{$apptype console} const len=3215; var words:array[1..4,1..len] of integer; procedure loadwords; var f:text; i:Integer; j:integer; s:string; c:char; begin for i:=1 to 4 do begin str(i,s); s:='basicword'+s+'.txt'; assign(f,s); reset(f); for j:=1 to len do begin read(f,c); words[i,j]:=ord(c)-ord('a'); end; close(f); end; end; var sum:array[1..3*len] of integer; procedure outno1; begin writeln('check1: no'); readln; end; procedure outno2; begin writeln('check2: no'); readln; end; procedure outno3; begin writeln('check3: no'); readln; end; procedure check1; var i,j:integer; s1,s2:integer; begin for s1:=1 to 4 do for s2:=1 to 4 do if s1<>s2 then begin for i:=1 to len do sum[i]:=words[s1,i]; for i:=1 to len do sum[i+len]:=words[s2,i]; end; for i:=1 to len-2 do begin for s1:=1 to 4 do begin j:=1; while j<=len do begin if sum[i+j]<>words[s1,j] then break; inc(j); end; if j>len then outno1; end; end; writeln('check1: ok'); end; procedure check2; var i,j,k,l:integer; s1,s2,s3:integer; begin for s1:=1 to 4 do for s2:=1 to 4 do if (s1<>s2) and odd(s2-s1) then begin for s3:=1 to 4 do if (s2<>s3) and odd(s2-s3) then begin for i:=1 to len do sum[i]:=words[s1,i]; for i:=1 to len do sum[i+len]:=words[s2,i]; for i:=1 to len do sum[i+2*len]:=words[s3,i]; for j:=1 to 3*len-1 do for k:=1 to ((3*len-j+1) div 2) do begin l:=1; while l<=k do begin if sum[j+l-1]<>sum[j+l+k-1] then break; inc(l); end; if l>k then outno2; end; end; end; writeln('check2: ok'); end; procedure check3; var s1,s2,s3,s4:integer; i,j:integer; begin for s1:=1 to 4 do for s2:=1 to 4 do for s3:=1 to 4 do if (s1<>s2) and (s2<>s3) then begin for i:=1 to len do sum[i]:=words[s1,i]; for i:=1 to len do sum[i+len]:=words[s2,i]; for i:=1 to len do sum[i+2*len]:=words[s3,i]; for i:=2 to len do begin j:=1; while j<=len do begin if sum[i+j-1]<>sum[i+j+len-1] then break; inc(j); end; if j>len then outno3; end; end; writeln('check3: ok'); end; begin loadwords; check1; check2; check3; readln; end.