asked on

Implementing huffman coding for file compression

I am currently doing an assignment in pascal to implement the huffman algorithm for the file compression, but i do not know how to start.The program takes a paragraph of text as input from the keyboard or a file. The outputs includes a frequency table, a coding for each character appeared in the text and a report of saving percentage of the coding compared with normal ASCII coding. The algorithm can be descibe as follows:

1. Constuct a frequency table (including spaces);
2. Create a forest of code trees, one for each character. Each code tree consists of a single node labelled by a character and frequency. The weight of each tree is the sum of the frequencies of the leaves.
3. Iteration until there is only one tree:
Select the two trees T1 and T2 of smallest weight, form a tree with subtrees T1 and T2. Assign the weight of the new tree, which is the sum of the weights of T1 AND T2, and update the frequency table.
4. Start at the root and trace down to every leaf to the final tree; mark O for the left branch and 1 for the right.

Example:
File Compression
1. Input text
2. Frequency Table
3. Huffman coding pattern
4. Display Compressed file
5. Saving percentage
6. Quit

Enter your choice >1
Input The text to compress file > BILL BEATS BEN.

Enter your choice > 2

Char Freq
B 3
L 2
E 2
SP 2
I 1
A 1
T 1
A 1
T 1
S 1
N 1
. 1
Total 15

Press any key to return to main program >
Enter your choice > 3
I 0000
A 0001
S 0010
T 0011
N 0100
. 0111
L 011
E 100
SP 101
B 11

Press any key to return to main program >
Enter your choice > 4
111000100101111000001001000111011100000110110101

Press any key to return to main program >
Enter your choice >5

You have saved 60% compared with a 8-bit coding.

Press any key to return to main program >
Enter your choice > 6

Impelementation requirment
Use linked lists, tree structures,feasible and efficient sorting algorithms

I need the source code for my assigment very urgently as my dateline for the assignment is 26 Jan 99. Appreciate your help. Please email to me as soon as possible so that i can have sufficient time to finish my documentation and report.

Thank you very much

Liver

ASKER CERTIFIED SOLUTION

Ronald Buster

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Ronald Buster

Hi Liver,

Here is some sample code to use the unit,

regards,

Cono

<----------------------------------->

{
============================================================
= JAM ARCHIVE PROGRAM =
============================================================
= Author(s) : Ronald Buster =
= Jo-Rien Steenbergen =
============================================================
= Date's : -Version 1.00 =
= 10-12-1993 - Start with program architecture =
= =
= -Version 1.01 =
= 12-12-1993 - Start with adding to archive =
= =
= -Version 1.02 =
= 13-12-1993 - Added viewing archive =
= - Bugs fixed =
= =
= -Version 1.03 =
= 14-12-1993 - Added extracting from archive =
= =
= -Version 1.04 =
= 15-12-1993 - Fixed bug in storing method =
= cause the extractor was getting =
= wrong information from original =
= - Fixed bug cause of too many fi- =
= les open error. =
= - Started with adding filelist =
= to viewing routine. =
= =
= -Version 1.05 =
= 16-12-1993 - Fixed viewing routine. =
= All param are now included. =
= =
= -Version 1.06 =
= 17-12-1993 - Extracting routine also works =
= with a filelist. =
============================================================
= (c)1993 Kickback Software Development =
============================================================}
const EX = 0;
LI = 1;

var JamVer ,
JamVerM : byte;

DoWhat : word;

TotBytesIn ,
TotBytesOut : longint;
TotFiles : integer;

TN1 ,
TN2 ,
TN3 : real;

Pat : PathStr;
Dir : DirStr;
Nam : NameStr;
Ext : ExtStr;

PackNam : string[8];
SearchName : string[12];

FH : SearchRec;

{===========================================================}
procedure ListSupplement1(e:string;m:byte);forward;
procedure ListSupplement2;forward;
{procedure BeginJam;forward;}
{===========================================================}

procedure JamInit;
begin
JamVer := 106;
JamVerM := 106;
Insrt := MinCopy; {MinCopy}
Dictfile := 0;
Binary := 0;
OutBufCount := 0;
InBufCount := 0;
Input_Bit_Count := 0;
Input_Bit_Buffer := 0;
Output_Bit_Count := 0;
Output_Bit_Buffer := 0;
Bytes_In := 0;
Bytes_Out := 0;
end;
{===========================================================}
function FormStr(st:string;lenfld:byte):string;
var t,i : byte;
tstr : string;
begin
tstr := '';
t := length(st);
if t = lenfld then
formstr := st;
if t < lenfld then
begin
for i := 1 to (lenfld-t) do
tstr := tstr + ' ';
tstr := tstr + st;
formstr := tstr;
end;
end;
{===========================================================}
function FileExists(Filename:string):boolean;
var F : File;
begin
{$I-}
assign(F,Filename);
Reset(F);
Close(F);
{$I+}
Fileexists := (IoResult = 0) and (Filename <> '');
end;

{===========================================================}
{= Extracting routine =}
{===========================================================}
procedure ExtrJam;
var StoreBuf : array[1..2048] of byte;
SFile : file of byte;
SFCount : longint;
SBCount : word;
Ch : Char;
begin
jaminit;
if JH.Meth = 1 then
begin
Assign(Outfile,JH.Name);
rewrite(outfile,1);
UnJam;
close(outfile);
end
else
begin
Assign(Outfile,JH.Name);
rewrite(outfile,1);
assign(SFile,PackNam+'.jam');
{$i-} reset(SFile); {$I+}
Writeln(IOResult);
readkey;
seek(SFile,JH.PosF-1);

fillchar(StoreBuf,sizeof(StoreBuf),0);

SFCount := 1;
SBCount := 1;
read(SFile,StoreBuf[SFCount]);
While (SFCount <= JH.OSiz) do
begin
read(SFile,StoreBuf[SBCount]);
if (SBCount = 2048) or (SFCount = JH.OSiz) then
begin
BlockWrite(outfile,storeBuf,SBCount);
SBCount := 0;
end;
inc(SFCount);
inc(SBCount);
end;
close(sfile);
close(outfile);
end;
end;

{===========================================================}
{= Parameter filelist checker 1. =}
{===========================================================}
{= Mode 0 : Parameterlist is available. =}
{= Mode 1 : All files in archive. =}
{===========================================================}
{= Works only with : Viewing,Extracting =}
{= =}
{===========================================================}
{= Only 20 parameters available in parameterlist =}
{===========================================================}

procedure ListJam1(mode:byte);

var LparN : array[3..23] of string[8];
LparE : array[3..23] of string[4];
ParamFound ,
Count ,
i ,
dummy ,
TCount : byte;

begin
{===================================}

Fillchar(LparN,Sizeof(LparN),0); {parse commline from param 3 to ?}
Fillchar(LparE,Sizeof(LparE),0);
for Count := 3 to Paramcount do
begin
FSplit(paramstr(Count), Dir, Nam, Ext);
LparN[Count] := Nam;
LparE[Count] := Ext;
end;

{===================================}

if mode = 0 then
TCount := paramcount - 2
else
TCount := 1;
Count := 3;
for i := 1 to TCount do
begin
dummy := 0;
seek(infile,0);
blockread(infile,JH,sizeof(JH));
repeat
if (TCount > 0) and (Mode = 0) then
begin
if JH.Name = upcasestr(LParN[Count]+LParE[Count]) then
ParamFound := 0
else
begin
FSplit(JH.Name, Dir, Nam, Ext);
if (LParN[Count] = '*') and
(Ext = upcasestr(LParE[Count])) then
begin
ParamFound := 0;
ListSupplement1(LParE[Count],0);
Dummy := 1;
inc(count);
end
else
begin
if (LParE[Count] = '.*') and
(Nam = upcasestr(LParN[Count])) then
begin
ParamFound := 0;
ListSupplement1(LParN[Count],1);
Dummy := 1;
inc(count);
end
else
begin
if (LParE[Count] = '.*') and
(LParN[Count] = '*') then
begin
ParamFound := 0;
ListSupplement1('',2);
Dummy := 1;
inc(count);
end
else
ParamFound := 1;
end;
end;
end;
end;
if (TCount = 1) and (Mode = 1) then
ParamFound := 0;

if (ParamFound = 0) and (Dummy = 0) then
begin
case DoWhat of
LI : ListSupplement2;
EX : ExtrJam;
end;

inc(totfiles);
inc(Count);
if (mode = 0) then
Dummy := 1;
end;
{$I-}
seek(infile,JH.PosN);
blockread(infile,JH,sizeof(JH));
until (IOresult <> 0) or (Dummy = 1) or (Kappuh);
{$I+}

if ParamFound = 1 then
begin
gotoxy(2,wherey);
write(upcasestr(LParN[Count]+LParE[Count]));
gotoxy(58,wherey);
write('Not found'#13#10);
Inc(Count);
end;

end;
end;

{======================================================}
{= ListSupplement1 =}
{======================================================}
{= Handles *.??? , ????????.* , *.* in filelist. =}
{======================================================}

procedure ListSupplement1(e:string;m:byte);
begin
seek(infile,0);
blockread(infile,JH,sizeof(JH));
repeat
FSplit(JH.Name, Dir, Nam, Ext);
if (Ext = upcasestr(E)) and (m=0) then
begin
case DoWhat of
LI : ListSupplement2;
EX : ExtrJam;
end;
inc(totfiles);
end;
write('Huh!');
if (Nam = upcasestr(E)) and (m=1) then
begin
case DoWhat of
LI : ListSupplement2;
EX : ExtrJam;
end;
inc(totfiles);
end;
if (e = '') and (m=2) then
begin
case DoWhat of
LI : ListSupplement2;
EX : ExtrJam;
end;
inc(totfiles);
end;
{$I-}
seek(infile,JH.PosN);
blockread(infile,JH,sizeof(JH));
until (IOresult <> 0) or (Kappuh);
{$I+}
end;

{======================================================}
{= ListSupplement2 =}
{======================================================}
{= Displays contents of archive. =}
{======================================================}

procedure ListSupplement2;
begin
gotoxy(2,wherey);
write(JH.Name);

gotoxy(16,wherey);
if JH.Meth = 0 then
write('Stored')
else
write('Jammed');

gotoxy(24,wherey);
TN1 := JH.OSiz;
TN2 := JH.PSiz;
TN3 := 100 - ( TN2 / ( TN1 / 100));
if JH.Meth = 0 then
TN3 := 0;

Write(FormStr(CRealStr(TN3,1),4),'%');

gotoxy(31,wherey);
Write(formstr(CIntStr(JH.OSiz),10));

gotoxy(43,wherey);

TotBytesIn := TotBytesIn + JH.OSiz;

TotBytesOut := TotBytesOut + JH.PSiz +Sizeof(JH);
Write(formstr(CIntStr(JH.PSiz+Sizeof(JH)),10),'');
gotoxy(58,wherey);
write('Ok'#13#10);
end;

Procedure JAMMED(S:STRING);
var OptionC : string[1];
OptSwitch : byte;

begin
OptSwitch := 1; {extract without subdirs}
FSplit(s, Dir, Nam, Ext);
PackNam := Nam;

if OptSwitch = 1 then
begin
Assign(infile,Nam+'.jam');
{$I-}
reset(infile,1);
if IOResult <> 0 then
begin
ErrorBox('Error opening file');
exit;
end;
{$I+}

TotBytesIn := 0;
TotBytesOut := 0;
TotFiles := 0;
JamInit;
DoWhat := EX;
if (paramstr(3) = '') or (paramstr(3) = '*.*') then
ListJam1(1)
else
ListJam1(0);
end;

end;