Informatika gyűjtemény

Egy szinttel feljebb pr_szojat.pas

2004050607080910

<<  13. óra  >>

<<  Szójáték  >>

NézetNyomtat

pr_szojat.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 1 KB
program szojat;

var so,be,ki:text;
szot:array[1..1337] of string; szdb:integer; szab:integer; //1:A 2:B szabaly
i,j:integer; c:string; kez, veg: integer; //valtozok, kezdo es veg szo
graf:array[1..1337,1..1337] of byte; //ebben tarolom a grafot
sor:array[1..1337] of integer; s1, s2: integer; //sor, eleje, vege
tav,apa:array[1..1337] of integer; //ki az apam, milyen tavol vagyok

procedure szome(a,b:integer); //behuz egy elet, ha behuzhato
var ii:integer; hk:integer; db:integer; //hk:szavak hosszanak kulonbsege
begin db:=0; //kulonbsegek darabszama
hk:=length(szot[b])-length(szot[a]); //legyen a<b (marmint hosszuk):
if hk<0 then begin ii:=a; a:=b; b:=ii; hk:=0-hk; end; //csere
for ii:=1 to length(szot[a]) do if szot[a][ii]<>szot[b][ii] then inc(db);
if (hk=0) and (db=1) then begin graf[a,b]:=1; graf[b,a]:=1; end; //ha1 kul.
if ((hk=1) and (db=0)) and (szab=2) then graf[a,b]:=1; //ha B verzio akkor...
end;


begin
assign(so,'SZOTAR.BE'); reset(so); //beolvas szotar
readln(so,szdb);
for i:=1 to szdb do readln(so,szot[i]);
close(so);
assign(be,'JATEK.BE'); reset(be); //beolvas kezdo, veg, szabaly
readln(be,c); if (c='A') or (c='a') then szab:=1 else szab:=2;
readln(be,c); for i:=1 to szdb do if szot[i]=c then kez:=i;
readln(be,c); for i:=1 to szdb do if szot[i]=c then veg:=i;
close(be);

for i:=1 to szdb do for j:=1 to szdb do graf[i,j]:=0; //grafurit
for i:=1 to szdb do for j:=1 to szdb do szome(i,j); //graffeltolt
for i:=1 to szdb do begin tav[i]:=-1; apa[i]:=0; end;  //nullaztomb

sor[1]:=kez; s1:=1; s2:=1; tav[kez]:=0; apa[kez]:=kez; //kezdo elem...


while s1<=s2 do begin  //bejaras (szelessegi, addig mig kezdet<=veg)
for i:=1 to szdb do if (apa[i]=0) and (graf[sor[s1],i]>0) then begin
apa[i]:=sor[s1]; tav[i]:=tav[sor[s1]]+1; inc(s2); sor[s2]:=i; //berak
end;
inc(s1); //kivesz
end;

assign(ki,'JATEK.KI'); rewrite(ki); //kiiras...
if tav[veg]=-1 then writeln(ki,'NEM') else writeln(ki,'IGEN ',tav[veg]);
for i:=1 to szdb do if tav[i]>-1 then write(ki,szot[i],' ');
close(ki);

end.
(Vissza)