Listing FRACTAL.PAS
Program Ratio;
type Matrix=array[0..2, 0..2] of Boolean;
var PX,QX,PY,QY,PXPeriod,PYPeriod,i:Integer;
NIter:LongInt;
Cut:Matrix;
Ok:Boolean;
Function Exp(Q:LongInt;K:Integer):Integer;
{ La ce putere e K in descompunerea lui Q }
var IAux:Integer;
begin
IAux:=0;
while Q mod K=0 do
begin Inc(IAux); Q:=Q div K end;
Exp:=IAux
end;
Function Cememedece(A, B:Integer):Integer;
var IAux:Integer;
begin
while B<>0 do
begin IAux:=A; A:=B; B:=IAux mod B end;
Cememedece:=A
end;
Procedure ReadData;
var C,NE,i,j:Integer;
begin
for i:=0 to 2 do
for j:=0 to 2 do Cut[i,j]:=false;
ReadLn(PX,QX); C:=Cememedece(PX,QX);
PX:=PX div C; QX:=QX div C;
ReadLn(PY,QY); C:=Cememedece(PY,QY);
PY:=PY div C; QY:=QY div C;
ReadLn(NE);
for i:=1 to NE do
begin
Read(C);
Cut[(C-1) mod 3,(C-1) div 3]:=true
end;
ReadLn
end;
Function Max(A,B:Integer):Integer;
begin
if A>B then Max:=A else Max:=B
end;
Procedure TakeDigit;
var DX,DY:Integer;
begin
DX:=PX*3 div QX; PX:=PX*3 mod QX;
DY:=PY*3 div QY; PY:=PY*3 mod QY;
Ok:=Ok and not Cut[DX,DY];
Inc(NIter)
end;
Begin
Assign(Input,'fractal.in');Reset(Input);
while not SeekEof do
begin
ReadData;
Ok:=True; NIter:=0;
for i:=1 to Max(Exp(QX,3),Exp(QY,3)) do
TakeDigit;
PXPeriod:=PX; PYPeriod:=PY;
repeat
TakeDigit
until ((PX=PXPeriod) and
(PY=PYPeriod)) or not Ok;
if Ok then Write('DA ')
else Write('NU ');
WriteLn(' -- ',NIter, ' iteratii')
end;
Close(Input)
End.