| Autor |
Beitrag |
maycontainnuts
Hält's aus hier
Beiträge: 5
|
Verfasst: Fr 11.04.08 15:11
Hallo
Bin neu hier und hab (wie könnte es anders sein) gleich mal eine Frage.
Den Huffman-code hab ich schon selbst implementiert. Nur wie macht man jetzt einen schnellen (de)kodierer?
Ich könnte es alles in Strings umwandeln aber das wäre bestimmt schleichend langsam 
Ein weiteres Problem ist das Speichern des Headers. Ich dachte, ich könnte es irgendwie so machen:
*a*1*b*5*c*hui*
Dabei ist * ein Trennzeichen, a/b/c das ursprüngliche Zeichen und 1/5/hui der 'huffmansche' Zeichensatz.
Nur gibt es ein Problem... Z.B. würde 001 und 01 (was ja präfixfrei und richtig ist) beides zum gleichen Zeichen
jemand ne Idee?
Ps: programmier Delphi erst seit knapp einem Monat. Habt also Erbarmen mit mir :/
Pss/pps(?): hier mal der völlig unkommentierte, und bestimmt auch schlecht geschriebene Code:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
| program huffman;
{$APPTYPE CONSOLE}
uses
SysUtils,dialogs,
huffman_class in 'huffman_class.pas';
var
huffman: Thuffman;
text: string;
i: byte;
begin
writeln('Gib nen Text ein:');
writeln('');
readln(text);
writeln('');
writeln('');
huffman := Thuffman.Create(text);
repeat
huffman.hash.sort;
huffman.tree.insert(huffman.hash.first,huffman.hash.second);
huffman.hash.joinfirstsecond;
until huffman.hash.last = true;
writeln('');
writeln('Fertig! binaerer Baum ist:');
writeln('');
huffman.tree.print;
writeln('');
writeln('ENTER druecken zum Beenden');
readln;
end. | 1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
| unit huffman_class;
interface
type
Tvarhash = record
count: integer;
chars: string;
end;
Tbinarytree = record
char: char;
bin: string;
end;
Ttree = class(Tobject)
private
binarytree: array of Tbinarytree;
procedure init(totree: array of Tvarhash);
function torealbin(tobin: string): integer;
public
procedure insert(const first,second: string);
procedure print;
end;
Thash = class(Tobject)
private
hash: array of Tvarhash;
function countchar(const char: char; const text: string): integer;
constructor Create(text: string; const tree: Ttree);
public
procedure sort;
function last:boolean;
function first: string;
function second: string;
procedure joinfirstsecond;
end;
Thuffman = class(Tobject)
private
public
tree: Ttree;
hash: Thash;
constructor Create(const text: string);
end;
implementation
uses
sysutils,dialogs;
constructor Thuffman.Create(const text: string);
begin
tree := Ttree.Create;
hash := Thash.Create(text, tree);
end;
constructor Thash.Create(text: string; const tree: Ttree);
begin
writeln('Dbg: Text: ',text);
writeln('');
writeln('Dbg: hash ist:');
while length(text) > 0 do
begin
setlength(hash,high(hash)+2);
hash[high(hash)].chars := text[1];
hash[high(hash)].count := countchar(text[1],text);
writeln(' ',hash[high(hash)].chars,' = ',hash[high(hash)].count);
text := stringreplace(text,text[1],'',[rfReplaceAll]);
end;
writeln('');
tree.init(hash);
end;
function Thash.countchar(const char: Char; const text: string): integer;
var
i: Integer;
return: integer;
begin
return := 0;
for i := 1 to length(text) do
if text[i] = char then
return := return +1;
result := return;
end;
procedure Thash.sort;
var
i,ii: byte;
swap: Tvarhash;
begin
for i := 0 to high(hash) do
begin
for ii := i to high(hash) do
begin
if hash[i].count > hash[ii].count then
begin
swap.chars := hash[ii].chars;
swap.count := hash[ii].count;
hash[ii].chars := hash[i].chars;
hash[ii].count := hash[i].count;
hash[i].chars := swap.chars;
hash[i].count := swap.count;
end;
end;
end;
writeln('Dbg: sortierter hash ist:');
for i := 0 to high(hash) do
writeln(' ',hash[i].chars,' = ',hash[i].count);
writeln('');
end;
function Thash.last;
begin
result := False;
if high(hash) = 0 then result := True;
end;
procedure Ttree.insert(const first: string; const second: string);
var
i: byte;
ii: byte;
begin
writeln('Dbg: erste zwei Eintraege zusammengefasst: ',first,' + ',second);
writeln('');
for i := 0 to high(binarytree) do
begin
for ii := 0 to length(first) do
begin
if binarytree[i].char = first[ii+1] then
begin
binarytree[i].bin := '0'+binarytree[i].bin;
end;
end;
end;
for i := 0 to high(binarytree) do
begin
for ii := 0 to length(second) do
begin
if binarytree[i].char = second[ii+1] then
begin
binarytree[i].bin := '1'+binarytree[i].bin;
end;
end;
end;
end;
procedure Ttree.init(totree: array of Tvarhash);
var
i: Integer;
begin
setlength(binarytree,high(totree)+1);
for i := 0 to high(totree) do
binarytree[i].char := totree[i].chars[1];
end;
function Thash.first;
begin
result := hash[0].chars;
end;
function Thash.second;
begin
result := hash[1].chars;
end;
procedure Thash.joinfirstsecond;
var
i: Integer;
begin
hash[0].chars := hash[0].chars + hash[1].chars;
hash[0].count := hash[0].count + hash[1].count;
for i := 1 to high(hash)-1 do
hash[i] := hash[i+1];
setlength(hash,high(hash));
end;
procedure Ttree.print;
var
i: byte;
begin
for i := 0 to high(binarytree) do
writeln(' ',binarytree[i].char,' = ',binarytree[i].bin,' -> ',torealbin(binarytree[i].bin));
end;
function Ttree.torealbin(tobin: string): integer;
var
bin: array of integer;
i: integer;
count: integer;
begin
setlength(bin,length(tobin));
count := 1;
for i := 0 to length(tobin)-1 do
begin
bin[i] := count;
count := count*2;
end;
count := 0;
for i := length(tobin) downto 1 do
begin
if tobin[i] = '1' then count := count +bin[length(tobin)-i];
result := count;
end;
end;
end. |
|
|
Ralf Jansen
 
Beiträge: 4708
Erhaltene Danke: 991
VS2010 Pro, VS2012 Pro, VS2013 Pro, VS2015 Pro, Delphi 7 Pro
|
Verfasst: Fr 11.04.08 16:01
Anstatt eines allgemeinen Trennzeichen könntest du die BitLänge des huffmankodierten Zeichens in diesem Byte ablegen.
Also 1byte(Zeichen)+1byte(Länge)+Nbyte(Huffman Zeichen)
Da du nun weißt aus wieviel bit dein Huffman Zeichen besteht weißt du dann auch wie groß N ist.
|
|
maycontainnuts 
Hält's aus hier
Beiträge: 5
|
Verfasst: Mo 14.04.08 14:42
hi
das ist ne gute idee  werd mich nach den Prüfungen (bibber ) mal daran versuchen.
Jetzt bleibt noch die Frage, wie man jetzt nen schnellen dekodierer/kodierer schreibt.
man könnte eine kleine Klasse machen, die in asm prüft, ob ein bit gesetzt ist oder nicht
aber das würde warscheinlich ziemlich langsam sein, wenn man für jedes Byte acht funktionsaufrufe macht, oder?
grez
|
|
Fiete
Beiträge: 617
Erhaltene Danke: 364
W7
Delphi 6 pro
|
Verfasst: Mo 14.04.08 15:19
moin maycontainnuts,
ich habe noch auf meiner Platte eine Turbo-Pascal-Version Anno 1994 gefunden.
Hoffentlich hilfts 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
| {$R-,G+}
PROGRAM DATENKOMPRESSION_NACH_HUFFMANN;
USES CRT;
TYPE STRING80=STRING[80];
ASTZEIGER=^AST;
AST=RECORD
ZEICHEN:BYTE;
ZWEIG:ARRAY[0..1]OF ASTZEIGER
END;
CODE=ARRAY[0..37]OF BYTE;
VAR ANZAHL:ARRAY[0..255]OF LONGINT;
STAMM:AST;
CODES:ARRAY[0..255]OF CODE;
START:CODE;
J,K:BYTE;
CH:CHAR;
GESZEICHEN,AUSZEICHEN:LONGINT;
DATEI1,DATEI2:STRING;
PROCEDURE AUSZAEHLEN(NAME:STRING);
VAR F:FILE OF BYTE;
I,WERT:BYTE;
M:LONGINT;
BEGIN
ASSIGN(F,NAME);RESET(F);
FOR I:=0 TO 255 DO ANZAHL[I]:=0;
FOR M:=1 TO FILESIZE(F) DO
BEGIN READ(F,WERT);INC(ANZAHL[WERT]) END;
CLOSE(F)
END;
PROCEDURE BINAERBAUM;
VAR DUMMY:AST;
I,MIN1,MIN2,GZEICHEN:BYTE;
BAUM:ARRAY[0..255]OF ASTZEIGER;
PROCEDURE FINDMIN(VAR M1,M2:BYTE);
VAR ANZ1,ANZ2:LONGINT;
I:BYTE;
BEGIN
ANZ1:=MAXLONGINT;ANZ2:=ANZ1;
FOR I:=0 TO 255 DO
IF BAUM[I]<>NIL THEN
BEGIN
IF ANZ1>=ANZAHL[I] THEN
BEGIN ANZ2:=ANZ1;ANZ1:=ANZAHL[I];M2:=M1;M1:=I END
ELSE IF ANZ2>=ANZAHL[I] THEN BEGIN ANZ2:=ANZAHL[I];M2:=I END
END
END;
BEGIN
GZEICHEN:=255;
FOR I:=0 TO 255 DO
IF ANZAHL[I]=0 THEN BEGIN BAUM[I]:=NIL;DEC(GZEICHEN) END
ELSE
BEGIN
NEW(BAUM[I]);BAUM[I]^.ZEICHEN:=I;BAUM[I]^.ZWEIG[0]:=NIL;
BAUM[I]^.ZWEIG[1]:=NIL
END;
FOR I:=1 TO GZEICHEN DO
BEGIN
FINDMIN(MIN1,MIN2);
DUMMY.ZEICHEN:=MIN1;DUMMY.ZWEIG[0]:=BAUM[MIN1];
DUMMY.ZWEIG[1]:=BAUM[MIN2];
NEW(BAUM[MIN1]);BAUM[MIN1]^:=DUMMY;
INC(ANZAHL[MIN1],ANZAHL[MIN2]);
BAUM[MIN2]:=NIL
END;
I:=0;
WHILE BAUM[I]=NIL DO INC(I);
STAMM:=BAUM[I]^;GESZEICHEN:=ANZAHL[I]
END;
PROCEDURE DEFCODE(GABEL:AST;STARTWERT:CODE);
BEGIN
IF (GABEL.ZWEIG[0]=NIL)AND(GABEL.ZWEIG[1]=NIL) THEN CODES[GABEL.ZEICHEN]:=STARTWERT
ELSE
BEGIN
STARTWERT[STARTWERT[0]DIV 8+1]:=STARTWERT[STARTWERT[0]DIV 8+1]
AND (255 - 1 SHL (STARTWERT[0]MOD 8));
INC(STARTWERT[0]);
DEFCODE(GABEL.ZWEIG[0]^,STARTWERT);
DISPOSE(GABEL.ZWEIG[0]);DEC(STARTWERT[0]);
STARTWERT[STARTWERT[0]DIV 8+1]:=STARTWERT[STARTWERT[0]DIV 8+1]
OR (1 SHL (STARTWERT[0]MOD 8));
INC(STARTWERT[0]);
DEFCODE(GABEL.ZWEIG[1]^,STARTWERT);
DISPOSE(GABEL.ZWEIG[1]);
END
END;
PROCEDURE CODEAUS(NAME1,NAME2:STRING);
VAR WERT,BITZAEHL,I,AUSGABE:BYTE;
M:INTEGER;
VON,NACH:FILE OF BYTE;
BEGIN
BITZAEHL:=0;ASSIGN(VON,NAME1);ASSIGN(NACH,NAME2);
RESET(VON);REWRITE(NACH);
FOR I:=0 TO 3 DO
BEGIN
AUSGABE:=(GESZEICHEN SHR(24-8*I)) AND 255;
WRITE(NACH,AUSGABE)
END;
FOR I:=0 TO 255 DO
BEGIN
FOR M:=0 TO CODES[I,0]-1 DO
BEGIN
AUSGABE:=AUSGABE SHL 2+(CODES[I,M DIV 8+1]SHR (M MOD 8)) AND 1;
INC(BITZAEHL,2);
IF BITZAEHL=8 THEN BEGIN WRITE(NACH,AUSGABE);BITZAEHL:=0 END
END;
AUSGABE:=AUSGABE SHL 2+3;
INC(BITZAEHL,2);
IF BITZAEHL=8 THEN BEGIN WRITE(NACH,AUSGABE);BITZAEHL:=0 END
END;
WHILE NOT(EOF(VON)) DO
BEGIN
READ(VON,WERT);
FOR I:=0 TO CODES[WERT,0]-1 DO
BEGIN
AUSGABE:=AUSGABE SHL 1+(CODES[WERT,I DIV 8+1]SHR (I MOD 8)) AND 1;
INC(BITZAEHL);
IF BITZAEHL=8 THEN
BEGIN WRITE(NACH,AUSGABE);BITZAEHL:=0;INC(AUSZEICHEN) END
END
END;
IF BITZAEHL>0 THEN
BEGIN
FOR I:=BITZAEHL TO 7 DO AUSGABE:=AUSGABE SHL 1+1;
WRITE(NACH,AUSGABE)
END;
AUSZEICHEN:=FILESIZE(NACH);CLOSE(VON);CLOSE(NACH);
END;
PROCEDURE DEKOMPRESS(NAME1,NAME2:STRING);
VAR WERT,BITZAEHL,I,AUSGABE,NP:BYTE;
VON,NACH:FILE OF BYTE;
DUMMY,DUMMYX:ASTZEIGER;
BEGIN
BITZAEHL:=8;STAMM.ZWEIG[0]:=NIL;STAMM.ZWEIG[1]:=NIL;DUMMY:=@STAMM;
ASSIGN(VON,NAME1);ASSIGN(NACH,NAME2);RESET(VON);REWRITE(NACH);
READ(VON,WERT);GESZEICHEN:=WERT;
READ(VON,WERT);GESZEICHEN:=GESZEICHEN SHL 8+WERT;
READ(VON,WERT);GESZEICHEN:=GESZEICHEN SHL 8+WERT;
READ(VON,WERT);GESZEICHEN:=GESZEICHEN SHL 8+WERT;
READ(VON,WERT);
FOR I:=0 TO 255 DO
BEGIN
WHILE ((WERT SHR(BITZAEHL-1)) AND 1)=0 DO
BEGIN
NP:=(WERT SHR(BITZAEHL-2)) AND 1;
IF DUMMY^.ZWEIG[NP]=NIL THEN
BEGIN
NEW(DUMMYX);
DUMMY^.ZWEIG[NP]:=DUMMYX;DUMMYX^.ZWEIG[0]:=NIL;
DUMMYX^.ZWEIG[1]:=NIL
END;
DUMMY:=DUMMY^.ZWEIG[NP];
DEC(BITZAEHL,2);
IF BITZAEHL=0 THEN BEGIN READ(VON,WERT);BITZAEHL:=8 END
END;
DUMMY^.ZEICHEN:=I;DUMMY:=@STAMM;
DEC(BITZAEHL,2);
IF BITZAEHL=0 THEN BEGIN READ(VON,WERT);BITZAEHL:=8 END
END;
AUSZEICHEN:=0;
WHILE AUSZEICHEN<GESZEICHEN DO
BEGIN
IF BITZAEHL=0 THEN BEGIN READ(VON,WERT);BITZAEHL:=8 END;
DUMMY:=DUMMY^.ZWEIG[(WERT SHR(BITZAEHL-1))AND 1];
IF (DUMMY^.ZWEIG[0]=NIL) AND (DUMMY^.ZWEIG[1]=NIL) THEN
BEGIN WRITE(NACH,DUMMY^.ZEICHEN);DUMMY:=@STAMM;INC(AUSZEICHEN) END;
DEC(BITZAEHL)
END;
CLOSE(VON);CLOSE(NACH)
END;
BEGIN
CLRSCR;WRITE('Name der "Von" - Datei : ');READLN(DATEI1);
WRITE('Name der "Nach" - Datei : ');READLN(DATEI2);
WRITE('Soll (K)omprimiert oder (D)ekomprimiert werden : ');
REPEAT CH:=UPCASE(READKEY) UNTIL CH IN['D','K'];WRITELN(CH);
IF CH='K' THEN
BEGIN
AUSZAEHLEN(DATEI1);WRITELN('Ausgezählt...');
BINAERBAUM;WRITELN('Bin„rbaum steht...');
FOR J:=0 TO 32 DO START[J]:=0;
FOR J:=0 TO 255 DO CODES[J]:=START;
DEFCODE(STAMM,START);
WRITELN('Codierungen zugeordnet...');
CODEAUS(DATEI1,DATEI2);
WRITELN('Code auf Festplatte...');
WRITELN('Kompression : ',100-AUSZEICHEN/GESZEICHEN*100:0:2,'%');
END
ELSE
BEGIN
DEKOMPRESS(DATEI1,DATEI2);
WRITE('Dekompression erfolgt...')
END;
WRITE('Drücke eine Taste');CH:=READKEY
END. |
Gruß
Fiete _________________ Fietes Gesetz: use your brain (THINK)
|
|
maycontainnuts
Hält's aus hier
Beiträge: 5
|
Verfasst: Mi 23.04.08 20:54
hi.
Sorry, das ich mich erst wieder so spät melde. Prüfungen halt
@fiete... ehrlich gesagt, verstehe ich nicht viel von deinem Quelltext (bin halt noch neu in delphi :/) aber trotzdem danke.
@topic.
Ich hab mir - wie gesagt - überlegt, eine 'bitstream'-klasse zu erstellen. Nur hab ich bedenken, ob dies so wirklich schnell ist.
Hat jemand da ungefähre Erfahrungsberichte?
grez
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Mi 23.04.08 21:57
Je nach dem wie man den Bitstream implementiert, hat man gegenüber normalen Streams kaum nachteile. Einziger Punkt, der hierbei zu beachten ist, ist die Tatsache, dass für jedes Byte noch ein Bitshift dazu kommt sowie eine Berechnung. Voraussetzung hierfür ist jedoch, dass Du gleich Bitgruppenweise arbeitest.
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
maycontainnuts
Hält's aus hier
Beiträge: 5
|
Verfasst: Mi 07.05.08 13:56
hi
Hab den bitstream jetzt mal so implementiert:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
| unit bitstream;
interface
uses
Classes, SysUtils;
type
Tbitstream = class(TObject)
public
constructor Create(const FromFile: string);
function next: boolean;
private
readbyte: byte;
bytepos: shortint;
Stream: TFileStream;
end;
implementation
constructor Tbitstream.Create(const FromFile: string);
begin
Stream := TFileStream.Create(FromFile,fmOpenRead or fmShareExclusive);
bytepos := -1;
end;
function Tbitstream.next;
begin
if bytepos = -1 then begin
Stream.Read(readbyte,1);
bytepos := 7;
end;
result := false;
case bytepos of
7:
if (readbyte and 128) = 128 then begin
result := true;
end;
6:
if (readbyte and 64) = 64 then begin
result := true;
end;
5:
if (readbyte and 32) = 32 then begin
result := true;
end;
4:
if (readbyte and 16) = 16 then begin
result := true;
end;
3:
if (readbyte and 8) = 8 then begin
result := true;
end;
2:
if (readbyte and 4) = 4 then begin
result := true;
end;
1:
if (readbyte and 2) = 2 then begin
result := true;
end;
0:
if (readbyte and 1) = 1 then begin
result := true;
end;
end;
bytepos := bytepos -1;
end;
end. |
denkt ihr, damit kann man was anfangen?^^
grez
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Mi 07.05.08 15:46
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
|
maycontainnuts