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.