Program (pascal) - kompresja metodą drzew huffmana

spec_u
Użytkownik
Użytkownik
Posty: 40
Rejestracja: 17 lis 2007, o 18:45
Płeć: Mężczyzna
Lokalizacja: Katowice
Podziękował: 5 razy
Pomógł: 1 raz

Program (pascal) - kompresja metodą drzew huffmana

Post autor: spec_u »

Witam, skompilowałem poniższy kod i po uruchomieniu przy podawaniu pliku do zapisu ("nazwa pliku w którym ma być zapisany wynik") wystepuje błąd, móże ktoś z Was mógłby na to rzucić fachowym okiem gdzie tkwi błąd ?

Za wszystkie sugestie będe bardzo wdzięczny, pozdrawiam :)

Kod: Zaznacz cały

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^.litera,'-',top^.ilosc);
top:=top^.pred; {właśnie tu coś się psuje!!!}
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^.ilosc + top^.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^.kod='0' then r^.lewy:=nil; {usunięcie odpowiedniego dowiązania}
if top^.kod='1' then r^.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.
ODPOWIEDZ