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] |