Cod sursa(job #159444)

Utilizator Marinescu_DanyelMarinescu George Marinescu_Danyel Data 14 martie 2008 09:46:25
Problema Multiplu Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.66 kb
program cel_mai_mic_mult_form_din_0_si_1;
var a,b,m:longint;f,g:text;s,s1,s2:string;

function cmmmc(a,b:longint):longint;
var cmmdc:longint;a2,b2,r:longint;
begin
a2:=a;
b2:=b;
repeat
r:=a2 mod b2;
a2:=b2;
b2:=r;
until r=0;
cmmdc:=a2;
cmmmc:=(a div cmmdc)*b;
end;

procedure adunare(a,b:string;var c:string);
var i,j,minte,x,k:longint;
begin
minte:=0;
k:=1;
i:=length(a);
j:=length(b);
c:='';
while (i>0) and (j>0) do
begin
x:=ord(a[i])+ord(b[j])-96 + minte;
minte:=x div 10;
x:=x mod 10;
c[k]:=chr(x+48);
c:=c+c[k];
inc(k);
dec(i);
dec(j);
end;

while (i>0) do
begin
x:=ord(a[i])-48 + minte;
minte:=x div 10;
x:=x mod 10;
c[k]:=chr(x+48);
c:=c+c[k];
inc(k);
dec(i);
end;

while (j>0) do
begin
x:=ord(b[j])-48 + minte;
minte:=x div 10;
x:=x mod 10;
c[k]:=chr(x+48);
c:=c+c[k];
inc(k);
dec(j);
end;

if minte<>0 then
	begin
	c[k]:=chr(minte+48);
  c:=c+c[k];
  end;
end;

procedure verificare;
var ok:boolean;x,i,k,k2,j:integer;m1,m2:longint;c:char;
begin
s:='';
s1:='';
m1:=cmmmc(a,b);
i:=0;
str(m1,s1);
repeat
i:=i+1;
s2:='';
for k:=1 to i do
    begin
    for j:=1 to (length(s2) div 2) do
        begin
        c:=s2[j];
        s2[j]:=s2[length(s2)-j+1];
        s2[length(s2)-j+1]:=c;
        end;
    adunare(s1,s2,s2);
    end;
s:=s2;
k2:=1;
repeat
ok:=false;
if (s2[k2]='0') or (s2[k2]='1') then
   begin
   ok:=true;
   k2:=k2+1;
   end;
until (ok=false) or (k2=length(s2)+1);
until k2=length(s2)+1;
end;

begin
assign(f,'multiplu.in');
reset(f);
read(f,a);
read(f,b);
close(f);
verificare;
assign(g,'multiplu.out');
rewrite(g);
writeln(g,s);
close(g);
end.