Компрессия информации и упорядочение дерева по алгоритму Виттера

Таблица 1. Итерация№1

* 3

H

2

Таблица 2. Итерация№2

H 5

3 4

* e

2

Таблица 3. Итерация№3

7

5 6

* l H e

1 2 3 4

Таблица 4. Итерация№4

7

l

5 6

e

3 4

* H

2

Таблица 5. Итерация№5

9

7 8

e h l

3 4 5 6

* o

2

Таблица 6. Итерация№6

11

9 10

e l

5 6 7 8

* - h o

1 2 3 4

Таблица 7. Итерация№7

13

11 12

l

7 8 9 10

* w e - h o

1 2 3 4 5 6

Таблица 8. Итерация№8

13

11 12

o l

7 8 9 10

e h

3 4 5 6

* w

2

Таблица 9. Итерация№9

15

o 13 14

9 10 11 12

h w e - l

3 4 5 6 7 8

* r

1 2

Таблица 10. Итерация№10

15

13 l 14

9 10 11 12

h w e - o

3 4 5 6 / 7 8

* r

1 2

Таблица 11. Итерация№11

17

15 16

l

11 12 13 14

h w e o

5 6 7 8 9 10

* d - r

1 2 3 4

ПРИЛОЖЕНИЕ В

Текст программы

unit Form;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls, Core;

type

TForm1 = class(TForm)

InChar: TEdit;

Panel1: TPaintBox;

Panel2: TPaintBox;

Label1: TLabel;

Label2: TLabel;

CodeTableMemo: TMemo;

MessageMemo: TMemo;

Label3: TLabel;

Label4: TLabel;

CodedMsg: TMemo;

Button1: TButton;

DecodedMsg: TMemo;

Button2: TButton;

Label5: TLabel;

procedure InCharKeyPress(Sender: TObject; var Key: Char);

procedure Button1Click(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure FormPaint(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Tree, DecodeTree: PTree;

codetable: array [char] of string;

decodetable: array [char] of string;

procedure MakeCodeTable(Top: PTree);

implementation

{$R *. DFM}

procedure DrawTree(D: TPaintBox; P: Ptree; w,h: integer);

var

C: TCanvas;

procedure Draw(T: PTree; x,y,level,ofs: integer);

begin

if(T<>nil) then

begin

if(T. Left<>nil) then

begin

c. MoveTo(x,y);

c. LineTo(x-(ofs div 2),y+30);

end;

if(T. Right<>nil) then

begin

c. MoveTo(x,y);

c. LineTo(x+(ofs div 2),y+30);

end;

C. Ellipse(x-12,y-12,x+12,y+12);

if t. isleaf then if t. symbol=#0 then C. TextOut(x-4,y-25,'*') else C. TextOut(x-4,y-25,t. Symbol);

C. TextOut(x-6,y-7, inttostr(T. wiegth));

C. TextOut(x-6,y+12, inttostr(T. number));

Draw(T. Left,x-(ofs div 2),y+30,level+1,ofs div 2);

Draw(T. Right,x+(ofs div 2),y+30,level+1,ofs div 2);

end;

end;

begin

C: =D. Canvas;

C. Brush. Color: =clBtnFace;

C. FillRect(D. ClientRect);

Draw(P,w div 2,30,1,w div 2);

end;

procedure MakeDeCodeTable(Top: PTree);

procedure CT(P: PTree; code: string);

begin

if P<>nil then

begin

if (P. Wiegth>=0) and (P. IsLeaf) then

begin

decodetable [P. Symbol] : =code;

end;

if not P. IsLeaf then

begin

CT(P. Left,code+'0');

CT(P. Right,code+'1');

end;

end;

end;

begin

CT(Top,'');

end;

var

DCounter: integer;

DString: String;

DByte: byte;

DB: Boolean;

procedure AddCharToDMess(C: Char);

var

S: String;

begin

With Form1. DecodedMsg do

begin

S: =Text;

Clear;

Text: =S+C;

end;

end;

procedure Decode(BIT: Char);

var

i,j: integer;

c: char;

begin

if DB then

begin

if DCounter=0 then

DCounter: =7 else

dec(DCounter);

DByte: =((DByte shl 1) or (byte(bit) and 1));

if DCounter=0 then

begin

AddSymbol(DecodeTree,chr(DByte));

CheckWiegth(DecodeTree);

Enumerate(DecodeTree);

Huffman(DecodeTree);

Vitter(DecodeTree);

DrawTree(Form1. Panel2,DecodeTree,Form1. Panel2. ClientWidth,500);

MakeDeCodeTable(DecodeTree);

AddCharToDMess(chr(DByte));

DString: ='';

DB: =false;

end;

end else

if DecodeTree=nil then

begin

DB: =true;

Decode(BIT);

end else

begin

DString: =DString + Bit;

for c: =#0 to #255 do

begin

if DecodeTable [c] =DString then

begin

if c=#0 then

begin

DB: =true;

DCounter: =0;

end else

begin

AddSymbol(DecodeTree,c);

CheckWiegth(DecodeTree);

Enumerate(DecodeTree);

Huffman(DecodeTree);

Vitter(DecodeTree);

DrawTree(Form1. Panel2,DecodeTree,Form1. Panel2. ClientWidth,500);

MakeDeCodeTable(DecodeTree);

DString: ='';

AddCharToDMess(c);

DB: =false;

break;

end;

end;

end;

end;

end;

procedure MakeCodeTable(Top: PTree);

procedure CT(P: PTree; code: string);

begin

if P<>nil then

begin

if (P. Wiegth>=0) and (P. IsLeaf) then

begin

codetable [P. Symbol] : =code;

end;

if not P. IsLeaf then

begin

CT(P. Left,code+'0');

CT(P. Right,code+'1');

end;

end;

end;

begin

CT(Top,'');

end;

procedure ShowCT;

var

C: Char;

begin

Form1. CodeTableMemo. Clear;

For c: =#0 to #255 do

begin

if CodeTable [c] <>'' then

begin

Form1. CodeTableMemo. Lines. Append(c+' - '+CodeTable [c]);

end;

end;

end;

procedure AddCharToMess(C: Char);

var

S: String;

begin

With Form1. MessageMemo do

begin

S: =Text;

Clear;

Text: =S+C;

end;

end;

procedure AddCoded(c: char);

var

s: string;

begin

S: =Form1. CodedMsg. Lines. Text;

Form1. CodedMsg. Clear;

Form1. CodedMsg. Lines. Text: =S+' '+CodeTable [c];

end;

procedure AddASC(c: char);

var

i: integer;

s: string;

b: byte;

begin

s: ='';

b: =byte(c);

for i: =1 to 8 do

begin

s: =chr((b and 1) +$30) +s;

b: =(b shr 1);

end;

S: =Form1. CodedMsg. Lines. Text+' '+s;

Form1. CodedMsg. Clear;

Form1. CodedMsg. Lines. Text: =S;

end;

procedure TForm1. InCharKeyPress(Sender: TObject; var Key: Char);

var

B: Boolean;

begin

B: =AddSymbol(Tree,Key);

CheckWiegth(Tree);

Enumerate(Tree);

Huffman(Tree);

DrawTree(Panel1,Tree,Panel1. ClientWidth,500);

Application. MessageBox('stop','stop',MB_OK);

Vitter(Tree);

DrawTree(Panel1,Tree,Panel1. ClientWidth,500);

if B then

begin

AddCoded(#0);

AddASC(key);

end else

begin

AddCoded(key);

end;

MakeCodeTable(Tree);

AddCharToMess(Key);

ShowCT;

InChar. Clear;

end;

procedure TForm1. Button1Click(Sender: TObject);

var

s: string;

c: char;

begin

s: =CodedMsg. Text;

if(s<>'') then

begin

while s [1] =' ' do Delete(s,1,1);

while ((s<>'') and (s [1] <>' ')) do

begin

Decode(s [1]);

Delete(s,1,1);

end;

CodedMsg. Clear;

CodedMsg. Text: =s;

end;

end;

procedure TForm1. FormResize(Sender: TObject);

begin

Panel1. Top: =20;

Panel1. Height: =(ClientHeight div 2) - 20;

Label2. Top: =(ClientHeight div 2);

Panel2. top: =(ClientHeight div 2) +20;

Panel2. Height: =(ClientHeight div 2) - 20;

end;

procedure TForm1. FormPaint(Sender: TObject);

begin

DrawTree(Panel1,Tree,Panel1. ClientWidth,500);

DrawTree(Panel2,DecodeTree,Panel2. ClientWidth,500);

end;

procedure TForm1. Button2Click(Sender: TObject);

var

s: string;

c: char;

begin

s: =CodedMsg. Text;

if(s<>'') then

begin

while s [1] =' ' do Delete(s,1,1);

if ((s<>'') and (s [1] <>' ')) then

begin

Decode(s [1]);

Delete(s,1,1);

end;

CodedMsg. Clear;

CodedMsg. Text: =s;

end;

end;

end.

unit Core;

{$B-}

interface

uses Graphics;

type

PTree = ^TTree;

TTree = record

Left,Right,Up: PTree;

Symbol: char;

Wiegth: integer;

Number: integer;

IsLeaf: boolean;

end;

function NewNode(l,r,u: PTree; s: char; c,n: integer; i: boolean): PTree;

procedure DeleteTree(var P: PTree);

function AddNewSymbolToTree(var Top: PTree; c: char): boolean;

function AddSymbolToTree(var Top: PTree; c: char): boolean;

function AddSymbol(var Top: PTree; c: char): boolean;

function MaxLevel(Top: PTree): integer;

procedure NodesOnLevel(Top: PTree; var qol: integer; l,level: integer);

function GetNodeFromLevel(P: Ptree; level,number: integer; var l,n: integer): PTree;

procedure Enumerate(P: PTree);

function CheckWiegth(P: PTree): integer;

function GetNodeByNumber(P: PTree; number: integer): PTree;

function GetLeafByWiegthMax(P: PTree; wiegth: integer): PTree;

procedure Vitter(P: PTree);

procedure Huffman(P: PTree);

implementation

Uses Math,SysUtils;

{$B-}

function CheckWiegth(P: PTree): integer;

begin

Result: =0;

if P<>nil then

begin

if not P. Isleaf then

begin

Result: =CheckWiegth(P. left) +CheckWiegth(P. right);

P. Wiegth: =Result;

end else Result: =P. Wiegth;

end else

Result: =0;

end;

procedure Huffman(P: PTree);

var

i,j,k: integer;

t,tt: PTree;

tmp: TTree;

begin

k: =1;

t: =GetNodeByNumber(P,k);

while t<>nil do

begin

tt: =GetNodeByNumber(P,k+1);

if tt<>nil then

begin

if tt. Wiegth<t. Wiegth then

begin

move(tt^,tmp,sizeof(tmp));

move(t^,tt^,sizeof(tmp));

move(tmp,t^,sizeof(tmp));

CheckWiegth(P);

Enumerate(P);

k: =1;

end;

end;

inc(k);

T: =GetNodeByNumber(P,k);

end;

end;

procedure Vitter(P: PTree);

var

i,j,k,l: integer;

t,tt,ttt: PTree;

tmp: TTree;

begin

k: =1;

t: =GetNodeByNumber(P,1);

while t<>nil do

begin

if not T. IsLeaf then

begin

tt: =GetLeafByWiegthMax(P,t. wiegth);

if(tt<>nil) then

begin

if(tt. Number>T. Number) then

begin

move(tt^,tmp,sizeof(tmp));

move(t^,tt^,sizeof(tmp));

move(tmp,t^,sizeof(tmp));

CheckWiegth(P);

Enumerate(P);

k: =1;

end;

end;

end;

inc(k);

T: =GetNodeByNumber(P,k);

end;

end;

function GetLeafByWiegthMax(P: PTree; wiegth: integer): PTree;

var

i: integer;

Node: PTree;

begin

Result: =nil;

i: =1;

Node: =GetNodeByNumber(P, i);

while Node<>nil do

begin

if Node. Wiegth > wiegth then exit; // ???????

if Node. IsLeaf and (Node. Wiegth=wiegth) then

begin

Result: =Node;

end;

inc(i);

Node: =GetNodeByNumber(P, i);

end;

end;

function GetNodeByNumber(P: PTree; number: integer): PTree;

begin

if(P<>nil) then

begin

if P. Number=number then result: =P else

begin

Result: =GetNodeByNumber(P. Left,number);

if Result=nil then Result: =GetNodeByNumber(P. Right,number);

end;

end else Result: =nil;

end;

procedure Enumerate(P: PTree);

var

i,j,k,l,n,o,s: integer;

T: PTree;

begin

n: =0;

k: =MaxLevel(P);

for i: =k downto 1 do

begin

o: =1;

s: =1;

l: =1;

T: =GetNodeFromLevel(P, i,l,o,s);

while T<>nil do

begin

inc(n);

T. Number: =n;

inc(l);

o: =1;

s: =1;

T: =GetNodeFromLevel(P, i,l,o,s);

end;

end;

end;

function GetNodeFromLevel(P: PTREE; level,number: integer; var l,n: integer): PTree;

var

T: PTRee;

begin

result: =nil;

if(P<>nil) then

begin

if(l<level) then

begin

inc(l);

T: =GetNodeFromLevel(P. Left,level,number,l,n);

dec(l);

if(T=nil) then

begin

inc(l);

Result: =GetNodeFromLevel(P. Right,level,number,l,n);

dec(l);

end

else Result: =T;

end else

begin

if(l=level) then

begin

if(n=number) then result: =P else

begin

result: =nil;

end;

inc(n);

end else result: =nil;

end;

end else

result: =nil;

end;

procedure NodesOnLevel(Top: PTree; var qol: integer; l,level: integer);

begin

if Top<>nil then

begin

if level=l then

begin

inc(qol);

end else

begin

NodesOnLevel(top. Left,qol,l+1,Level);

NodesOnLevel(top. Right,qol,l+1,Level);

end;

end;

end;

function MaxLevel(Top: PTree): integer;

begin

if(Top=nil) then

begin

Result: =0;

end else

begin

Result: =Max(MaxLevel(Top. Left),MaxLevel(Top. Right)) +1;

end;

end;

function AddSymbol(var Top: PTree; c: char): boolean;

begin

if(not AddSymbolToTree(Top,c)) then

if(not AddNewSymbolToTree(Top,c)) then

result: =false // Error

else

result: =true // Added

else

result: =false; // Updated

end;

function AddSymbolToTree(var Top: PTree; c: char): boolean;

begin

if Top=nil then Result: =False else

begin

if Top. IsLeaf then

begin

if Top. Symbol=c then

begin

inc(Top. Wiegth);

result: =true;

end else

begin

result: =false;

end;

end else

begin

if AddSymbolToTree(Top. left,c) or AddSymbolToTree(Top. right,c) then

begin

inc(Top. Wiegth);

result: =true;

end else

result: =false;

end;

end;

end;

function AddNewSymbolToTree(var Top: PTree; c: char): boolean;

begin

if Top=nil then

begin

Top: =NewNode(nil,nil,nil,#0,1,0,false);

Top. left: =NewNode(nil,nil,Top,#0,0,0,true);

Top. Right: =NewNode(nil,nil,Top,c,1,0,true);

result: =true;

end else

begin

if (Top. Wiegth=0) and (top. Symbol=#0) then

begin

Top. Left: =NewNode(nil,nil,Top,#0,0,0,true);

Top. Right: =NewNode(nil,nil,Top,c,1,0,true);

Top. IsLeaf: =false;

Top. Wiegth: =1;

Result: =true;

end else

begin

if (Top. Left<>nil) and AddNewSymbolToTree(Top. Left,c) then

begin

result: =true;

exit;

end;

if (Top. Right<>nil) and AddNewSymbolToTree(Top. Right,c) then

begin

result: =true;

exit;

end;

result: =false;

end;

end;

end;

procedure DeleteTree(var P: PTree);

begin

if P=nil then exit;

DeleteTree(P. Left);

DeleteTree(P. Right);

Dispose(P);

P: =nil;

end;

function NewNode(l,r,u: ptree; s: char; c,n: integer; i: boolean): PTree;

var

P: PTree;

begin

new(P);

P. Left: =l;

P. Right: =r;

P. Up: =u;

P. Symbol: =s;

P. Wiegth: =c;

P. Number: =n;

P. IsLeaf: =i;

result: =P;

end;

end.