Cod sursa(job #223232)

Utilizator mari_anaMariana Gheorghe mari_ana Data 27 noiembrie 2008 19:47:40
Problema Multiplu Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.81 kb
program multiplu;
const ct=125000;
type adresa=^nod;
		 nod=record
     		 cif:boolean;
         dupa,inainte:adresa;
         rest:longint;
         end;
var ult,cap,gasit,p,c,d:adresa;
    asd,x,a,b:longint;
    m:string;
    ok:boolean;
    v:array [0..ct] of word;
    f:text;

function conditie(nr:longint):boolean;
var ind,ind2:longint;
begin
ind:=nr mod ct;
ind2:=nr div ct;
nr:=v[ind];
nr:=nr shr ind2;
if nr and 1=1 then
	conditie:=false
else
	conditie:=true;
end;


procedure inlocuieste(nr:longint);
var ind,ind2:longint;
begin
ind:=nr mod ct;
ind2:=nr div ct;
nr:=1 shl ind2;
v[ind]:=v[ind] or nr;
end;

begin
assign(f,'multiplu.in'); reset(f);
readln(f,a,b);
close(f);
x:=a*b;
while a<>b do
	if a>b then
  	a:=a-b
  else
  	b:=b-a;
x:=x div a;
new(cap);
cap^.cif:=true; cap^.dupa:=nil; cap^.inainte:=nil; cap^.rest:=1;
p:=cap; new(d); d:=cap; ult:=cap;
ok:=false;
v[1]:=1;
while not ok do
	begin
  asd:=(p^.rest*10) mod x;
  if conditie(asd) then
  	begin
  	new(c);
  	c^.cif:=false;
  	c^.dupa:=nil; c^.inainte:=p;
  	c^.rest:=asd;
    inlocuieste(c^.rest);
  	ult^.dupa:=c;
    ult:=ult^.dupa;
  	if c^.rest=0 then begin
  									  ok:=true;
                      gasit:=c;
                      end
    end;
  asd:=(asd+1) mod x;
	if conditie(asd) then
  	begin
  	new(d);
    d^.cif:=true;
    d^.rest:=asd;
    ult^.dupa:=d;
    ult:=ult^.dupa;
		inlocuieste(d^.rest);
    d^.dupa:=nil; d^.inainte:=p;
    if d^.rest=0 then begin
      								ok:=true;
                      gasit:=d;
                      end
    end;
  p:=p^.dupa
end;
p:=gasit;
m:='';
while p^.inainte<>nil do begin
	if p^.cif then
    m:='1'+m
  else
  	m:='0'+m;
  p:=p^.inainte
end;
m:='1'+m;
assign(f,'multiplu.out'); rewrite(f);
writeln(f,m);
close(f);
end.