Навигация
13 l 14
 |  |  |  |  |  |
9 10 11 12
h w e - o
 |  |
3 4 5 6 / 7 8
* r
1 2
Таблица 11. Итерация№11
| Итерация №11 |
| Сообщение: Hello_ world |
| Закодировнное сообщение: 01101000 001100101 1001101100 01 110 01101111 100 00100000 01001110111 111 1110 01110010 111 1100 01100100 |
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.
0 комментариев