Mam kilka procedur ale niestety coś się zapętla i nie mogę rozwiązać problemu...
program huffman;
uses crt;
type
drzewo=^wierzch;
wierzch=record
litera:char; {jaka litera}
ilosc:integer; {ilość wystąpień litery}
kod:string;
lewy:drzewo; {dla 0}
prawy:drzewo; {dla 1}
pred:drzewo; {określenie następnika w liście}
end;
var plik1, plik2 : text;
znak : char;
top, lewy, prawy : drzewo;
{przypisanie nazw plików do przetwarzania}
procedure nazwy_plikowHUFF(var plik1:text; var plik2:text);
var a,b:string;
begin
writeln('Podaj nazwe pliku z tekstem do okreslenia kodow znakow');
readln(a);
assign(plik1,a);
reset(plik1);
writeln('Podaj nazwe pliku w ktorym ma byc zapisany wynik');
readln(b);
assign(plik2,'C:\wynik.txt');
rewrite(plik2);
end;
{wyświetlenie listy elementów po zczytaniu z tekstu}
procedure drukuj_listaHUFF(top:drzewo);
var kopia:drzewo;
begin
writeln(' litera | ilosc wystapien w tekscie');
while top<>nil do
begin
writeln(' ',top<sup>.litera,'-',top</sup>.ilosc);
top:=top^.pred; <u>{właśnie tu coś się psuje!!!}</u><b>
end;
readln;
end;
{dodawanie elementu jest powiązane z "sortowaniem". Nowo sklejane
sklejane elementy są wstawiane w odpowiednie miejsce na liście już
istniejących dzieki temu nie ma procedury czasochłonnego sortowania}
procedure dodajHUFF(var top:drzewo; ilosc:integer; litera:char; l1:drzewo; p1:drzewo);
var p, pamiec, kopia:drzewo;
pozycja:integer;
begin
pozycja:=0; {dodanie elementu do listy}
kopia:=top;
while top<>nil do
begin
if top^.ilosc>ilosc then {wstawianie gdy ilość wystąpień znaku jest większa}
begin
new(p);
p^.ilosc:=ilosc; {wpisanie wartości ilości wystąpień litery}
p^.litera:=litera; {sama litera}
p^.kod:=''; {kody znaków są na początku puste}
if litera=chr(0) then
begin
p^.lewy:=l1;
p^.prawy:=p1;
end
else
begin
p^.lewy:=nil;
p^.prawy:=nil;
end;
p^.pred:=top; {przypisanie wskaźników do potomków jesli jest to węzeł}
top:=p;
pamiec^.pred:=p;
break; {przerwanie pętli}
end;
if top^.ilosc=ilosc then {ta sama funkcja ale gdy ilość wystąpień jest równa}
begin
if top^.litera<litera then {segregacja po literach}
begin
pamiec:=top; {jeżeli litera jest większa niż przerwana pętla}
top:=top^.pred; {dostawiony jest element przed kolejny na liście}
pozycja:=1; {przykład a<g (oba po 3 wystąpienia więc przerwa}
continue; {top przeskakuje teraz g-3 < niż inna litera np d-5}
{więc wstawia element przed d-5 a za a-3 (a-3 g-3 d-5)}
end
else
begin
new(p); {jeżeli litera jest mniejsza to wstawia przed top tak jak normalnie}
p^.ilosc:=ilosc;
p^.litera:=litera;
p^.kod:='';
if litera=chr(0) then
begin
p^.lewy:=l1;
p^.prawy:=p1;
end
else
begin
p^.lewy:=nil;
p^.prawy:=nil;
end;
p^.pred:=top;
top:=p;
pamiec^.pred:=p;
break;
end;
end
else {przejście do kolejnego elementu jeśli nie zostało wykonane żadne dodanie z powyższych}
begin
pamiec:=top;
top:=top^.pred;
pozycja:=1;
end;
end;
{dodanie elementu gdy lista jest pusta lub gdy dodawany element m zwiększa ilośc wystąpień niż wcześniejsze}
if top=nil then
begin
new(p);
p^.ilosc:=ilosc;
p^.litera:=litera;
p^.kod:='';
if litera=chr(0) then
begin
p^.lewy:=l1;
p^.prawy:=p1;
end
else
begin
p^.lewy:=nil;
p^.prawy:=nil;
end;
p^.pred:=nil;
top:=p;
pamiec^.pred:=p;
end;
if pozycja=1 then top:=kopia;
end;
procedure wczytajHUFF(var plik:text; var top:drzewo);
var a:char;
pamiec:drzewo;
i, litera:integer;
tablica:array[0..256] of integer;
begin
pamiec:=nil;
for i:=0 to 256 do
tablica[i]:=0;
while not eof(plik1) do {wczytanie z pliku ilości wystąpień liter}
begin
read(plik1, a);
litera:=ord(a);
tablica[litera]:=tablica[litera]+1; {dodanie ilości wystąpień}
end;
for i:=0 to 256 do {wczytanie liter które wystąpiły w tekście do listy zawierającej znaki do zakodowania}
begin
dodajHUFF(top, tablica[i], chr(i), pamiec, pamiec);
end;
end;
{przesuniecie wskaźnika na kolejny element}
procedure usunHUFF(var top:drzewo);
begin
top:=top^.pred; {elementu nie są usuwane tylko doklejane jako prawy i lewy nowego}
end;
procedure tworz_drzewoHUFF(var top:drzewo);
var a:char;
p,pamiec,kopia:drzewo;
z,ilosc:integer;
begin {dopoki na liście korzenia znajdują się 2 korzenie}
kopia:=top; {nastepuje scalanie w drzewo}
while (top<>nil)and(top^.pred<>nil) do
begin
pamiec:=top; {wskaźniki na 2 "pierwsze"(w danej pętli) elementy}
top:=top^.pred;
pamiec^.kod:='0'; {z lewej dodajemy kod 0}
top^.kod:='1'; {z prawej kod 1 do elementów które są dodawane}
ilosc:= pamiec<sup>.ilosc + top</sup>.ilosc; {zsumowanie ilości wystąpien znaków}
{z 2 pierwszych miejsc listy}
dodajHUFF(kopia,ilosc,chr(0),pamiec,top);
top:=top^.pred;
{utworzenie nowego elementu który ma 2 potomków}
usunHUFF(kopia); {wpisanie go do listy elementów}
usunHUFF(kopia); {"znikają" z listy przepisane elementy}
end;
top:=kopia;
end;
{wyświetlenie drzewa z literami i iloscią ich wystąpień (algortym z Wirta)}
procedure drukuj_drzewoHUFF(top:drzewo; x:integer);
var i:integer;
begin
if top<>nil then
with top^ do
begin
drukuj_drzewoHUFF(prawy,x+2);
for i:=1 to x do write (' ');
writeln(ilosc,'-',litera);
drukuj_drzewoHUFF(lewy,x+2);
end;
end;
{wyświetlenie i zapisanie do pliku kodów poszczególnych znaków}
procedure znaki_literHUFF(top:drzewo;var plik2:text);
var i:integer;
kod:string;
p,r:drzewo;
begin
p:=top;
kod:='' ;
while (p.lewy<>nil)or(p.prawy<>nil) do {przepatrywanie drzewa az bedzie puste zostanie korzen}
begin
while (top.lewy<>nil)or(top.prawy<>nil) do {przepatrywanie poszczególnych gałęzi}
begin
kod:=kod + top^.kod; {dodanie kodów tych odgałęzień}
if (top^.lewy<>nil) then
begin { w zależności czy istnieje odgalęzienie to w tym kieruku}
r:=top; { zagłębia się pętla}
top:=top^.lewy;
end
else
begin
r:=top;
top:=top^.prawy;
end;
end;
if top^.litera<>chr(0) then {jeżeli dojdziemy do liścia który zawiera literę}
begin {to wyświeltony zostaje kod tej litery + litera}
kod:=kod + top^.kod;
writeln(kod,' ', top^.litera); {nastepuje również zapis do pliku}
readln;
write(plik2,kod);
writeln(plik2,top^.litera);
end;
if top<sup>.kod='0' then r</sup>.lewy:=nil; {usunięcie odpowiedniego dowiązania}
if top<sup>.kod='1' then r</sup>.prawy:=nil;
dispose(top); {zwolnienie pamięci w której znajdowała się litera}
top:=p;
kod:='';
end;
close(plik2);
end ;
{PROGRAM GŁOWNY}
begin
clrscr;
top:=nil;
nazwy_plikowHUFF(plik1, plik2);
wczytajHUFF(plik1, top);
tworz_drzewoHUFF(top);
drukuj_listaHUFF(top);
readln;
end.
</b>