Witam,
piszę program, który będzie kompresował pliki metodą huffmana. Cały kod jest od początku napisany, przeze mnie. Niestety trafiłem na problem z którym sobie nie radzę. Prosiłbym o wskazówkę, gdzie może się znajdować (podejrzewam, że w procedurze, która usuwa z listy elementy) i ewentualnie jak go naprawić. Męczę się z tym już czwarty dzień i nie mogę nic wykombinować... :/
program huffman;
uses
crt;
(*========== TYPES ==========*)
type
PElement=^Element;
Element = record
Amount:integer;
ReadValue:byte;
PPrev:PElement;
PNext:PElement;
PLChild:PElement;
PRChild:PElement;
PParent:PElement;
end;
(*========== VARIABLES ==========*)
var
InputFile:file;
FirstOnList:PElement;
Root:PElement;
(*========== PROCEDURES ==========*)
(*Procedura wyswietlajaca utworzona liste
TYLKO DO SPRAWDZENIA POPRAWNOSCI PROCEDURY CreateList*)
procedure CheckList(FirstOnList:PElement);
var
Temp:PElement;
Suma:integer;
begin
Suma:=0;
if FirstOnList<>nil then
begin
Temp:=FirstOnList;
Suma:=Suma+Temp^.Amount;
writeln(Temp^.ReadValue,' ilosc: ',Temp^.Amount);
while Temp^.PNext<>nil do
begin
Temp:=Temp^.PNext;
Suma:=Suma+Temp^.Amount;
writeln(Temp^.ReadValue,' ilosc: ',Temp^.Amount);
end;
end;
writeln('Suma odczytanych bajtow: ',Suma);
end;
procedure LiczListe(FirstOnList:PElement);
var
Temp:PElement;
Suma:byte;
begin
Temp:=FirstOnList;
Suma:=1;
while Temp^.PNext<>nil do
begin
Temp:=Temp^.PNext;
inc(Suma);
end;
writeln('Ilosc elementow na liscie: ',Suma);
end;
procedure CreateList(var InputFile:file; var FirstOnList:PElement);
var
Buffer:byte;
NewElement:PElement;
Temp:PElement;
CreateNewElement:boolean;
begin
while not eof(InputFile) do
begin
blockread(InputFile,Buffer,sizeof(Buffer));
(*Jesli nie ma zadnego elementu na liscie, tworzymy nowy i przypisujemy pierwsza wartosc*)
if FirstOnList=nil then
begin
new(FirstOnList);
FirstOnList^.Amount:=1;
FirstOnList^.ReadValue:=Buffer;
FirstOnList^.PPrev:=nil;
FirstOnList^.PNext:=nil;
FirstOnList^.PLChild:=nil;
FirstOnList^.PRChild:=nil;
FirstOnList^.PParent:=nil;
end;
(*Jezeli na liscie znajduje sie wiecej niz dwa elementy, najpierw przeszukujemy liste
w poszukiwaniu wartosci rownej, biezacej wartosci Buffer, jezeli taka znajdziemy, w elemencie
posiadajacym taka wartosc, zwiekszamy wartosc pola Amount o jeden. W przeciwnym wypadku,
dodajemy do listy nowy element*)
if FirstOnList^.PNext<>nil then
begin
Temp:=FirstOnList;
(*Dzieki zmiennej CreateNewElement wiemy, czy odnaleziono juz na liscie element
o takiej samej wartosci, jak bierzaca wartosc Buffer, czy musimy utworzyc nowy
element dla owej wartosci*)
CreateNewElement:=true;
//Przeszukiwanie listy
if Buffer=Temp^.ReadValue then
begin
inc(Temp^.Amount);
CreateNewElement:=false;
end;
while Temp^.PNext<>nil do
begin
if Buffer=Temp^.ReadValue then
begin
inc(Temp^.Amount);
CreateNewElement:=false;
end;
Temp:=Temp^.PNext;
end;
//Tworzenie nowego elementu, w przypadku nie odnalezienia odpowiadajacego, juz istniejacego
if CreateNewElement=true then
begin
Temp:=FirstOnList^.PNext;
new(NewElement);
NewElement^.PNext:=FirstOnList^.PNext;
NewElement^.PPrev:=Temp^.PPrev;
FirstOnList^.PNext:=NewElement;
Temp^.PPrev:=NewElement;
NewElement^.Amount:=1;
NewElement^.ReadValue:=Buffer;
NewElement^.PLChild:=nil;
NewElement^.PRChild:=nil;
NewElement^.PParent:=nil;
end;
end;
(*Jesli na liscie znajduje sie tylko jeden element, sprawdzamy czy aktualna wartosc bufora
jest taka sama jak tego elementu. W przypadku, gdy jest, zwiekszamy tylko wartosc Amount
w istniejacym elemencie. W przeciwnym wypadku, tworzymy nowy element listy*)
if FirstOnList^.PNext=nil then
if Buffer=FirstOnList^.ReadValue then
inc(FirstOnList^.ReadValue)
else
begin
new(NewElement);
NewElement^.Amount:=1;
NewElement^.ReadValue:=Buffer;
NewElement^.PPrev:=FirstOnList;
NewElement^.PNext:=nil;
NewElement^.PLChild:=nil;
NewElement^.PRChild:=nil;
NewElement^.PParent:=nil;
FirstOnList^.PNext:=NewElement;
end;
end;
end;
procedure DeleteFromList(var FirstOnList:PElement; var Element:PElement);
var
Temp,Temp2,TempElement:PElement;
begin
if Element<>nil then
begin
if (Element^.ReadValue=FirstOnList^.ReadValue) and (Element^.Amount=FirstOnList^.Amount) then
begin
if FirstOnList^.PNext<>nil then
begin
Temp:=FirstOnList^.PNext;
Temp2:=Temp^.PNext;
FirstOnList:=Temp;
dispose(Temp);
FirstOnList^.PNext:=Temp2;
Temp2^.PPrev:=FirstOnList;
end
else
begin
FirstOnList:=nil;
end;
end
else
begin
if Element^.PNext=nil then
begin
Temp:=Element^.PPrev;
Temp^.PNext:=nil;
dispose(Element);
end
else
begin
if (Element^.PPrev<>nil) and (Element^.PNext<>nil) then
begin
Temp:=Element^.PPrev;
Temp2:=Element^.PNext;
Temp^.PNext:=Temp2;
Temp2^.PPrev:=Temp;
//dispose(Element);
end;
end;
end;
end;
end;
(*========== Procedura tworzaca drzewo Huffmana ==========*)
procedure CreateHuffmanTree(var FirstOnList:PElement);
var
Temp,Temp2,Chosen1,Chosen2,NewElement:PElement;
begin
Temp:=FirstOnList;
if (FirstOnList<>nil) and (FirstOnList^.PNext<>nil) then
begin
new(Chosen1);
new(Chosen2);
Temp:=FirstOnList^.PNext;
Chosen1:=Temp^.PNext;
while Temp^.PNext<>nil do
begin
Temp:=Temp^.PNext;
if Temp^.Amount<Chosen1^.Amount then
Chosen1:=Temp;
end;
Temp:=FirstOnList;
Chosen2:=Temp;
while Temp^.PNext<>nil do
begin
Temp:=Temp^.PNext;
if (Temp^.Amount<Chosen1^.Amount) AND (Temp^.ReadValue<>Chosen1^.ReadValue) then
Chosen2:=Temp;
end;
Temp:=FirstOnList;
while Temp<>Chosen1 do
begin
Temp:=Temp^.PNext;
end;
DeleteFromList(FirstOnList,Temp);
Temp:=FirstOnList;
while Temp<>Chosen2 do
begin
Temp:=Temp^.PNext;
end;
DeleteFromList(FirstOnList,Temp);
new(NewElement);
NewElement^.Amount:=Chosen1^.Amount+Chosen2^.Amount;
NewElement^.ReadValue:=0;
NewElement^.PParent:=nil;
NewElement^.PLChild:=Chosen1;
NewElement^.PRChild:=Chosen2;
Chosen1^.PParent:=NewElement;
Chosen2^.PParent:=NewElement;
if FirstOnList<>nil then
begin
Temp:=FirstOnList;
while Temp^.PNext<>nil do
begin
Temp:=Temp^.PNext;
end;
Temp^.PNext:=NewElement;
NewElement^.PPrev:=Temp;
end
else
begin
FirstOnList:=NewElement;
exit;
end;
CreateHuffmanTree(FirstOnList);
end;
end;
(*========== MAIN ==========*)
begin
FirstOnList:=nil;
assign(InputFile,'./plik');
reset(InputFile,1);
clrscr;
CreateList(InputFile,FirstOnList);
LiczListe(FirstOnList);
CreateHuffmanTree(FirstOnList);
LiczListe(FirstOnList);
close(InputFile);
repeat until keypressed;
end.