var s:string[90];
	n,i,c:longint;
	ch:longint;
BEGIN
	readln(n);
	readln(s);
	ch:=0;
	i:=1;
	s[n+1]:='0';
	while i<=n do
	begin
		c:=0;
		while s[i]<>'0' do
		begin
			inc(c);
			inc(i);
		end;
		ch:=(ch*10)+c;
		inc(i);
	end;
	if s[n]='0' then ch:=(ch*10)+0;
	writeln(ch);
END.

var s:string;
    x,y,n,i,code,j:longint;
    a:array[1..100] of longint;
    k:string;
begin
readln(n);
readln(s);
i:=1;y:=0;j:=1;
while i<=n do
   begin
   IF s[i]='1' then inc(a[j])
   else inc(j);
   inc(i);
   end;
for i:=1 to j do write(a[i]);
end.

Program Chi;
var che:longint;
    j,i,n:byte;
    p,nu:array[0..100]of byte;
    s:string;

begin
readln(n);
read(s);
for i:=n downto 1 do
  p[i]:=ord(s[i])-ord('0');
nu[0]:=0;
for i:=1 to n do
  begin
  if p[i]=0 then
    begin
    inc(j);
    nu[j]:=i;
    end;
  end;
inc(j);
nu[j]:=n+1;
for i:=1 to j do
  che:=che*10+nu[i]-nu[i-1]-1;
writeln(che);

end.

const   fi='test.inp';
        fo='test.out';
procedure Nhap;
var     i,d,n:longint;
        z:char;
begin
        //assign(input,fi);
        //reset(input);
        readln(n);   d:=0;
        for i:=1 to n do
        begin
                read(z);
                if z='1' then inc(d);
                if z='0' then
                begin
                        write(d);
                        d:=0;
                end;
        end;
        write(d);
        //close(input);
end;

procedure Main;
var     i:longint;
begin

end;
procedure Xuat;
begin
        assign(output,fo);
        rewrite(output);
        close(output);
end;
begin
        Nhap;
        main;
        Xuat;
end.

var a,b,c,d,e,i,j:longint;
    s:string;
begin
  readln(a);
  readln(s);
  b:=0;
  c:=0;
  for i:=1 to a do
    begin
      if s[i]='1' then inc(b) else
      begin
        c:=c * 10+b;
        b:=0;
      end;
    end;
  writeln(c * 10+b);
end.

const fin='binary.inp';fon='binary.out';
var i,j,m,n,k,o,u,x,y,c,d,e,f,s,t:longint;a:string;
procedure nhap;
	begin
	readln(n);
	readln(a);
	end;
procedure tinh;
	begin
	t:=0;
	for i:=1 to n do
		begin
		if a[i]='1' then inc(t)
		else
				begin
				write(t);
				t:=0;
				end;
		end;
	write(t);
	end;
begin
//assign(input,fin);
//reset(input);
//assign(output,fon);
//rewrite(output);
nhap;
tinh;
end.

var a,n,i:integer;
s:string;
begin
readln(n);
readln(s);
a:=0;
for i:=1 to n do begin
  if s[i]='1' then
  a:=a+1
  else begin
       write(a);
       a:=0;
       end;
      end;
write(a);
end.

var a,n,i:integer;
s:string;
begin
readln(n);
readln(s);
a:=0;
for i:=1 to n do begin
  if s[i]='1' then
  a+=1
  else begin
       write(a);
       a:=0;
       end;
      end;
write(a);
end.

var s:string;n,a,i:longint;
BEGIN
readln(n);
readln(s);
for i:=1 to n do
if s[i]='1' then a:=a+1 else
if (s[i]='0')and(s[i-1]='0')then write('0')
                            else begin write(a);a:=0;end;
write(a);
end.

//abcdefghijklmnopqrstuvwxyz
var
a,c,i:longint;
b:char;
begin
readln(a);
for i:=1 to a do
  begin
  read(b);
  if b='1'
    then inc(c)
    else
      begin
      write(c);
      c:=0;
      end;
  end;
writeln(c);
end.

var n:longint;
    x,i:longint;
    s:string;
begin
  readln(n);
  readln(s);
  s:=s+'0';
  for i:=1 to n+1 do
  if s[i]='0' then
  begin
    write(x);
    x:=0;
  end else inc(x);
end.

var ans:int64;
b,i,n:integer;s:String;
begin
    ans:=0;
    readln(n);
    readln(s);
  s:=s+'0';

    b:=1;
    for i:=2 to length(s) do begin

        if s[i]='1' then inc(b)
        else if (s[i]='0') then begin

       if s[i-1]='1' then begin
       ans:=ans*10+b;
       b:=0;end else begin
       ans:=ans*10;
       end;

       end;
        end;

    writeln(ans);
end.

var
   n, i, k, kp: integer;
   str: string;
   a: array [1..1000] of integer;
begin
   readln(n);
   readln(str);

   str:= str+'0';
   k:=0; kp:=0;

   for i:= 1 to n+1 do
      begin
         if (str[i] = '1') then k:=k+1;
         if (str[i] = '0') then
            begin
               kp:=kp + 1;
               a[kp]:= k;

               k:= 0;
            end;
      end;
   a[kp+1]:= k;
   for i:= 1 to kp do write (a[i]);
end.

program twoface;
var n, i, num, zerg,k,r:integer;
a:array[1..89]of integer;
var s:string[90];
begin
readln(n);
read(s);

k:=1;
for i:=1 to n do
begin
if s[i] = '1'
   then
  begin
    num:=num+1;
    for r:= 1 to zerg-1 do
    begin
    a[k]:=0;
    k:=k+1;
    end;
    zerg:=0;
  end
   else
  begin
    if num>0 then
    begin
    a[k]:=num;
    k:=k+1;
    num:=0;
    end;

    zerg:=zerg+1;
  end;
end;
if num>0 then a[k]:= num;
    for r:= 1 to zerg-1 do
    begin
    a[k]:=0;
    k:=k+1;
    end;
for i:=1 to k do
write(a[i]);
for i:= 1 to -1  do
write('asdawdasd');
end.

program dvoich;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  i, n: integer;
  s, ans: string;

begin
  readln(n);
  readln(s);
  i := 0;
  while (length(s) > 0) do
  begin
    if (s[1] = '1') or ((length(s) = 1) and (s[1] = '1')) then inc(i)
    else
    begin
      ans :=  ans + inttostr(i);
      i := 0;
    end;
    delete(s, 1, 1);
  end;
  if ans = '0' then
    writeln(ans)
  else
    writeln(ans + inttostr(i));
  readln;
  readln;
end.

   const nn=1600000; nnn=200000;eps=0.0000000001;
   label 1,2;
    type    real=extended;  {string=ansistring;}
    mas=array [0..nn] of int64;   point=record x,y,z:real;end;
    zap=record p1,p2,p3 :int64;end; zap1=^zap;
    mass=array[0..nn] of int64;mass1=^mass;
    var qq,p3,start,modul,pp,ot,q,ll,rr,aa,bb,cc,p1,p2,l,r,pos,t,kolx,kolo,nm,n,k,s1,s2,m,s,imax,smin,cen,dl,t2,i1,p,besk:int64;
    tt,ii,jj,step, i,j:longint;
     time:real;
     newpole,pole:array[-10..200,-10..200] of char;
     ssot,sssnew:array[-10..3000000] of char;
     smas:array[-10..2000000]of string;
     skobk,zz,z,sum,c,d,x,y,a,b:array[-1000002..6000000] of int64;
     per,dda,ddb:array[-10..120,-10..120] of int64;
     ss3,ss1,ss2:string;
    ss:string;ch:char;
    maxpr:array[0..nn] of string;
    st2:array[0..nnn] of string;
     v0,v1,s0,t0:real;
     zv:point;
     xx,yy:array[-1..nn] of double;
     yot:double;
     prost:array [-1000..6000000] of boolean;
       flag,flag1:boolean;
    function al(x,y:real):real; var t0,t1,p,s0,s1:real;
 begin
     if (x>0)and(y>=0) then p:=arctan(y/x);
     if x<0 then p:=pi+arctan(y/x);
     if(x>0)and(y<0) then p:=2*pi+arctan(y/x);
     if x=0 then if (y>=0) then p:=pi/2 else p:=3*pi/2;
     al:=p/pi*180;
 end;
  function min(x,y:int64):int64;begin min:=x;if y<x then min:=y; end;
  function max(x,y:int64):int64;begin max:=x;if y>x then max:=y; end;

  function nod(x,y:int64):int64; var z:int64;
begin   repeat  z:=x mod y;x:=y;y:=z;   until  z=0 ;  nod:=x;end;

  function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
  tt:zap; tt1:zap1;
begin
  if a<b then begin r:=a;a:=b;b:=r; end;
  x2:=1;x1:=0;y2:=0;y1:=1;
  while b>0 do
    begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
          a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;

    end;
    d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt;
   evkl:=tt1;
end;

function degg(a,k:int64):int64; var p:int64;
begin
 if k<=0 then degg:=1 else if odd(k) then degg:=degg(a,k-1)*a mod modul else
   begin  p:=degg(a,k div 2); degg:=p*p mod modul;   end;

end;

begin
   { assign (input,'input.txt');reset(input);
      assign (output,'output.txt'); rewrite(output);
    }
    readln(n);
    read(ss);
    n:=length(ss);
    for i:=1 to n do if ss[i]='0' then begin inc(q);a[q]:=i;  end;
    inc(q);a[q]:=n+1;
    for i:=1 to q do write(a[i]-a[i-1]-1);

   1:          close(output);
end.

program suhfiuw21742987;
 var s:string;
     n,i,a:integer;
 begin
  readln (n);
  readln (s);
  a:=0;
  for i:=1 to n do begin
    if s[i]='1' then
     a+=1
     else
     begin
      write (a);
      a:=0;
     end;
   end;
  write (a);
 end.

var
        n : integer;
        s : string;
        i,j : integer;
BEGIN
        //assign(input,'input.inp');reset(input);
        //assign(output,'output.out');rewrite(output);
        readln(n);
        read(s);
        s:= s + '0';
        inc(n);
        i:= 1;
        while (i <= n) do
                begin
                        if s[i] = '1' then
                                begin
                                        j:= i+1;
                                        while (j <= n) and (s[j] = '1') do
                                                inc(j);
                                        write(j - i);
                                        i:= j + 1;
                                end
                        else
                                begin
                                        write(0);
                                        i:= i + 1;
                                end;
                end;
END.

const
    fi='';
    fo='';
var n:longint;
    s:string;
procedure input;
var f:text;
begin
    assign(f,fi);
    reset(f);
    readln(f,n);
    readln(f,s);
    close(f);
end;
function ans:string;
var st:string;
    i,dem:longint;
begin
    st:='';dem:=0;
    for i:=1 to n do
    begin
        if(s[i]='1')then inc(dem)
            else
            begin
                st:=st+chr(dem+48);
                dem:=0;
            end;
    end;
    st:=st+chr(dem+48);
    exit(st);
end;
procedure output;
var f:text;
begin
    assign(f,fo);
    rewrite(f);
    writeln(f,ans);
    close(f);
end;
begin
    input;
    output;
end.

var s:string;
    i,k,n:longint;
begin
    readln(n);
    readln(s);
    for i:=1 to n do begin
        if(s[i]='1') then
          inc(k)
        else begin
            write(k);
            k:=0;
        end;
    end;
      write(k);
end.

program zadacha_A;
var
  n,i,count,k: integer;
  s,temp:string;
begin
  readln(n);
  readln (s);
  temp:='';
  i:=1;count:=0;
  while (i<=n) do
  begin
    if s[i]<>'0' then
      temp:=temp+s[i]
    else
    begin
      if (length(temp)<>0) then write(length(temp));
      temp:=''; inc(count);
      if (s[i]='0') and(s[i+1]='0')then write(0);
   end;
    inc(i);
  end;
  write(length(temp));
end.

var n,i,res: longint;
	s: string;
BEGIN
readln(n);
readln(s);
res:=0;
for i:=1 to n do begin
	if s[i]='1' then inc(res,1);
	if s[i]='0' then begin write(res); res:=0; end;
	if i=n then write(res);
end;
END.

var n,i,o:longint;s:string;
begin
readln(n);
readln(s);
for i:=1 to n do
  if s[i]='1'then o:=o+ord(s[i])-48
  else
    begin
    write(o);
    o:=ord(s[i])-48;
    end;
write(o);
end.

var
        s:char;
        cnt,i,n:longint;
begin
readln(n);
while i<=n do
        begin
        cnt:=0;
        inc(i);
        read(s);
        while (s<>'0') and (i<=n) do
                begin
                inc(cnt);
                inc(i);
                read(s);
                end;
        write(cnt);
        end;
end.

var n,i,d:longint;
    s,k:string;
procedure solve;
var t:string;
begin
   i:=2; d:=1;
   while i<=n do
   begin
      if s[i]='1' then inc(d);
      if (s[i]='0') and (s[i-1]='1') then
      begin
         str(d,t);
         k:=k+t;
         d:=0;
      end;
      if (s[i]='0') and (s[i-1]='0') then
      begin
         k:=k+'0';
      end;
      inc(i);
   end;
   str(d,t);
   k:=k+t;
   writeln(k);
end;

begin
   readln(n);
   readln(s);
   k:='';
   solve;
end.

var	n,i,dem:longint;
	ans:int64;
	s:ansistring;
begin
	readln(n);
	readln(S);

	ans:=0;
	i:=1;
	while i<=n do
	begin
		dem:=0;
		while (i<=n) and (s[i]='1') do
		begin
			inc(Dem);
			inc(i);
		end;
		ans:=ans*10+dem;
		inc(i);
	end;
	write(ans);
	if s[n]='0' then write(0);
end.

var n,i,j:byte;
     res:longint;
    s:string;

    begin
 readln(n);
 read(s);
 res:=0;
 i:=1;
 writeln;
 while i<=n do
begin
if s[i]='1' then res:=res+1
else
begin
write(res);
res:=0;
end;
 inc(i);
 end;
 write(res);
readln;
end.

Var n,ans,k,i,f:longint;
S:string;
begin
readln(n);
ans:=0;
read(S);
S:=S+'0';
for i:=1 to n+1 do
if S[i]='0' then begin
                 write(k);
                 k:=0;
               end
               else inc(k);
        end.

var
a:array[1..100] of integer;
c:char;
n,l,i:integer;

begin
readln(n);l:=1;

for i:=1 to n do begin
 read(c);
if (ord(c)=49) then a[l]:=a[l]+1;
if (ord(c)=48) then l:=l+1;
end;

for i:=1 to l do write(a[i]);
end.

var
n,y,u,o:longint;
f:string;
begin
readln(n);
readln(f);
u:=0; inc(n);
y:=1; o:=1; f:=f+'0';
while o<=n do
begin while (o<n)
and (f[o]='1') do inc(o);
u:=u*10+o-y;
y:=o+1; inc(o); end;
write(u); end.

var n,i,k:integer;
s,s2,t:string;
begin

        readln(n);
        readln (s);
        i:=1;
        while i<=n do
             begin
             while (s[i]<>'0')  do
             begin
             k:=k+1;
             i:=i+1;
             if i>n then break;
             end;
             str(k,t);
             s2:=s2+t;
             k:=0;
             if i>=n then break;
             if s[i+1]='0' then
             begin
             s2:=s2+'0';
             i:=i+2;
             end else
             i:=i+1;
        end;
        if (s[n]='0') then s2:=s2+'0';
        writeln(s2);
end.

var
	n, count1, count0, i, j, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then
				begin
					count1:=count1 + 1;
					if count0 > 1 then
					    	    for j:=1 to count0 - 1 do write(0);
					count0:=0;
				end
			else
				begin
					if count1 <> 0 then
						begin
							write(count1);
							count1:=0;
						end;
					count0:=count0 + 1;
				end;
		end;
	if count1 <> 0 then write(count1);
	if count0 > 0 then
		for i:=1 to count0 do write(0);
end.

var s,s1:ansistring; i,x,len:longint;
begin
readln(len);
readln(s);  s:=s+'0';
for i:=1 to len+1 do
  if s[i]='0' then
    begin
    str(x,s1);
    write(s1);
    x:=0;
    end
  else x:=x+1;
end.

var n,i,k:longint;
    s,tg,ans:ansistring;
begin
        readln(n);
        readln(s);
        s:=s+'0';
        for i:=1 to n+1 do
                if s[i]='1' then inc(k) else
                begin
                        str(k,tg);
                        ans:=ans+tg;
                        k:=0;
                end;
        writeln(ans);
end.

program twoface;
var n, i, ss, num, zerg,k,r:integer;
a:array[1..89]of integer;
s:string;
begin
read(n);
read(ss);
str(ss, s);
k:=1;
for i:=1 to n do
begin
if s[i] = '1'
   then
  begin
    num:=num+1;
    for r:= 1 to zerg-1 do
    begin
    a[k]:=0;
    k:=k+1;
    end;
    zerg:=0;
  end
   else
  begin
    if num>0 then
    begin
    a[k]:=num;
    k:=k+1;
    num:=0;
    end;

    zerg:=zerg+1;
  end;
end;
if num>0 then a[k]:= num;
if s[n]= '0' then a[k]:=0;
for i:=1 to k do
write(a[i]);
for i:= 1 to -1  do
write('asdawdasd');
end.

program dvoich;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  i, n: integer;
  s, ans: string;

begin
  readln(n);
  readln(s);
  i := 0;
  while (length(s) > 0) do
  begin
    if (s[1] = '1') or (length(s) = 1) then inc(i)
    else
    begin
      ans :=  ans + inttostr(i);
      i := 0;
    end;
    delete(s, 1, 1);
  end;
  writeln(ans + inttostr(i));
  readln;
  readln;
end.

   const nn=1600000; nnn=200000;eps=0.0000000001;
   label 1,2;
    type    real=extended;  {string=ansistring;}
    mas=array [0..nn] of int64;   point=record x,y,z:real;end;
    zap=record p1,p2,p3 :int64;end; zap1=^zap;
    mass=array[0..nn] of int64;mass1=^mass;
    var qq,p3,start,modul,pp,ot,q,ll,rr,aa,bb,cc,p1,p2,l,r,pos,t,kolx,kolo,nm,n,k,s1,s2,m,s,imax,smin,cen,dl,t2,i1,p,besk:int64;
    tt,ii,jj,step, i,j:longint;
     time:real;
     newpole,pole:array[-10..200,-10..200] of char;
     ssot,sssnew:array[-10..3000000] of char;
     smas:array[-10..2000000]of string;
     skobk,zz,z,sum,c,d,x,y,a,b:array[-1000002..6000000] of int64;
     per,dda,ddb:array[-10..120,-10..120] of int64;
     ss3,ss1,ss2:string;
    ss:string;ch:char;
    maxpr:array[0..nn] of string;
    st2:array[0..nnn] of string;
     v0,v1,s0,t0:real;
     zv:point;
     xx,yy:array[-1..nn] of double;
     yot:double;
     prost:array [-1000..6000000] of boolean;
       flag,flag1:boolean;
    function al(x,y:real):real; var t0,t1,p,s0,s1:real;
 begin
     if (x>0)and(y>=0) then p:=arctan(y/x);
     if x<0 then p:=pi+arctan(y/x);
     if(x>0)and(y<0) then p:=2*pi+arctan(y/x);
     if x=0 then if (y>=0) then p:=pi/2 else p:=3*pi/2;
     al:=p/pi*180;
 end;
  function min(x,y:int64):int64;begin min:=x;if y<x then min:=y; end;
  function max(x,y:int64):int64;begin max:=x;if y>x then max:=y; end;

  function nod(x,y:int64):int64; var z:int64;
begin   repeat  z:=x mod y;x:=y;y:=z;   until  z=0 ;  nod:=x;end;

  function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
  tt:zap; tt1:zap1;
begin
  if a<b then begin r:=a;a:=b;b:=r; end;
  x2:=1;x1:=0;y2:=0;y1:=1;
  while b>0 do
    begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
          a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;

    end;
    d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt;
   evkl:=tt1;
end;

function degg(a,k:int64):int64; var p:int64;
begin
 if k<=0 then degg:=1 else if odd(k) then degg:=degg(a,k-1)*a mod modul else
   begin  p:=degg(a,k div 2); degg:=p*p mod modul;   end;

end;

begin
   { assign (input,'input.txt');reset(input);
      assign (output,'output.txt'); rewrite(output);
    }
    readln(n);
    read(ss);
    n:=length(ss);
    for i:=1 to n do if ss[i]='0' then begin inc(q);a[q]:=i;  end;
    inc(q);a[q]:=n+1;
    for i:=1 to q do write(a[i]-a[i-1]-1,' ');

   1:          close(output);
end.

var
        n : integer;
        s : string;
        i,j : integer;
BEGIN
        //assign(input,'input.inp');reset(input);
        //assign(output,'output.out');rewrite(output);
        readln(n);
        read(s);
        i:= 1;
        while (i <= n) do
                begin
                        if s[i] = '1' then
                                begin
                                        j:= i+1;
                                        while (j <= n) and (s[j] = '1') do
                                                inc(j);
                                        write(j - i);
                                        i:= j + 1;
                                end
                        else
                                begin
                                        write(0);
                                        i:= i + 1;
                                end;
                end;
END.

var s:string;
    i,k,n:longint;
begin
    readln(n);
    readln(s);
    for i:=1 to n do begin
        if(s[i]='1') then
          inc(k)
        else begin
            write(k);
            k:=0;
        end;
    end;
    if(s[n]='1') then
      write(k);
end.

var
        s:char;
        cnt,i,n:longint;
begin
readln(n);
while i<=n do
        begin
        cnt:=0;
        inc(i);
        read(s);
        while (s<>'0') and (i<=n) do
                begin
                inc(cnt);
                inc(i);
                if i<>n then read(s);
                end;
        write(cnt);
        end;
end.

var s:string;
    x,y,n,i,code,j:longint;
    a:array[1..100] of longint;
    k:string;
begin
readln(n);
readln(s);
i:=1;y:=0;j:=1;
while i<=n do
   begin
   val(s[i],x,code);
   a[j]:=a[j]+x;
   IF (s[i]='0') or (s[i+1]='0') then inc(j);
   IF s[i+1]='0' then inc(i,2) else inc(i);
   end;
for i:=1 to j do write(a[i]);
end.

Var n,ans,k,i,f:longint;
S:string;
begin
readln(n);
ans:=0;
read(S);
i:=1;
while i<=n do begin
k:=0;
while (i<n+1) and(S[i]<>'0') do begin
                               inc(i);
                               inc(k);
                              end;
ans:=ans*10+k;
k:=0;
inc(i);
end;
       write(ans);
        end.

Var n,ans,k,i:longint;
S:string;
begin
readln(n);
ans:=0;
read(S);
i:=1;
while i<=n do begin
k:=0;
while (i<n+1) and(S[i]<>'0') do begin
                               inc(i);
                               inc(k);
                              end;
write(k);
k:=0;
inc(i);
end;

        end.

var
n,y,u,o:longint;
f:string;
begin
readln(n);
readln(f);
u:=0; inc(n);
y:=1; o:=1; f:=f+'0';
while o<n do
begin while (o<n)
and (f[o]='1') do inc(o);
u:=u*10+o-y;
y:=o+1; inc(o); end;
write(u); end.

var n,i,k,k1:integer;
s,s2,t:string;
begin
        readln(n);

        readln (s);
        if pos('0',s)=0 then writeln(n) else
        begin
        k:=1;
        for i:=2 to n do
        begin
                if s[i]='1' then k:=k+1;
                if (s[i]='0') and (s[i-1]='0') then
                s2:=s2+'0' else
                if s[i]='0'then
                begin
                k1:=k;
                str(k1,t);
                s2:=s2+t;
                k:=0;
                end;

        end;
        writeln(s2+'1');
        end;
end.

var n,i,k,k1,k2:integer;
s,s2,t:string;
begin
        readln(n);

        readln (s);
        if pos('0',s)=0 then writeln(n) else
        begin
        k:=1;
        for i:=2 to n do
        begin
                if s[i]='1' then k:=k+1;
                if (s[i]='1') and (i=n)
                then begin
                k1:=k;
                str(k1,t);
                s2:=s2+t;
                end
                else
                if (s[i]='0') and (s[i-1]='0') then
                s2:=s2+'0' else
                if (s[i]='0') then
                begin
                k1:=k;
                str(k1,t);
                s2:=s2+t;
                k:=0;
                end;

        end;
        writeln(s2);
        end;
end.

var n,i,k,k1,k2:integer;
s,s2,t,r:string;
begin
        readln(n);
        readln (s);
        if pos('0',s)=0 then writeln(n) else
        begin
        k:=0;
        for i:=1 to n do
        begin
                if s[i]='1' then k:=k+1;
                if (s[i]='0') and (s[i-1]='0')and (i<>n) then
                s2:=s2+'0' else
                if (s[i]='0') then
                begin
                k1:=k;
                str(k1,t);
                s2:=s2+t;
                k:=0;
                end;

        end;
        if k<>0 then
        begin
        k2:=k;
        str(k2,r);
        s2:=s2+r;
        end;
        writeln(s2);
        end;
end.

var n,i,k:integer;
s,s2,t:string;
begin
        readln(n);
        readln (s);
        i:=1;
        while i<=n do
             begin
             while (s[i]<>'0')  do
             begin
             k:=k+1;
             i:=i+1;
             if i>n then break;
             end;
             str(k,t);
             s2:=s2+t;
             k:=0;
             if i>n then break;
             if s[i+1]='0' then
             begin
             s2:=s2+'0';
             i:=i+2;
             end else
             i:=i+1;
        end;
        if (s[n]='0') and (s[n-1]='0') then s2:=s2+'0';
        writeln(s2);
end.

var n,i,k:integer;
s,s2,t:string;
begin
        readln(n);
        readln (s);
        i:=1;
        if s='10' then s2:='10'
        else
        begin
        while i<=n do
             begin
             while (s[i]<>'0')  do
             begin
             k:=k+1;
             i:=i+1;
             if i>n then break;
             end;
             str(k,t);
             s2:=s2+t;
             k:=0;
             if i>n then break;
             if s[i+1]='0' then
             begin
             s2:=s2+'0';
             i:=i+2;
             end else
             i:=i+1;
        end;
        if (s[n]='0') and (s[n-1]='0') then s2:=s2+'0';
        end;
        writeln(s2);
end.

var s:string[89];
	n,i,c:longint;
	ch:longint;
BEGIN
	readln(n);
	readln(s);
	ch:=0;
	i:=1;
	s[n+1]:='0';
	while i<=n do
	begin
		c:=0;
		while s[i]<>'0' do
		begin
			inc(c);
			inc(i);
		end;
		ch:=(ch*10)+c;
		inc(i);
	end;
	writeln(ch);
END.

var s:string[89];
	n,i,c:byte;
	ch:longint;
BEGIN
	readln(n);
	readln(s);
	ch:=0;
	i:=1;
	s[n+1]:='0';
	while i<=n do
	begin
		c:=0;
		while s[i]<>'0' do
		begin
			inc(c);
			inc(i);
		end;
		ch:=(ch*10)+c;
		inc(i);
	end;
	writeln(ch);
END.

var s:string[90];
	n,i,c:longint;
	ch:longint;
BEGIN
	readln(n);
	readln(s);
	ch:=0;
	i:=1;
	s[n+1]:='0';
	while i<=n do
	begin
		c:=0;
		while s[i]<>'0' do
		begin
			inc(c);
			inc(i);
		end;
		ch:=(ch*10)+c;
		inc(i);
	end;
	if s[n]='0' then ch:=(ch*10)+c;
	writeln(ch);
END.

var s:string[90];
	n,i,c:byte;
	ch:longint;
BEGIN
	readln(n);
	readln(s);
	ch:=0;
	i:=1;
	s[n+1]:='0';
	while i<=n do
	begin
		c:=0;
		while s[i]<>'0' do
		begin
			inc(c);
			inc(i);
		end;
		ch:=(ch*10)+c;
		inc(i);
	end;
	writeln(ch);
END.

var n:longint;
    x,i:longint;
    s:string;
begin
  readln(n);
  readln(s);
  s:=s+'0';
  for i:=1 to n do
  if s[i]='0' then
  begin
    write(x);
    x:=0;
  end else inc(x);
end.

var n,i,j:byte;
     res:longint;
    s:string;

    begin
 readln(n);
 read(s);
 res:=0;
 i:=1;
 writeln;
 while i<=n do
begin
res:=0;
 while (s[i]<>'0') and (i<=n) do
 begin
 res:=res+1;
 inc(i);
 end;
 if res<>0 then  write(res);
 if s[i]='0' then inc(i);
 while s[i]='0' do begin
 write(0);
 inc(i);
 end;
 end;
readln;
end.

var n,i,j:byte;
     res:longint;
    s:string;

    begin
 readln(n);
 read(s);
 res:=0;
 i:=1;
 writeln;
 while i<=n do
begin
res:=0;
 while (s[i]<>'0') and (i<=n) do
 begin
 res:=res+1;
 inc(i);
 end;
 write(res);
 if s[i]='0' then inc(i);
 while s[i]='0' do begin
 write(0);
 inc(i);
 end;
 end;
readln;
end.

var n,i,j:byte;
     res:longint;
    s:string;

    begin
 readln(n);
 read(s);
 res:=0;
 i:=1;
 writeln;
 while i<=n do
begin
res:=0;
 while (s[i]<>'0') and (i<=n) do
 begin
 res:=res+1;
 inc(i);
 end;
 if s[i]='0' then inc(i);
 while s[i]='0' do begin
 write(0);
 inc(i);
 end;
 write(res);
 end;
readln;
end.

var
	n, count1, count0, i, j, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then
				begin
					count1:=count1 + 1;
					if count0 > 1 then
							for j:=1 to count0 div 2 do write(0);
					count0:=0;
				end
			else
				begin
					if count1 <> 0 then
						begin
							write(count1);
							count1:=0;
						end;
					count0:=count0 + 1;
				end;
		end;
	if count1 <> 0 then write(count1);
	if count0 > 1 then
		for i:=1 to count0 do write(0);
end.

var
	n, count1, count0, i, j, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then
				begin
					count1:=count1 + 1;
					if count0 > 1 then
							for j:=1 to count0 div 2 do write(0);
					count0:=0;
				end
			else
				begin
					if count1 <> 0 then
						begin
							write(count1);
							count1:=0;
						end;
					count0:=count0 + 1;
				end;
		end;
	if count1 <> 0 then write(count1);
	if count0 > 1 then
		for i:=1 to count0 - 1 do write(0);
end.

var
	n, count1, count0, i, j, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then
				begin
					count1:=count1 + 1;
					if count0 > 1 then
					        if count0 mod 2 = 0 then
					    		for j:=1 to count0 div 2 do write(0)
					    	else
					    	    for j:=1 to count0 div 2 + 1 do write(0);
					count0:=0;
				end
			else
				begin
					if count1 <> 0 then
						begin
							write(count1);
							count1:=0;
						end;
					count0:=count0 + 1;
				end;
		end;
	if count1 <> 0 then write(count1);
	if count0 > 1 then
		for i:=1 to count0 do write(0);
end.

var
	n, count1, count0, i, j, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then
				begin
					count1:=count1 + 1;
					if count0 > 1 then
							for j:=1 to count0 div 2 do write(0);
					count0:=0;
				end
			else
				begin
					if count1 <> 0 then
						begin
							write(count1);
							count1:=0;
						end;
					count0:=count0 + 1;
				end;
		end;
	if count1 <> 0 then write(count1);
	if count0 > 1 then
		for i:=1 to count0 div 2 do write(0);
end.

var
	n, count1, count0, i, j, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then
				begin
					count1:=count1 + 1;
					if count0 > 1 then
					    	    for j:=1 to count0 - 1 do write(0);
					count0:=0;
				end
			else
				begin
					if count1 <> 0 then
						begin
							write(count1);
							count1:=0;
						end;
					count0:=count0 + 1;
				end;
		end;
	if count1 <> 0 then write(count1);
	if count0 > 1 then
		for i:=1 to count0 do write(0);
end.

var
	n, count1, count0, i, j, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then
				begin
					count1:=count1 + 1;
					if count0 > 1 then
							for j:=1 to count0 - 1 do write(0);
					count0:=0;
				end
			else
				begin
					if count1 <> 0 then
						begin
							write(count1);
							count1:=0;
						end;
					count0:=count0 + 1;
				end;
		end;
	if count1 <> 0 then write(count1);
	if count0 > 1 then
		for i:=1 to count0 - 1 do write(0);
end.

var
	n, count, i, tmp: byte;
	ch: char;
begin
	readln(n);
	for i:=1 to n do
		begin
			read(ch);
			val(ch,tmp);
			if tmp = 1 then count:=count + 1
			else
				if count = 0 then write(0)
					else
						begin
							write(count);
							count:=0;
						end;
		end;
	if count <> 0 then write(count);
end.

var	n,i,dem:longint;
	ans:int64;
	s:ansistring;
begin
	readln(n);
	readln(S);

	ans:=0;
	i:=1;
	while i<=n do
	begin
		dem:=0;
		while (i<=n) and (s[i]='1') do
		begin
			inc(Dem);
			inc(i);
		end;
		ans:=ans*10+dem;
		inc(i);
	end;
	writeln(ans);
end.

var	n,i,dem:longint;
	ans:int64;
	s:ansistring;
begin
	readln(n);
	readln(S);

	ans:=0;
	i:=1;
	while i<=n do
	begin
		dem:=0;
		while (i<=n) and (s[i]<>'0') do
		begin
			inc(Dem);
			inc(i);
		end;
		ans:=ans*10+dem;
		inc(i);
	end;
	writeln(ans);
end.


 {$M 100000000}
{$Q-,R-,S-,I-}
uses math;
const fi='';//input.inp';
      fo='';//output.out';
      mh:array[1..16] of integer=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var   n:longint;
      a,d,sl:array[0..101] of longint;
      sc:array[0..100000] of longint;
      con:array[0..100000,0..100] of longint;
      luu,f,aa,bb:array[0..100,0..100000] of longint;
      e:array[0..100,0..100] of longint;

procedure   docfile;
   var i:longint;
   begin
      assign(input,fi);
      reset(input);
      readln(n);
      for i:=1 to n do
         read(a[i]);
      assign(output,fo);
      rewrite(output);
   end;
procedure   dongfile;
   begin
      close(input);  close(output);
   end;
procedure   taomang;
   var i,j,k:longint; ok:boolean;
   begin
      for i:=0 to (1 shl 16)-1 do
         begin
            for j:=1 to 58 do
               begin
                  ok:=true;
                  for k:=1 to 16 do
                     if (i or (1 shl (k-1)) = i) then
                        if j mod mh[k] = 0 then
                           begin
                              ok:=false; break;
                           end;
                  if ok then
                     begin
                        inc(sc[i]); con[i,sc[i]]:=j;
                     end;
               end;
         end;
      for i:=2 to 58 do
         begin
            for j:=1 to 16 do
               if i mod mh[j] = 0 then
                  begin
                     inc(d[i]);  e[i,d[i]]:=j;
                  end;
         end;
   end;
procedure   ghikq(m,t:longint);
   begin
      if m=0 then exit;
      ghikq(m-1,bb[m,t]);
      if m<n then write(aa[m,t],' ')
      else
         writeln(aa[m,t]);
   end;
procedure   xuli;
   var i,j,u,v,k,t,h,z,res,vt:longint;
   begin
      for i:=0 to n do
         for j:=0 to 1 shl 16 do f[i,j]:=maxlongint;
      f[0,0]:=0;
      sl[0]:=1; luu[0,1]:=0;
      for i:=1 to n do
         begin
            for j:=1 to sl[i-1] do
               begin
                  u:=luu[i-1,j];
                  for k:=1 to sc[u] do
                     begin
                        t:=con[u,k];
                        v:=u;
                        for h:=1 to d[t] do
                           begin
                              z:=e[t,h];
                              v:=v or (1 shl (z-1));
                           end;
                        if f[i,v] = maxlongint then
                           begin
                              inc(sl[i]); luu[i,sl[i]]:=v;
                           end;
                        if f[i,v]>f[i-1,u]+abs(t-a[i]) then
                           begin
                              f[i,v]:=f[i-1,u]+abs(t-a[i]);
                              aa[i,v]:=t; bb[i,v]:=u;
                           end;
                     end;
               end;
         end;
      res:=maxlongint;    vt:=0;
      for i:=0 to 1 shl 16 do
         if res>f[n,i] then
            begin
               res:=f[n,i]; vt:=i;
            end;
      ghikq(n,vt);
   end;
BEGIN
   docfile;
   taomang;
   xuli;
   dongfile;
END.

Const CEILING = 60;
Var A, Perm, Answer, B, C: array[1..101] of longint;
    n, i, num: longint;
    minSum: longint;

Procedure Sort(n: longint);
var i, j, tmp: longint;
begin
 For i:= 1 to n-1 do
  For j:= 1 to n-i do
   if A[j] > A[j+1] then
    begin
     tmp:= A[j];
     A[j]:= A[j+1];
     A[j+1]:= tmp;

     tmp:= Perm[j];
     Perm[j]:= Perm[j+1];
     Perm[j+1]:= tmp;
    end;
end;

Function GCD(a, b: longint): longint;
begin
 while (a<>0) and (b<>0) do
  if a>b then
   a:= a mod b
  else
   b:= b mod a;

 GCD:= a or b;
end;

Procedure CheckComb(len: longint);
var i, sum: longint;
begin
 if len=0 then
  exit;
 sum:= 0;
 For i:= n downto n-len+1 do
  sum:= sum + abs(A[i]-C[len-(n-i)]);
 For i:= n-len downto 1 do
  sum:= sum + abs(A[i]-1);

 if sum < minSum then
  begin
   minSum:= sum;
   For i:= 1 to n-len do
    Answer[i]:= 1;
   For i:= n-len+1 to n do
    Answer[i]:= C[i-(n-len+1)+1];
  end;
end;

Procedure Go(pos, len: longint);
var i, j: longint;
    good: boolean;
begin
 if (pos=CEILING+1) or (len=num) then
  exit;

 For i:= pos to CEILING do
  begin
   good:= true;
   For j:= 1 to len do
    if GCD(i, C[j]) <> 1 then
     begin
      good:= false;
      break;
     end;

   if good then
    begin
     C[len+1]:= i;
     CheckComb(len+1);
     Go(i+1, len+1);
     C[len+1]:= 0;
    end;
  end;
end;

begin
 read(n);

 num:= 0;
 For i:= 1 to n do
  begin
   read(A[i]);
   Perm[i]:= i;
   if A[i] <> 1 then
    inc(num);
  end;
 if num>20 then
  num:= 20;

 Sort(n);

 minSum:= MAXLONGINT;
 Go(2, 0);

 if num = 0 then
  For i:= 1 to n do
   Answer[i]:= 1;

 For i:= 1 to n do
  B[ Perm[i] ]:= Answer[i];

 For i:= 1 to n do
  write(B[i], ' ');
end.

const
  ct:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var
  a,g:array[0..100,0..65535]of longint;
  tt:array[1..58]of longint;
  p:array[0..65535,1..58]of longint;
  q:array[0..65535]of longint;
  b,wt:array[1..100]of longint;
  tp:array[1..16]of longint;
  n,i,j,k,an1,an2:longint;
begin
  readln(n);
  for i:=1 to n do
    for j:=0 to 65535 do a[i,j]:=3000;
  for i:=1 to n do read(b[i]);
  for i:=1 to 58 do
    for j:=1 to 16 do begin
      tt[i]:=tt[i] shl 1;
      if i mod ct[j]=0 then inc(tt[i]);
    end;
  for i:=0 to 65535 do
    for j:=1 to 58 do
      if tt[j] and i=0 then begin
        inc(q[i]);p[i,q[i]]:=j;
      end;
  for i:=1 to n do
    for j:=0 to 65535 do
      for k:=1 to q[j] do
        if a[i-1,j]+abs(p[j,k]-b[i])<a[i,j or tt[p[j,k]]] then begin
          a[i,j or tt[p[j,k]]]:=a[i-1,j]+abs(p[j,k]-b[i]);
          g[i,j or tt[p[j,k]]]:=p[j,k];
        end;
  an1:=3000;
  for i:=0 to 65535 do
    if a[n,i]<an1 then begin
      an1:=a[n,i];an2:=i;
    end;
  for i:=n downto 1 do begin
    wt[i]:=g[i,an2];
    an2:=an2 xor tt[wt[i]];
  end;
  for i:=1 to n do write(wt[i],' ');
  writeln;
end.

uses math;
const
 d:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var
 q,z,mn,i,j,n,m,k,t,x:longint;
 a,b,ans:array[0..11111]of longint;
 mk,f,p,an:array[0..111,0..133333]of longint;
begin
 readln(n);
 for i:=1 to n do read(a[i]);
 for i:=1 to 58 do for j:=1 to 16 do if i mod d[j]=0 then b[i]:=b[i] or(1 shl(j-1));
 fillchar(f,sizeof(f),63);f[0,0]:=0;
 for i:=1 to n do for j:=1 to 58 do
 begin
  z:=not b[j];
  z:=z and(1 shl 16-1);q:=z;
  while true do
  begin
   k:=f[i-1,z]+abs(a[i]-j);
   f[i,z or b[j]]:=min(f[i,z or b[j]],k);
   if f[i,z or b[j]]=k then
   begin
    p[i,z or b[j]]:=z;an[i,z or b[j]]:=j;
   end;
   if z=0 then break;
   z:=(z-1)and q;
  end;
 end;
 mn:=maxlongint;
 for i:=0 to 77777 do if f[n,i]<mn then begin mn:=f[n,i];q:=i;end;
 for i:=n downto 1 do begin ans[i]:=an[i,q];q:=p[i,q];end;
 for i:=1 to n do write(ans[i],' ');
 writeln;
end.

program dd;
const
    nm = 100;
    pm = 17;
    bm = 1 shl 17;
    p: array[1..17] of word = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59);
    oo = trunc(1e9);
var
    a, res: array[1..nm] of longint;
    bit: array[1..60] of longword;
    memo, trace2, used: array[1..nm, 0..bm] of longword;
    calc: array[1..nm, 0..bm] of boolean;
    n: longword;
procedure inp;
    var
        i: longword;
    begin
        readln(n);
        for i := 1 to n do read(a[i]);
    end;
function f(const i, s: longword): longword;
    var
        j: longint;
        tmp: longword;
    begin
        if (i = 0) then exit(0);
        if (calc[i, s]) then exit(memo[i, s]);
        calc[i, s] := true; memo[i, s] := oo;
        for j := 1 to (a[i] + abs(a[i]-1)) do
            begin
                if ((s and bit[j]) <> 0) then continue;
                tmp := f(i-1, s or bit[j]) + abs(j-a[i]);
                if (tmp < memo[i, s]) then
                    begin
                        memo[i, s] := tmp;
                        trace2[i, s] := s or bit[j];
                        used[i, s] := j;
                    end;
            end;
        exit(memo[i, s]);
    end;
procedure trace(const i, s: longword);
    begin
        if (i = 0) then exit;
        res[i] := used[i, s];
        trace(i-1, trace2[i, s]);
    end;
procedure sol;
    var
        i, j, best: longword;
    begin
        for i := 2 to 60 do
            for j := 1 to 17 do
                if ((i mod p[j]) = 0) then bit[i] := bit[i] or (1 shl (j-1));
        f(n, 0);
        trace(n, 0);
        for i := 1 to n do write(res[i], ' ');
    end;
begin
    inp;
    sol;
end.

var n,i,j,pn,s:longint;
fct,a:array[0..101] of longint;
rd,b:array[0..101,0..131072] of longint;
function sc(x,s:longint):longint;
var i:longint;
begin
if x>n then exit(0);
if rd[x,s]<>-1 then exit(rd[x,s]);
rd[x,s]:=maxlongint;
for i:=1 to 2*a[x]-1 do
  begin
  if(fct[i] and s)>0then continue;
  if abs(a[x]-i)+sc(x+1,fct[i] or s)<rd[x,s] then
    begin
    b[x,s]:=i;
    rd[x,s]:=abs(a[x]-i)+sc(x+1,fct[i] or s);
    end;
  end;
exit(rd[x,s]);
end;
begin
//assign(input,'xmdhxxb.in');reset(input);
//assign(output,'xmdhxxb.out');rewrite(output);
readln(n);
for i:=1 to n do read(a[i]);
for i:=2 to 59 do
  if fct[i]=0 then
    begin
    j:=i;
    while j<=59 do
      begin
      fct[j]:=fct[j] or (1<<pn);
      j:=j+i;
      end;
    inc(pn);
    end;
fillchar(rd,sizeof(rd),255);
sc(1,0);s:=0;
for i:=1 to n do
  begin
  write(b[i,s],' ');
  s:=s or fct[b[i,s]];
  end;
close(input);close(output);
end.

var a,e:array[0..201] of longint;
f:array[0..201] of boolean;
b,d:array[0..101,0..200000] of longint;
i,j,n,t,x:longint;
procedure sc(t,w:longint);
var i:longint;
begin
if t>n then begin d[t,w]:=0;exit; end;
if d[t,w]<>-1 then exit;
d[t,w]:=maxlongint div 2;
for i:=1 to 59 do
  if e[i] and w=0 then
    begin
    sc(t+1,w or e[i]);
    if abs(i-a[t])+d[t+1,w or e[i]]<d[t,w] then
      begin
      b[t,w]:=i;d[t,w]:=abs(i-a[t])+d[t+1,w or e[i]];
      end;
    end;
end;
begin
//(input,'hxxb.in');reset(input);
//assign(output,'hxxb.out');rewrite(output);
readln(n);
for i:=1 to n do
  read(a[i]);
fillchar(d,sizeof(d),255);
for i:=2 to 59 do
  if f[i]=false then
    begin
    for j:=1 to 59 div i do
      begin
      f[i*j]:=true;e[i*j]:=e[i*j] or (1 shl t);
      end;
    t:=t+1;
    end;
sc(1,0);t:=0;
for i:=1 to n do
  begin
  write(b[i,t],' ');t:=t or e[b[i,t]];
  end;
close(input);close(output);
end.

program dd;
const
    nm = 100;
    pm = 17;
    bm = 1 shl 17;
    p: array[1..17] of word = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59);
    oo = trunc(1e9);
var
    a, res: array[1..nm] of longint;
    bit: array[1..60] of longword;
    memo, trace2, used: array[1..nm, 0..bm] of longword;
    calc: array[1..nm, 0..bm] of boolean;
    n: longword;
procedure inp;
    var
        i: longword;
    begin
        readln(n);
        for i := 1 to n do read(a[i]);
    end;
function f(const i, s: longword): longword;
    var
        j: longint;
        tmp: longword;
    begin
        if (i = 0) then exit(0);
        if (calc[i, s]) then exit(memo[i, s]);
        calc[i, s] := true; memo[i, s] := oo;
        for j := 1 to (a[i] + abs(a[i]-1)) do
            begin
                if ((s and bit[j]) <> 0) then continue;
                tmp := f(i-1, s or bit[j]) + abs(j-a[i]);
                if (tmp < memo[i, s]) then
                    begin
                        memo[i, s] := tmp;
                        trace2[i, s] := s or bit[j];
                        used[i, s] := j;
                    end;
            end;
        exit(memo[i, s]);
    end;
procedure trace(const i, s: longword);
    begin
        if (i = 0) then exit;
        res[i] := used[i, s];
        trace(i-1, trace2[i, s]);
    end;
procedure sol;
    var
        i, j, best: longword;
    begin
        for i := 2 to 60 do
            for j := 1 to 17 do
                if ((i mod p[j]) = 0) then bit[i] := bit[i] or (1 shl (j-1));
        f(n, 0);
        trace(n, 0);
        for i := 1 to n do write(res[i], ' ');
    end;
begin
    //assign(input, 'input.txt'); reset(input);
    inp;
    sol;
end.

program sss;
var f,g,h:array[0..100,0..70000]of longint;
        a:array[1..100]of longint;
        q:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
        v:array[1..60]of longint;
        ans:array[1..100]of longint;
        i,j,k,m,n,l,e:longint;

procedure gx(x,y:longint);
var i,j,k,l:longint;
        u:boolean;
begin
        j:=y;

        if f[x+1,y]>f[x,y]+a[x+1]-1 then
        begin
                f[x+1,y]:=f[x,y]+a[x+1]-1;
                g[x+1,y]:=1;
                h[x+1,y]:=y;
        end;

        for i:=2 to 60 do
        begin
                if v[i] or y<y+v[i] then
                begin
                        continue;
                end;
                k:=v[i] or y;
                if f[x+1,k]>f[x,y]+abs(a[x+1]-i) then
                begin
                        f[x+1,k]:=f[x,y]+abs(a[x+1]-i);
                        g[x+1,k]:=i;
                        h[x+1,k]:=y;
                end;

        end;

end;

begin
        readln(n);
        for i:=1 to n do read(a[i]);
        fillchar(f,sizeof(f),55);
        f[0,0]:=0;

        fillchar(v,sizeof(v),0);
        for i:=2 to 60 do
        begin
                k:=0;
                l:=1;
                for  j:=1 to 16 do
                begin
                                if i mod q[j]=0 then k:=k+l;
                                l:=l*2;
                end;
                v[i]:=k;

        end;

        k:=1;
        for i:=1 to 16 do k:=k*2;
        k:=k-1;

        for i:=0 to n-1 do
                for j:=0 to k do
                        if f[i,j]<=3000 then gx(i,j);

        j:=3000;
        for i:=0 to k do
                if f[n,i]<j then
                begin
                        m:=i;
                        j:=f[n,i];
                end;

        for i:=n downto 1 do
        begin
                ans[i]:=g[i,m];
                m:=h[i,m];
        end;

        for i:=1 to n do write(ans[i],' ');

end.

var
  a : array [0..100] of longint;
  f,tt : array [0..100,0..140000] of integer;
  pr : array [0..100,0..140000] of longint;
  b,por,tr,anss : array [0..1000] of integer;
  min,i,n,d,gg : longint;
  j,nmask,nom,v,p,nom1,k,x : longint;
begin
  readln(n);
  for i:=1 to n do read(b[i]);
  for i:=2 to 59 do
   begin
    v:=0;
    for j:=2 to i do
     if (i mod j=0) and (por[j]<>0) then begin inc(v); a[i]:=a[i]+1 shl (por[j]-1); end;
    if v=0 then begin inc(gg); por[i]:=gg; a[i]:=1 shl (gg-1); end;
   end;
  for i:=1 to n do
  for j:=0 to 139000 do f[i,j]:=n*30;
  min:=n*30;
  for i:=1 to n do
  for j:=1 to 59 do
   begin
    x:=a[j] xor ((1 shl 17)-1);
    k:=x;
    while true do
     begin
      if f[i-1][k]+abs(b[i]-j)<f[i][k or a[j]] then
       begin
        f[i][k or a[j]]:=f[i-1][k]+abs(b[i]-j);
        if (i=n) and (f[i][k or a[j]]<min) then begin min:=f[i][k or a[j]]; nom:=k or a[j];nom1:=j; end;
        pr[i][k or a[j]]:=k;
        tt[i][k or a[j]]:=j;
       end;
      if k=0 then break;
      k:=x and (k-1);
     end;
   end;
  for i:=n downto 1 do
   begin
    anss[i]:=tt[i,nom];
    nom:=pr[i,nom];
   end;
  for i:=1 to n do write(anss[i],' ');
end.

{$R-,S-,Q-,I-,O+}
{$M 32000000}

{$APPTYPE CONSOLE}

uses Math;
const
    inf = round(1e9);
    maxn = round(1e5) + 200;
    md = round(1e9) + 7;
var
    n, i, mask, x, maxnum, cnt, ans, now : longint;
    a, res : array [1..111] of longint;
    dp, pred : array [0..111, 0..1 shl 17] of longint;
    submask, prime : array [1..61] of longint;

  function check(x : longint) : boolean;
  var
     i : longint;
  begin
    i := 2;
    while i * i <= x do
    begin
      if x mod i = 0 then
      begin
        check := false;
        exit;
      end;
      inc(i);
    end;
    check := true;
  end;

begin
  //assign (input, 'input.txt'); reset(input);
  //assign (output, 'output.txt'); rewrite(output);
  randomize;
  readln(n);
  for i := 1 to n do read(a[i]);

  maxnum := 59;
  cnt := 0;
  for i := 2 to maxnum do
  if check(i) then
  begin
    inc(cnt);
    prime[cnt] := i;
  end;

  for x := 1 to maxnum do
  begin
    submask[x] := 0;
    for i := 1 to cnt do
    if x mod prime[i] = 0 then submask[x] := submask[x] or (1 shl (i - 1));
  end;

  for i := 0 to n do
    for mask := 0 to 1 shl cnt - 1 do dp[i][mask] := inf;
  dp[0][0] := 0;

  for i := 0 to n - 1 do
    for mask := 0 to 1 shl cnt - 1 do
    if dp[i][mask] < inf then
      for x := 1 to maxnum do
      if submask[x] and mask = 0 then
        if dp[i + 1][submask[x] or mask] > dp[i][mask] + abs(a[i + 1] - x) then
        begin
          dp[i + 1][submask[x] or mask] := dp[i][mask] + abs(a[i + 1] - x);
          pred[i + 1][submask[x] or mask] := x;
        end;

  ans := inf; now := 0;
  for mask := 0 to 1 shl cnt - 1 do
  if ans > dp[n][mask] then
  begin
    ans := dp[n][mask];
    now := mask;
  end;

  for i := n downto 1 do
  begin
    res[i] := pred[i][now];
    now := now xor submask[res[i]];
  end;

  for i := 1 to n do write(res[i],' ');
end.

program B259;

const
	Inp = '';
	Oup = '';
	Maxstt = 131072;
	Maxn = 100;
	PrimeA : array [1..17] of integer = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59);

type
	Tnode=record
		 X,Y:longint;
		 Val:longint;
	end;

var
	Dp: array [0..MaxN,0..MaxStt] of longint;
	Trace: array[0..Maxn,0..MaxStt] of TNode;
	Stt: array [1..60] of longint;
	N: longint;
	A,ResA: array [1..maxN] of longint;

procedure Init();
var
	i,j: Longint;
begin
	for i:=1 to 60 do
		begin
			for j:=1 to 17 do
				begin
					if (i mod PrimeA[j] = 0) then
						begin
							Stt[i]:=Stt[i] or (1 shl (j-1));
						end;
				end;
		end;
end;

procedure Dpsearch();
var
	i,j,k,X,Y,Res: longint;
begin
	for i:=0 to N do
		for j:=0 to (1 shl 17)-1 do
			begin
				Dp[i,j]:=1000000000;
			end;
	Dp[0,0]:=0;
	for i:=1 to N do
		begin
			for j:=0 to (1 shl 17)-1 do
				begin
					for k:=1 to 60 do
						begin
							if ((j and Stt[k])=Stt[k]) then
								begin
									if Dp[i,j]>Dp[i-1,j-Stt[k]]+abs(A[i]-k) then
										begin
											Dp[i,j]:=Dp[i-1,j-Stt[k]]+abs(A[i]-k);
											Trace[i,j].X:=i-1;
											Trace[i,j].Y:=j-Stt[k];
											Trace[i,j].Val:=k;
										end;
								end;
						end;
				end;
		end;
	Res:=100000000;
	for j:=0 to (1 shl 17)-1 do if Dp[N,j]<Res then
		begin
			Res:=Dp[N,j];
			X:=N;
			Y:=J;
		end;
	while X>0 do
		begin
			ResA[X]:=Trace[X,Y].Val;
			i:=X;
			j:=Y;
			X:=Trace[i,j].X;
			Y:=Trace[i,j].Y;
		end;
end;

procedure Main();
var
	i: longint;
begin
	assign(input,inp); reset(input);
	assign(output,oup); rewrite(output);
	readln(N);
	for i:=1 to N do read(A[i]);
	Init();
	Dpsearch();
	for i:=1 to N do write(ResA[i],' ');
end;

begin
	Main();
end.

const
      prime:array[0..15] of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
      inf=1000000000;
var
    n,i,j,k,m,ans:longint;
    dp,pre:array[0..101,0..65537] of longint;
    a,b,f:array[0..101] of longint;

begin {main}
  readln(n);
  for i:=1 to n do read(a[i]);
  m:=1 shl 16-1;
  for i:=1 to m do dp[0][i]:=inf;dp[0][0]:=0;
  for i:=1 to 58 do
    begin
      f[i]:=0;
      for j:=0 to 15 do if i mod prime[j]=0 then f[i]:=f[i]+(1 shl j);
    end;
  for i:=1 to n do
    begin
      for j:=0 to m do dp[i][j]:=inf;
      for j:=0 to m do
        if dp[i-1][j]<inf then
          for k:=1 to 58 do
            if (j and f[k]=0) and (dp[i][j+f[k]]>dp[i-1][j]+abs(k-a[i])) then
              begin
                dp[i][j+f[k]]:=dp[i-1][j]+abs(k-a[i]);pre[i][j+f[k]]:=k;
              end;
    end;
  ans:=inf;
  for i:=0 to m do if dp[n][i]<ans then begin ans:=dp[n][i];k:=i;end;
  for i:=n downto 1 do
    begin
      b[i]:=pre[i][k];k:=k-f[pre[i][k]];
    end;
  for i:=1 to n-1 do write(b[i],' ');writeln(b[n]);
end.

const p:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var n,i,j,k,ans:longint;
    a,b:array[0..101]of longint;
    c:array[0..60]of longint;
    f,s:array[0..100,0..65535]of longint;
begin
  readln(n);
  for i:=1 to n do read(a[i]);
  for i:=1 to 59 do
    for j:=1 to 16 do
    if i mod p[j]=0 then c[i]:=c[i]+(1 shl (j-1));
  for i:=1 to n do
    for j:=0 to 65535 do
      f[i,j]:=maxlongint;
  for i:=1 to n do
    for j:=0 to 65535 do
      for k:=1 to 59 do
      if (j and c[k]=0) then
      begin
        if f[i,j or c[k]]>f[i-1,j]+abs(k-a[i]) then
        begin
          f[i,j or c[k]]:=f[i-1,j]+abs(k-a[i]);
          s[i,j or c[k]]:=k;
        end;
      end;
  ans:=maxlongint;
  for i:=0 to 65535 do
  if f[n,i]<ans then
  begin
    ans:=f[n,i];
    j:=i;
  end;
  for i:=n downto 1 do
  begin
    b[i]:=s[i,j];
    j:=j-c[s[i,j]];
  end;
  for i:=1 to n do write(b[i],' ');
end.

const p=1<<17;
var table,a,ans,b:array[0..101] of longint;
    f,g:array[0..101,0..p] of longint;
    flag:array[0..101] of boolean;
    tot,i,j,n,t,k:longint;
procedure typetype;
var i,j,k:longint;
begin
    fillchar(flag,sizeof(flag),true);
    tot:=0;
    for i:=2 to 60 do if flag[i] then
    begin
        table[tot]:=i;
        inc(tot);
        j:=i;
        while j<=60 do
        begin
                flag[j]:=false;
                inc(j,i);
        end;
    end;
end;
begin
    readln(n);
    for i:=1 to n do read(a[i]);
    typetype;
    for i:=1 to p-1 do
    for j:=0 to tot-1 do
    if (i mod table[j]=0) then b[i]:=b[i] or (1<<j);
    fillchar(f,sizeof(f),127);
    f[0,0]:=0;
    for i:=0 to n-1 do
    for j:=0 to p do
	begin
	if f[i,j]>100000000 then continue;
    for k:=1 to 60 do
    begin

        if (j and b[k])<>0 then continue;
        if f[i+1,j or b[k]]>abs(a[i+1]-k)+f[i,j] then
        begin
            f[i+1,j or b[k]]:=abs(a[i+1]-k)+f[i,j];
            g[i+1,j or b[k]]:=k;
        end;
    end;end;
    t:=0;
    for i:=1 to p do if f[n,i]<f[n,t] then t:=i;
    for i:=n downto 1 do
    begin
        ans[i]:=g[i,t];
        t:=t xor b[g[i,t]];
    end;
    for i:=1 to n-1 do write(ans[i],' ');
    writeln(ans[n]);
end.

uses Math,SysUtils;
type maxx=array[0..100,0..1 shl 17-1] of longint;
     mass=array[0..100] of longint;
const m2:array[1..17] of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59);
var l,d,k1,a,z1,md,k,b,e,n,ee:int64;
    s:string;
    dp,dp1,dp2:maxx;
    m,m1,m3:mass;
    i,z,j:longint;
begin
//   assign(input,'input.txt');
//   assign(output,'output.txt');
   readln(n);
   for i:=1 to n do
      read(m[i]);
   for i:=1 to 59 do
      Begin
         a:=i;
         for z:=1 to 17 do
            if a mod m2[z]=0
            then Begin
                    m1[i]:=m1[i] or (1 shl (z-1));
                    while (a mod m2[z]=0) do
                       a:=a div m2[z];
                 end;
      end;
   fillchar(dp,sizeof(dp),3);
   dp[0,0]:=0;
   for i:=1 to n do
      Begin
         for z:=1 to 59 do
          Begin
            for j:=0 to 1 shl 17-1 do
               if m1[z] and j=0
               then if dp[i,m1[z] or j]>dp[i-1,j]+abs(m[i]-z)
                    then Begin
                            a:=m1[z] or j;
                            dp[i,a]:=dp[i-1,j]+abs(m[i]-z);
                            dp1[i,a]:=j;
                            dp2[i,a]:=z;
                         end;
          end;
      end;
   a:=maxlongint;
   b:=0;
   for i:=0 to 1 shl 17-1 do
      if a>dp[n,i]
      then Begin
               a:=dp[n,i];
               b:=i;
           end;
   a:=n;
   while b>0 do
      Begin
         m3[a]:=dp2[a,b];
         b:=dp1[a,b];
         dec(a);
      end;
   while a>0 do
      Begin
         m3[a]:=1;
         dec(a);
      end;
   for i:=1 to n do
      write(m3[i],' ');
end.

{$APPTYPE CONSOLE}

program LittlePonyAndHarmonyChest;

type
    int16 = smallint;
    uint16 = word;
    int = Integer;

const
    SUM_BOUND: int = 10000;
    PRIMES: array[0..16] of int = (1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53);

var
    ResultsValues: array[0..100] of array[0..65536] of int;
    ResultsFrom: array[0..100] of array[0..65536] of Word;
    ResultsNumbers: array[0..100] of array[0..65536] of Byte;
    NumbersMasks: array[1..58] of int;

procedure Init;
var
    i, j: int;
begin
    for i := 1 to 58 do
    begin
        NumbersMasks[i] := 0;
        for j := 1 to High(PRIMES) do
            if (i mod PRIMES[J] = 0) then
                NumbersMasks[i] := NumbersMasks[i] or (1 shl (j - 1));
    end;
    for i := 0 to 100 do
        for j := 0 to 65536 do
            ResultsValues[i][j] := SUM_BOUND;
    ResultsValues[0][0] := 0;
end;

function Abs(const x: int): int;
begin
    if x < 0 then
        Result := -x
    else
        Result := x;
end;

procedure Solve(const n: int; const a: array of word);
var
    i, j, k: int;
    tmp: int;
begin
    for i := 1 to n do
    begin
        for j := Low(ResultsValues[i]) to High(ResultsValues[i]) do
        begin
            for k := Low(NumbersMasks) to High(NumbersMasks) do
            begin
                tmp := j or NumbersMasks[k];
                if (j and NumbersMasks[k] = 0) and
                    (ResultsValues[i][tmp] > ResultsValues[i - 1][j] + Abs(a[i] - k)) then
                begin
                    ResultsValues[i][tmp] := ResultsValues[i - 1][j] + Abs(a[i] - k);
                    ResultsFrom[i][tmp] := j;
                    ResultsNumbers[i][tmp] := k;
                end;
            end;
        end;
    end;
end;

procedure Print(const n: int);
var
    min: int;
    pos: int;
    i, j: int;
    a: array[1..100] of byte;
begin
    min := High(word);
    for i := 0 to 65536 do
        if min > ResultsValues[n][i] then
        begin
            min := ResultsValues[n][i];
            pos := i;
        end;

    for i := n downto 1 do
    begin
        a[i] := ResultsNumbers[i][pos];
        pos := ResultsFrom[i][pos];
    end;

    for i := 1 to n - 1 do
        Write(a[i], ' ');
    Writeln(a[n]);
end;

var
    n, i: int;
    data: array of word;

begin
    Readln(n);
    SetLength(data, n + 1);
    for i := 1 to n do
        Read(data[i]);

    Init();
    Solve(n, data);
    Print(n);
end.

Const CEILING = 60;
Var A, Perm, Answer, B, C: array[1..101] of longint;
    n, i, num: longint;
    minSum: longint;

Procedure Sort(n: longint);
var i, j, tmp: longint;
begin
 For i:= 1 to n-1 do
  For j:= 1 to n-i do
   if A[j] > A[j+1] then
    begin
     tmp:= A[j];
     A[j]:= A[j+1];
     A[j+1]:= tmp;

     tmp:= Perm[j];
     Perm[j]:= Perm[j+1];
     Perm[j+1]:= tmp;
    end;
end;

Function GCD(a, b: longint): longint;
begin
 while (a<>0) and (b<>0) do
  if a>b then
   a:= a mod b
  else
   b:= b mod a;

 GCD:= a or b;
end;

Procedure CheckComb(len: longint);
var i, sum: longint;
begin
 if len=0 then
  exit;
 sum:= 0;
 For i:= n downto n-len+1 do
  sum:= sum + abs(A[i]-C[len-(n-i)]);
// write(sum,'; ');
 For i:= n-len downto 1 do
  sum:= sum + abs(A[i]-1);
 //writeln(sum);

 if sum < minSum then
  begin
   minSum:= sum;
   For i:= 1 to n-len do
    Answer[i]:= 1;
   For i:= n-len+1 to n do
    Answer[i]:= C[i-(n-len+1)+1];
  end;
end;

Procedure Go(pos, len: longint);
var i, j: longint;
    good: boolean;
begin
// writeln('ZZ: ',pos,' ',len);
 if (pos=CEILING+1) or (len=num) then
  exit;

 For i:= pos to CEILING do
  begin
   good:= true;
   For j:= 1 to len do
    if GCD(i, C[j]) <> 1 then
     begin
      good:= false;
      break;
     end;

   if good then
    begin
     C[len+1]:= i;
     CheckComb(len+1);
     Go(i+1, len+1);
     C[len+1]:= 0;
    end;
  end;
end;

begin
 read(n);

 num:= 0;
 For i:= 1 to n do
  begin
   read(A[i]);
   Perm[i]:= i;
   if A[i] <> 1 then
    inc(num);
  end;
 if num>20 then
  num:= 20;

 Sort(n);

 minSum:= MAXLONGINT;
 Go(2, 0);

 if num = 0 then
  For i:= 1 to n do
   Answer[i]:= 1;

 For i:= 1 to n do
  B[ Perm[i] ]:= Answer[i];

 For i:= 1 to n do
  write(B[i], ' ');
end.

Const CEILING = 45;
Var A, Perm, Answer, B, C: array[1..101] of longint;
    n, i, num: longint;
    minSum: longint;

Procedure Sort(n: longint);
var i, j, tmp: longint;
begin
 For i:= 1 to n-1 do
  For j:= 1 to n-i do
   if A[j] > A[j+1] then
    begin
     tmp:= A[j];
     A[j]:= A[j+1];
     A[j+1]:= tmp;

     tmp:= Perm[j];
     Perm[j]:= Perm[j+1];
     Perm[j+1]:= tmp;
    end;
end;

Function GCD(a, b: longint): longint;
begin
 while (a<>0) and (b<>0) do
  if a>b then
   a:= a mod b
  else
   b:= b mod a;

 GCD:= a or b;
end;

Procedure CheckComb(len: longint);
var i, sum: longint;
begin
 if len=0 then
  exit;
 sum:= 0;
 For i:= n downto n-len+1 do
  sum:= sum + abs(A[i]-C[len-(n-i)]);
// write(sum,'; ');
 For i:= n-len downto 1 do
  sum:= sum + abs(A[i]-1);
 //writeln(sum);

 if sum < minSum then
  begin
   minSum:= sum;
   For i:= 1 to n-len do
    Answer[i]:= 1;
   For i:= n-len+1 to n do
    Answer[i]:= C[i-(n-len+1)+1];
  end;
end;

Procedure Go(pos, len: longint);
var i, j: longint;
    good: boolean;
begin
// writeln('ZZ: ',pos,' ',len);
 if (pos=CEILING+1) or (len=num) then
  exit;

 For i:= pos to CEILING do
  begin
   good:= true;
   For j:= 1 to len do
    if GCD(i, C[j]) <> 1 then
     begin
      good:= false;
      break;
     end;

   if good then
    begin
     C[len+1]:= i;
     CheckComb(len+1);
     Go(i+1, len+1);
     C[len+1]:= 0;
    end;
  end;
end;

begin
 read(n);

 num:= 0;
 For i:= 1 to n do
  begin
   read(A[i]);
   Perm[i]:= i;
   if A[i] <> 1 then
    inc(num);
  end;
 if num>15 then
  num:= 15;

 Sort(n);

 minSum:= MAXLONGINT;
 Go(2, 0);

 if num = 0 then
  For i:= 1 to n do
   Answer[i]:= 1;

 For i:= 1 to n do
  B[ Perm[i] ]:= Answer[i];

 For i:= 1 to n do
  write(B[i], ' ');
end.

Var A, Perm, Answer, B, C: array[1..101] of longint;
    n, i, num: longint;
    minSum: longint;

Procedure Sort(n: longint);
var i, j, tmp: longint;
begin
 For i:= 1 to n-1 do
  For j:= 1 to n-i do
   if A[j] > A[j+1] then
    begin
     tmp:= A[j];
     A[j]:= A[j+1];
     A[j+1]:= tmp;

     tmp:= Perm[j];
     Perm[j]:= Perm[j+1];
     Perm[j+1]:= tmp;
    end;
end;

Function GCD(a, b: longint): longint;
begin
 while (a<>0) and (b<>0) do
  if a>b then
   a:= a mod b
  else
   b:= b mod a;

 GCD:= a or b;
end;

Procedure CheckComb(len: longint);
var i, sum: longint;
begin
 if len=0 then
  exit;
 sum:= 0;
 For i:= n downto n-len+1 do
  sum:= sum + abs(A[i]-C[len-(n-i)]);
// write(sum,'; ');
 For i:= n-len downto 1 do
  sum:= sum + abs(A[i]-1);
 //writeln(sum);

 if sum < minSum then
  begin
   minSum:= sum;
   For i:= 1 to n-len do
    Answer[i]:= 1;
   For i:= n-len+1 to n do
    Answer[i]:= C[i-(n-len+1)+1];
  end;
end;

Procedure Go(pos, len: longint);
var i, j: longint;
    good: boolean;
begin
// writeln('ZZ: ',pos,' ',len);
 if (pos=31) or (len=num) then
  exit;

 For i:= pos to 30 do
  begin
   good:= true;
   For j:= 1 to len do
    if GCD(i, C[j]) <> 1 then
     begin
      good:= false;
      break;
     end;

   if good then
    begin
     C[len+1]:= i;
     CheckComb(len+1);
     Go(i+1, len+1);
     C[len+1]:= 0;
    end;
  end;
end;

begin
 read(n);

 num:= 0;
 For i:= 1 to n do
  begin
   read(A[i]);
   Perm[i]:= i;
   if A[i] <> 1 then
    inc(num);
  end;
 if num>10 then
  num:= 10;

 Sort(n);

 minSum:= MAXLONGINT;
 Go(2, 0);

 if num = 0 then
  For i:= 1 to n do
   Answer[i]:= 1;

 For i:= 1 to n do
  B[ Perm[i] ]:= Answer[i];

 For i:= 1 to n do
  write(B[i], ' ');
end.

Var A, Perm, Answer, B, C: array[1..101] of longint;
    n, i, num: longint;
    minSum: longint;

Procedure Sort(n: longint);
var i, j, tmp: longint;
begin
 For i:= 1 to n-1 do
  For j:= 1 to n-i do
   if A[j] > A[j+1] then
    begin
     tmp:= A[j];
     A[j]:= A[j+1];
     A[j+1]:= tmp;

     tmp:= Perm[j];
     Perm[j]:= Perm[j+1];
     Perm[j+1]:= tmp;
    end;
end;

Function GCD(a, b: longint): longint;
begin
 while (a<>0) and (b<>0) do
  if a>b then
   a:= a mod b
  else
   b:= b mod a;

 GCD:= a or b;
end;

Procedure CheckComb(len: longint);
var i, sum: longint;
begin
 if len=0 then
  exit;
 sum:= 0;
 For i:= n downto n-len+1 do
  sum:= sum + abs(A[i]-C[len-(n-i)]);
// write(sum,'; ');
 For i:= n-len downto 1 do
  sum:= sum + abs(A[i]-1);
 //writeln(sum);

 if sum < minSum then
  begin
   minSum:= sum;
   For i:= 1 to n-len do
    Answer[i]:= 1;
   For i:= n-len+1 to n do
    Answer[i]:= C[i-(n-len+1)+1];
  end;
end;

Procedure Go(pos, len: longint);
var i, j: longint;
    good: boolean;
begin
// writeln('ZZ: ',pos,' ',len);
 if (pos=31) or (len=num) then
  exit;

 For i:= pos to 30 do
  begin
   good:= true;
   For j:= 1 to len do
    if GCD(i, C[j]) <> 1 then
     begin
      good:= false;
      break;
     end;

   if good then
    begin
     C[len+1]:= i;
     CheckComb(len+1);
     Go(i+1, len+1);
     C[len+1]:= 0;
    end;
  end;
end;

begin
 read(n);

 num:= 0;
 For i:= 1 to n do
  begin
   read(A[i]);
   Perm[i]:= i;
   if A[i] <> 1 then
    inc(num);
  end;
 if num>15 then
  num:= 15;

 Sort(n);

 minSum:= MAXLONGINT;
 Go(2, 0);

 if num = 0 then
  For i:= 1 to n do
   Answer[i]:= 1;

 For i:= 1 to n do
  B[ Perm[i] ]:= Answer[i];

 For i:= 1 to n do
  write(B[i], ' ');
end.

uses math;
const
 d:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var
 q,z,mn,i,j,n,m,k,t,x:longint;
 a,b,ans:array[0..11111]of longint;
 mk,f,p:array[0..1111,0..1111]of longint;
begin
 readln(n);
 for i:=1 to n do read(a[i]);
 for i:=1 to 58 do for j:=1 to 16 do if i mod d[j]=0 then b[i]:=b[i] or(1 shl(j-1));
 fillchar(f,sizeof(f),63);f[0,1]:=0;
 for i:=1 to n do for j:=1 to 58 do for z:=1 to 58 do if mk[i-1,z] and b[j]=0 then
 begin
  k:=f[i-1,z]+abs(a[i]-j);
  f[i,j]:=min(f[i,j],k);
  mk[i,j]:=mk[i-1,z] or b[j];
  if f[i,j]=k then p[i,j]:=z;
 end;
 mn:=maxlongint;
 for i:=1 to 58 do if f[n,i]<mn then begin mn:=f[n,i];q:=i;end;
 for i:=n downto 1 do begin ans[i]:=q;q:=p[i,q];end;
 for i:=1 to n do write(ans[i],' ');
 writeln;
end.

uses math;
const
 d:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var
 q,z,mn,i,j,n,m,k,t,x:longint;
 a,b,ans:array[0..11111]of longint;
 mk,f,p,an:array[0..111,0..133333]of longint;
begin
 readln(n);
 for i:=1 to n do read(a[i]);
 for i:=1 to 58 do for j:=1 to 16 do if i mod d[j]=0 then b[i]:=b[i] or(1 shl(j-1));
 fillchar(f,sizeof(f),63);f[0,0]:=0;
 for i:=1 to n do for j:=1 to 58 do
 begin
  z:=not b[j];
  z:=z and(1 shl 16-1);q:=z;
  while true do
  begin
   k:=f[i-1,z]+abs(a[i]-j);
   f[i,z or b[j]]:=min(f[i,z or b[j]],k);
   if f[i,z or b[j]]=k then
   begin
    p[i,z or b[j]]:=z;an[i,z or b[j]]:=j;
   end;
   if z=0 then break;
   z:=(z-1)and q;
  end;
 end;
 mn:=maxlongint;
 for i:=1 to 77777 do if f[n,i]<mn then begin mn:=f[n,i];q:=i;end;
 for i:=n downto 1 do begin ans[i]:=an[i,q];q:=p[i,q];end;
 for i:=1 to n do write(ans[i],' ');
 writeln;
end.

uses math;
const
 d:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var
 q,z,mn,i,j,n,m,k,t,x:longint;
 a,b,ans:array[0..11111]of longint;
 mk,f,p:array[0..1111,0..1111]of longint;
begin
 readln(n);
 for i:=1 to n do read(a[i]);
 for i:=1 to 58 do for j:=1 to 16 do if i mod d[j]=0 then b[i]:=b[i] or(1 shl(j-1));
 fillchar(f,sizeof(f),63);f[0,1]:=0;
 for i:=1 to n do for j:=1 to 58 do for z:=1 to 58 do if mk[i-1,z] and b[j]=0 then
 begin
  k:=f[i-1,z]+abs(a[i]-j);
  f[i,j]:=min(f[i,j],k);
  if f[i,j]=k then
  begin
  mk[i,j]:=mk[i-1,z] or b[j];
  p[i,j]:=z;
 end;
 end;
 mn:=maxlongint;
 for i:=1 to 58 do if f[n,i]<mn then begin mn:=f[n,i];q:=i;end;
 for i:=n downto 1 do begin ans[i]:=q;q:=p[i,q];end;
 for i:=1 to n do write(ans[i],' ');
 writeln;
end.

{$APPTYPE CONSOLE}

program LittlePonyAndHarmonyChest;

type
    int16 = smallint;
    uint16 = word;
    int = Integer;

const
    SUM_BOUND: int = 30000;
    PRIMES: array[0..16] of byte = (1, 2, 3, 5, 7, 11, 13, 17, 23, 29, 31, 37, 41, 43, 47, 53, 59);

var
    ResultsValues: array[0..100] of array[0..65536] of Word;
    ResultsFrom: array[0..100] of array[0..65536] of Byte;
    ResultsNumbers: array[0..100] of array[0..65536] of Byte;
    NumbersMasks: array[1..59] of word;

procedure Init;
var
    i, j: int;
begin
    for i := 1 to 59 do
    begin
        NumbersMasks[i] := 0;
        for j := 1 to High(PRIMES) do
            if (i mod PRIMES[J] = 0) then
                NumbersMasks[i] := NumbersMasks[i] or (1 shl (j - 1));
    end;
    for i := 0 to 100 do
        for j := 0 to 65536 do
            ResultsValues[i][j] := SUM_BOUND;
    ResultsValues[0][0] := 0;
end;

function Abs(const x: int16): uint16;
begin
    if x < 0 then
        Result := uint16(-x)
    else
        Result := uint16(x);
end;

procedure Solve(const n: int; const a: array of word);
var
    i, j, k: int;
    tmp: int;
begin
    for i := 1 to n do
    begin
        for j := Low(ResultsValues[i]) to High(ResultsValues[i]) do
        begin
            for k := Low(NumbersMasks) to High(NumbersMasks) do
            begin
                tmp := j or NumbersMasks[k];
                if (j and NumbersMasks[k] = 0) and
                    (ResultsValues[i][tmp] > ResultsValues[i - 1][j] + Abs(a[i] - k)) then
                begin
                    ResultsValues[i][tmp] := ResultsValues[i - 1][j] + Abs(a[i] - k);
                    ResultsFrom[i][tmp] := j;
                    ResultsNumbers[i][tmp] := k;
                end;
            end;
        end;
    end;
end;

procedure Print(const n: int);
var
    min: word;
    pos: int;
    i, j: int;
    a: array[1..100] of byte;
begin
    min := High(word);
    for i := 0 to 65536 do
        if min > ResultsValues[n][i] then
        begin
            min := ResultsValues[n][i];
            pos := i;
        end;

    for i := n downto 1 do
    begin
        a[i] := ResultsNumbers[i][pos];
        pos := ResultsFrom[i][pos];
    end;

    for i := 1 to n - 1 do
        Write(a[i], ' ');
    Writeln(a[n]);
end;

var
    n, i: int;
    data: array of word;

begin
    Readln(n);
    SetLength(data, n + 1);
    for i := 1 to n do
        Read(data[i]);

    Init();
    Solve(n, data);
    Print(n);
end.

{$APPTYPE CONSOLE}

program LittlePonyAndHarmonyChest;

type
    int16 = smallint;
    uint16 = word;
    int = Integer;

const
    SUM_BOUND: int = 30000;
    PRIMES: array[0..17] of byte = (1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59);

var
    ResultsValues: array[0..100] of array[0..65536] of int;
    ResultsFrom: array[0..100] of array[0..65536] of Byte;
    ResultsNumbers: array[0..100] of array[0..65536] of Byte;
    NumbersMasks: array[1..59] of int;

procedure Init;
var
    i, j: int;
begin
    for i := 1 to 59 do
    begin
        NumbersMasks[i] := 0;
        for j := 1 to High(PRIMES) do
            if (i mod PRIMES[J] = 0) then
                NumbersMasks[i] := NumbersMasks[i] or (1 shl (j - 1));
    end;
    for i := 0 to 100 do
        for j := 0 to 65536 do
            ResultsValues[i][j] := SUM_BOUND;
    ResultsValues[0][0] := 0;
end;

function Abs(const x: int): int;
begin
    if x < 0 then
        Result := -x
    else
        Result := x;
end;

procedure Solve(const n: int; const a: array of word);
var
    i, j, k: int;
    tmp: int;
begin
    for i := 1 to n do
    begin
        for j := Low(ResultsValues[i]) to High(ResultsValues[i]) do
        begin
            for k := Low(NumbersMasks) to High(NumbersMasks) do
            begin
                tmp := j or NumbersMasks[k];
                if (j and NumbersMasks[k] = 0) and
                    (ResultsValues[i][tmp] > ResultsValues[i - 1][j] + Abs(a[i] - k)) then
                begin
                    ResultsValues[i][tmp] := ResultsValues[i - 1][j] + Abs(a[i] - k);
                    ResultsFrom[i][tmp] := j;
                    ResultsNumbers[i][tmp] := k;
                end;
            end;
        end;
    end;
end;

procedure Print(const n: int);
var
    min: word;
    pos: int;
    i, j: int;
    a: array[1..100] of byte;
begin
    min := High(word);
    for i := 0 to 65536 do
        if min > ResultsValues[n][i] then
        begin
            min := ResultsValues[n][i];
            pos := i;
        end;

    for i := n downto 1 do
    begin
        a[i] := ResultsNumbers[i][pos];
        pos := ResultsFrom[i][pos];
    end;

    for i := 1 to n - 1 do
        Write(a[i], ' ');
    Writeln(a[n]);
end;

var
    n, i: int;
    data: array of word;

begin
    Readln(n);
    SetLength(data, n + 1);
    for i := 1 to n do
        Read(data[i]);

    Init();
    Solve(n, data);
    Print(n);
end.

const p:array[1..16]of longint=(2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53);
var n,i,j,k,l,sum,now,min:longint; b:boolean; a:array[0..100]of longint;
    d:array[0..65535,0..50]of longint;
    g,h,c,ans:array[0..65535]of longint; f,r:array[0..100,0..65535]of longint;
begin
  readln(n);
  for i:=1 to n do read(a[i]);
  k:=0;
  for i:=0 to 65535 do
  begin
    sum:=1;
    b:=true;
    for j:=0 to 15 do
    begin
      if (i shr j) and 1=1 then sum:=sum*p[16-j];
      if sum>=59 then
      begin
        b:=false;
        break;
      end;
    end;
    if b then
    begin
      inc(k);
      g[k]:=i;
      h[k]:=sum;
    end;
  end;
  for i:=0 to 65535 do
    for j:=1 to k do
    if (i and g[j])=0 then
    begin
      inc(c[i]);
      d[i,c[i]]:=j;
    end;
  for i:=0 to n do
    for j:=0 to 65535 do
      f[i,j]:=10000;
  f[0,0]:=0;
  for i:=0 to n-1 do
    for j:=0 to 65535 do
    if f[i,j]<10000 then
      for l:=1 to c[j] do
      if f[i,j]+abs(h[d[j,l]]-a[i+1])<f[i+1,j+g[d[j,l]]] then
      begin
        f[i+1,j+g[d[j,l]]]:=f[i,j]+abs(h[d[j,l]]-a[i+1]);
        r[i+1,j+g[d[j,l]]]:=d[j,l];
      end;
  min:=10000;
  for i:=0 to 65535 do if f[n,i]<min then
  begin
    min:=f[n,i];
    now:=i;
  end;
  for i:=n downto 1 do
  begin
    ans[i]:=h[r[i,now]];
    now:=now-g[r[i,now]];
  end;
  for i:=1 to n-1 do write(ans[i],' ');
  writeln(ans[n]);
end.