var x,y,x1,y1,f,l:longint;a,b,c:array[1..1000] of byte;
   i,k,s,r,w,z:word;
begin
read(x, y);
l:=2;w:=0;
While (f<>1)and(l<=10) do begin
i:=1;
x1:=x;
s:=0;
c:=a;
b:=a;

Repeat
c[i]:=x1 mod l;
x1:=x1 div l;
inc(i);
inc(s)
until x1=0;

y1:=y;k:=0;
i:=1;
Repeat
b[i]:=y1 mod l;
y1:=y1 div l;
inc(i);
inc(k)
until y1=0;

r:=b[k];z:=1;i:=s;

Repeat
If c[i]=r then begin r:=b[k-z];inc(z);end;
dec(i);
until (z=k+1)or(i=0);
If z=k+1 then begin f:=1;w:=l;end;
inc(l);
end;
If w=0 then writeln('No solution')
else writeln(w)


end.

Help me please...