Cod sursa(job #357560)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 19 octombrie 2009 19:53:47
Problema Multiplu Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
var w,v:array[1..30000]of byte;
a,b,aux,d,i,n:integer;
x:longint;
nr:int64;

function verif(a:longint):boolean;
var ok:boolean;
begin
ok:=true;
while a<>0 do begin
      if ((a mod 10)<>0)and((a mod 10)<>1) then begin
         ok:=false;
         break;
         end;
      a:=a div 10;
end;
verif:=ok;
end;

begin
assign(input,'multiplu.in');reset(input);
assign(output,'multiplu.out');rewrite(output);
read(a,b);

aux:=a; d:=2;
while aux<>1 do begin
      if aux mod d=0 then while aux mod d=0 do begin
                                    inc(v[d]);
                                    aux:=aux div d;
                                    end;
      inc(d);
end;

aux:=b; d:=2;
while aux<>1 do begin
      if aux mod d=0 then while aux mod d=0 do begin
                                    inc(w[d]);
                                    aux:=aux div d;
                                    end;
      inc(d);
end;

if a>b then n:=a
       else n:=b;
x:=1;
for d:=2 to n do begin
    if v[d]<>0 then begin
               if v[d]>w[d] then begin for i:=1 to v[d] do x:=x*d; end
                            else begin for i:=1 to w[d] do x:=x*d; end;
               end
               else if w[d]<>0 then for i:=1 to w[d] do x:=x*d;
end;

nr:=x;
while not verif(nr) do nr:=nr+x;

write(nr);
close(output);
end.