Listing GIMNAST.PAS

{$r-,s-} 
 {$M 65000,0,655360} 
 
  type vector=array[-2..10001] of Char; 
 var init,a,b,st:vector; 
 n,i,j,r:Integer; 
 rule:array[0..7] of string; 
 f:Text; 
 nr,ntr,basis,period,npas:Longint; 
 
 procedure citire; 
 begin 
 Assign(f,'GYM.IN'); Reset(f); 
 Readln(f,ntr); 
 n:=0; 
 while not Seekeoln(f) do 
 begin 
 Inc(n); 
 Read(f,st[n]) 
 end; 
 if ntr=0 
 then 
 begin 
 Assign(f,'GYM.OUT'); Rewrite(f); 
 for i:=1 to n do Write(f,st[i]); 
 Close(f); 
 Halt 
 end; 
 for i:=1 to n do 
 if st[i]='J' 
 then a[i-1]:='J' 
 else a[i-1]:='S'; 
 a[n]:=a[0]; 
 a[-1]:=a[n-1]; 
 a[-2]:=a[n-2]; 
 b:=a; 
 init:=a; 
 r:=-1; 
 while not Seekeof(f) do 
 begin 
 Inc(r); 
 Readln(f,rule[r]) 
 end; 
 Close(f) 
 end; 
 
 procedure modifica(var a:vector); 
 var c:vector; 
 i,j:Integer; 
 begin 
 for i:=0 to n-1 do 
 for j:=0 to r do 
 if (a[i]=rule[j,1]) 
and 
(a[i-2]=rule[j,2]) 
and 
 (a[i+1]=rule[j,3]) 
  then c[i]:=rule[j,4]; 
 a:=c; 
 a[-2]:=c[n-2]; a[-1]:=c[n-1]; a[n]:=a[0] 
 end; 
 
 procedure transf; 
 begin 
 Inc(npas); 
 modifica(a); modifica(b); modifica(b) 
 end; 
 
 function egal(var a,b:vector):Boolean; 
 var i:Integer; 
 begin 
 egal:=true; 
 for i:=0 to n-1 do 
 if a[i]<>b[i] 
 then 
 begin 
 egal:=false; 
 Exit 
 end 
 end; 
 
 procedure baza_perioada; 
 begin 
 a:=init; 
 basis:=0; 
 while not egal(a,b) do 
 begin Inc(basis); modifica(a) end; 
 period:=0; 
 repeat 
 Inc(period); 
 modifica(a); 
 until egal(a,b); 
 if basis=period then basis:=0 
 end; 
 
 procedure pozitie; 
 begin 
 if ntr<=basis 
 then nr:=ntr 
 else nr:=basis+(ntr-basis) mod period 
 end; 
 
 procedure prelucrare; 
 begin 
 npas:=0; 
 repeat transf until egal(a,b); 
 baza_perioada; 
 pozitie 
 end; 
 
 procedure afisare; 
 var i:Longint; 
 begin 
 a:=init; 
 if nr=0 then nr:=basis+period; 
 for i:=1 to nr do modifica(a); 
 Assign(f,'GYM.OUT'); Rewrite(f); 
 for i:=0 to n-1 do Write(f,a[i]); 
 Close(f) 
 end; 
 
 Begin 
 citire; prelucrare; afisare 
 End. 

[cuprins]