Az alábbi letöltési lehetőségek közül választhatsz: (
segítség)
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: utf-8
Méret: 2 KB
program ana;
type PElem = ^Elem;
Elem = Record
data : string;
next : PElem;
end;
Lista = Record
head, tail : PElem;
db : longint;
end;
PFaelem= ^Faelem;
Faelem = Record
kulcs : string;
szavak: Lista;
bal,jobb : PFaelem;
end;
Fa = PFaelem;
procedure initLista(var L : lista);
begin
new(L.head);
new(L.tail);
L.head^.data := '';
L.head^.next := L.tail;
L.tail^.data := 'zzzzzzzzzz';
L.tail^.next := NIL;
L.db := 0;
end;
procedure insert(var L : lista; s : string);
var p : PElem;
tmp : PElem;
begin
p := L.head;
while s > p^.next^.data do p := p^.next;
L.db := L.db+1;
new(tmp);
tmp^.next := p^.next;
tmp^.data := s;
p^.next := tmp;
end;
procedure printList(L : lista);
var p : PELem;
begin
p := L.head^.next;
write(L.db,' : ');
while p <> L.tail do
begin
write(p^.data,' ');
p := p^.next;
end;
end;
procedure insertFa(kulcs,szo: string; var F : Fa);
begin
if F = NIL then
begin
new(F);
F^.bal := NIL;
F^.jobb := NIL;
initLista(F^.szavak);
F^.kulcs:=kulcs;
insert(F^.szavak,szo);
end
else if F^.kulcs = kulcs then
insert(F^.szavak,szo)
else if kulcs < F^.kulcs
then insertFa(kulcs, szo, F^.bal)
else insertFa(kulcs, szo, F^.jobb);
end;
procedure bejarFa(F : Fa);
begin
if F <> NIL then
begin
bejarFa(F^.bal);
write(F^.kulcs,' -> ');
printList(F^.szavak);
writeln;
bejarFa(F^.jobb);
end;
end;
function rendez(s:string):string;
var h,i,j : byte;
c : char;
begin
h := length(s);
for i := 1 to h-1 do
for j := i+1 to h do
if s[i] > s[j] then begin
c := s[i]; s[i] := s[j]; s[j] := c;
end;
rendez := s;
end;
procedure beolvas(fn:string);
var be : text; sor : string;
F : Fa;
begin
assign(be,fn);
reset(be);
F := NIL;
while not eof(be) do
begin
readln(be, sor);
if length(sor)>0 then insertFA(rendez(sor),sor,F);
end;
close(be);
bejarFa(F);
end;
begin
beolvas('brit.txt');
end.
