Le codage de huffman adaptatif

Le codage de huffman adaptatif

Le codage de huffman adaptatif : Plusieurs milliers de conseils pour vous faciliter la vie.

LZH mise en œuvre de Pascal

l'auteur: DOUGLAS WEBB

Unite LZH

{$A ,B-,D-,E-,F-,I ,L,N,O,R,S,V}

(*
* LZHUF.C English version 1.0
* Base sur la version Japonaise 29-NOV-1988
* LZSS code par Haruhiko OKUMURA
* le Codage de Huffman Adaptatif code par Haruyasu YOSHIZAKI
* Edite et traduit de l'anglais par Kenji RIKITAKE
* Traduit a partir de C, Turbo Pascal par Douglas Webb 2/18/91
* mise a Jour et correction d'un bug de TP version 4/29/91 (Desole!!)
*)

{
Cette Unite permet a l'utilisateur de commpress de donnees a l'aide d'une combinaison de
LZSS la Compression et le codage de Huffman adaptatif, ou a l'inverse pour decompresser
les donnees precedemment Comprime par cette Unite.

Il y a un certain nombre d'options de l'endroit ou les donnees a compresser/
decompresse vient/va.

En fait, il necessite de passer du 'LZHPack' Procedure 2 procedure
parametre de Type & #39 GetProcType & #39 et & #39 PutProcType & #39 (declaree ci-dessous)
accepte 3 parametres et d'agir dans tous les sens comme un & #39 BlockRead & #39 / & #39 BlockWrite & #39
l'appel de Procedure. Votre & #39 GetProcType & #39 Procedure doit renvoyer les donnees
pour etre Compresse, et Votre & #39 PutProcType & #39 Procedure devrait faire quelque chose avec
les donnees Compressees (ie., mettre dans un Fichier). Dans le Cas ou vous avez besoin de savoir (et de
- vous faire si vous souhaitez decompresser de nouveau ces donnees) le nombre d'Octets dans le
donnees Compressees (l'original, pas Compresse taille) est retourne dans & #39 Bytes_Written & #39 .

GetBytesProc = Procedure(Var DTA NBytes:Word Var Bytes_Got : Word)

DTA est le debut d'un emplacement de memoire ou les informations retournees doivent
. NBytes est le nombre d'Octets demandes. Le nombre reel d'Octets
retourne doit etre transmis dans Bytes_Got (si il n'y a plus de donnees a 0
doit etre retourne).

PutBytesProc = Procedure(Var DTA NBytes:Word Var Bytes_Got : Word)

Comme ci-dessus, sauf qu'au lieu de demander des donnees la Procedure est dumping
donnees Compressees, faire quelque chose Avec elle.

'LZHUnPack' est essentiellement la meme chose en sens inverse. Il exige
de procedure des parametres de Type & #39 PutProcType & #39 / & #39 GetProcType & #39
va agir comme ci-dessus. & #39 GetProcType & #39 doit recuperer les donnees sont Compressees a l'aide de
'LZHPack' (ci-dessus) et le nourrir pour le deballage de routine.
& #39 PutProcType & #39 doit accepter le decompresse donnees et de faire quelque chose
withit. Vous devez aussi passer a la taille d'origine de l'decompresse de donnees,
un manquement a avoir des resultats negatifs.

Don & #39 t Oublier que de procedure, les parametres de l' & #39 GetProcType & #39 / & #39 PutProcType & #39
les Procedures doivent etre rassembles dans la & #39 F & #39 l'etat afin d'eviter une catastrophe.

}

{ remarque: Toutes les grandes structures de donnees Pour ces routines sont attribues lors de la
necessaire dans le tas, et libere lorsque termine. Donc, lorsque vous n'utilisez pas
les besoins en memoire sont minimes. Toutefois, cette Unite Utilise sur 34K de
espace de tas, et 400 Octets de la pile lors de l'utilisation. }

Interface

Type

PutBytesProc = Procedure(Var DTA NBytes : Word Var Bytes_Put : Word)
GetBytesProc = Procedure(Var DTA NBytes : Word Var Bytes_Got : Word)

Procedure LZHPack(Var Bytes_Written : LongInt
GetBytes : GetBytesProc
PutBytes : PutBytesProc)

Procedure LZHUnpack(TextSize : LongInt
GetBytes : GetBytesProc
PutBytes : PutBytesProc)

la mise en Œuvre

Const
Exit_OK = 0
Exit_FAILED = 1

{ LZSS Parametres }
N = 4096 { Taille de la memoire tampon de Chaîne }
F = 60 { Taille de look-ahead buffer }
SEUIL = 2
NUL = N { la fin de l'arbre & #39 s node }

{ codage de Huffman parametres }
N_Char = (256 - SEUIL F)

{ code de Caractere (:= 0..N_Char-1) }
T = (N_Char * 2 - 1) { Taille du tableau }
R = (T - 1) { position racine }

{ mise a jour lorsque la frequence cumulee }
{ atteint cette valeur }
MAX_FREQ = $8000

{
* Tables De codage/decodage superieur a 6 bits
* glissement dictionnaire Pointeur
}

{ codeur table }
p_len : Array[0..63] de Byte =
($03, $04, $04, $04, $05, $05, $05, $05,
$05, $05, $05, $05, $06, $06, $06, $06,
$06, $06, $06, $06, $06, $06, $06, $06,
$07, $07, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $07, $07,
$08, $08, $08, $08, $08, $08, $08, $08,
$08, $08, $08, $08, $08, $08, $08, $08)

p_code : Array[0..63] de Byte =
($00, $20, $30, $40, $50, $58, $60, $68,
$70, $78, $80, $88, $90, $94, $98, $9C,
$A0, $A4, $A8, $CA, $B0, $B4, $B8, $BC,
$C0, $C2, $C4, $C6, $C8, $CA, $CC $EC,
$D0 $D2, $D4, $D6, $D8, $DA $DC, $DE,
$E0, $E2, $E4, $E6, $E8, $EE $EC, $EE,
$F0, $F1, $A2, $F3, $F4, $F5, $F6, $F7,
$F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF)

{ decodeur table }
d_code : Array[0..255] de Byte =
($00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$02, $02, $02, $02, $02, $02, $02, $02,
$02, $02, $02, $02, $02, $02, $02, $02,
$03, $03, $03, $03, $03, $03, $03, $03,
$03, $03, $03, $03, $03, $03, $03, $03,
$04, $04, $04, $04, $04, $04, $04, $04,
$05, $05, $05, $05, $05, $05, $05, $05,
$06, $06, $06, $06, $06, $06, $06, $06,
$07, $07, $07, $07, $07, $07, $07, $07,
$08, $08, $08, $08, $08, $08, $08, $08,
$09, $09, $09, $09, $09, $09, $09, $09,
$0, $0, $0, $0, $0, $0, $0, $0A,
$0B, $0B, $0B, $0B, $0B, $0B, $0B, $0B,
$0C, $0C, $0C, $0C, $0, $0, $0, $0D,
$0E, $0E, $0E, $0E, $0F, $0F, $0F, $0F,
$10, $10, $10, $10, $11, $11, $11, $11,
$12, $12, $12, $12, $13, $13, $13, $13,
$14, $14, $14, $14, $15, $15, $15, $15,
$16, $16, $16, $16, $17, $17, $17, $17,
$18, $18, $19, $19, $1A, $1A, 1 milliard de DOLLARS, 1 milliard de DOLLARS,
$1C $1C $1D $1D $1F, $1F, $1F, $1F,
$20, $20, $21, $21, $22, $22, $23, $23,
$24, $24, $25, $25, $26, $26, $27, $27,
$28, $28, $29, $29, $2A, $2A $2B $2B,
$2C, $2 ET $2D, $2D, $2E, $2E, $2F, $2F
$30, $31, $32, $33, $34, $35, $36, $37,
$38, de 39$, $3A, 3 G$, $3, $3D, $3F, $3F)

d_len : Array[0..255] de Byte =
($03, $03, $03, $03, $03, $03, $03, $03,
$03, $03, $03, $03, $03, $03, $03, $03,
$03, $03, $03, $03, $03, $03, $03, $03,
$03, $03, $03, $03, $03, $03, $03, $03,
$04, $04, $04, $04, $04, $04, $04, $04,
$04, $04, $04, $04, $04, $04, $04, $04,
$04, $04, $04, $04, $04, $04, $04, $04,
$04, $04, $04, $04, $04, $04, $04, $04,
$04, $04, $04, $04, $04, $04, $04, $04,
$04, $04, $04, $04, $04, $04, $04, $04,
$05, $05, $05, $05, $05, $05, $05, $05,
$05, $05, $05, $05, $05, $05, $05, $05,
$05, $05, $05, $05, $05, $05, $05, $05,
$05, $05, $05, $05, $05, $05, $05, $05,
$05, $05, $05, $05, $05, $05, $05, $05,
$05, $05, $05, $05, $05, $05, $05, $05,
$05, $05, $05, $05, $05, $05, $05, $05,
$05, $05, $05, $05, $05, $05, $05, $05,
$06, $06, $06, $06, $06, $06, $06, $06,
$06, $06, $06, $06, $06, $06, $06, $06,
$06, $06, $06, $06, $06, $06, $06, $06,
$06, $06, $06, $06, $06, $06, $06, $06,
$06, $06, $06, $06, $06, $06, $06, $06,
$06, $06, $06, $06, $06, $06, $06, $06,
$07, $07, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $07, $07,
$07, $07, $07, $07, $07, $07, $07, $07,
$08, $08, $08, $08, $08, $08, $08, $08,
$08, $08, $08, $08, $08, $08, $08, $08)

getbuf : Word = 0
getlen : Octets = 0
putlen : Octets = 0
putbuf : Word = 0
TextSize : LongInt = 0
codesize : LongInt = 0
printcount : LongInt = 0
match_position : Integer = 0
match_length : Integer = 0

Type
FreqType = Array[0..T] de Mot
FreqPtr = ^FreqType
PntrType = Array[0..pred(T N_Char)] of Integer
pntrPtr = ^PntrType
SonType = Array[0..pred(T)] of Integer
SonPtr = ^SonType
TextBufType = Array[0..N F - 2] de Byte
TBufPtr = ^TextBufType
WordRay = Array[0..N] of Integer
WordRayPtr = ^WordRay
BWordRay = Array[0..N 256] of Integer
BWordRayPtr = ^BWordRay

Var
Text_buf : TBufPtr
lson, papa : WordRayPtr
rson : BWordRayPtr
freq : FreqPtr { cumulatif freq table }

{
* en pointant du doigt les nœuds parents.
* zone [T..(T N_Char - 1)] sont des Pointeurs Pour les feuilles
}
prnt : pntrPtr

{ pointage de nœuds enfants (fils[], fils[] 1)}
fils : SonPtr

Procedure InitTree { Initialisation de l'arbre }
Var
i : Integer
begin
For i := N 1 a N 256 do
rson^[i] := NUL { racine }
For i := 0 to N do
papa^[i] := NUL { noeud }
fin

Procedure InsertNode(R : Entier) { Insertion de nœud de l'arbre }
Var
tmp, i, p, cmp : Integer
cle : TBufPtr
c : Mot
begin
cmp := 1
- cles := @Text_buf^[R]
p := succ(N)^[0]
rson^[R] := NUL
lson^[R] := NUL
match_length := 0
Alors que match_length < F n'
begin
if (cmp >= 0) then
begin
if (rson^[p] <> NUL), alors
p := rson^[p]
else
begin
rson^[p] := R
papa^[R] := p
Sortie
fin
fin
else
begin
if (lson^[p] <> NUL), alors
p := lson^[p]
else
begin
lson^[p] := R
papa^[R] := p
Sortie
fin
fin
i := 0
cmp := 0
While (i < F) et (cmp = 0) do
begin
inc(i)
cmp := cle^[i] - Text_buf^[i]
fin
if (i > SEUIL) puis
begin
tmp := pred((R - p) et pred(N))
if (i > match_length)
begin
match_position := tmp
match_length := i
fin
if (match_length < F) et (i = match_length)
begin
c := tmp
if (c < match_position)
match_position := c
fin
fin
end { While True do }
papa^[R] := papa^[p]
lson^[R] := lson^[p]
rson^[R] := rson^[p]
papa^[lson^[p]] := R
papa^[rson^[p]] := R
if (rson^[papa^[p]] = p)
rson^[papa^[p]] := R
else
lson^[papa^[p]] := R
papa^[p] := NUL { supprimer les p }
fin

Procedure DeleteNode(p : Entier) { Suppression de nœud de l'arbre }
Var
q : Integer
begin
if (papa^[p] = NUL), alors
Sortie { non }
if (rson^[p] = NUL), alors
q := lson^[p]
else if (lson^[p] = NUL), alors
q := rson^[p]
else
begin
q := lson^[p]
if (rson^[q] <> NUL), alors
begin
Repeat
q := rson^[q]
Jusqu'a ce que (rson^[q] = NUL)
rson^[papa^[q]] := lson^[q]
papa^[lson^[q]] := papa^[q]
lson^[q] := lson^[p]
papa^[lson^[p]] := q
fin
rson^[q] := rson^[p]
papa^[rson^[p]] := q
fin
papa^[q] := papa^[p]
if (rson^[papa^[p]] = p)
rson^[papa^[p]] := q
else
lson^[papa^[p]] := q
papa^[p] := NUL
fin

{ codage de Huffman parametres }

la Fonction GetBit(GetBytes : GetBytesProc) : Entier { obtenir un peu }
Var
j' : Octet
i2 : Integer
resultat : Mot
begin
While (getlen <= 8) ne
begin
GetBytes(i, 1, suite)
si resultat = 1 puis
i2 := i
d'autre i2 := 0
getbuf := getbuf ou (i2 shl (8 - getlen))
inc(getlen, 8)
fin
i2 := getbuf
getbuf := getbuf shl 1
dec(getlen)
GetBit := Integer((i2 < 0))
fin

la Fonction GetByte(GetBytes : GetBytesProc) : Entier { obtenir un Octet }
Var
j : Octet
j', resultat : le Mot
begin
While (getlen <= 8) ne
begin
GetBytes(j, 1, suite)
si resultat = 1 puis
i := j
else
i := 0
getbuf := getbuf ou (je shl (8 - getlen))
inc(getlen, 8)
fin
i := getbuf
getbuf := getbuf shl 8
dec(getlen, 8)
GetByte := Integer(i shr 8)
fin

Procedure Putcode(l : Entier c : Mot
PutBytes : PutBytesProc) { sortie c bits }
Var
Temp : Octet
A : Wor
begin
putbuf := putbuf ou (c shr putlen)
inc(putlen, l)
if (putlen >= 8)
begin
Temp := putbuf shr 8
PutBytes(Temp, 1, Ai)
dec(putlen, 8)
if (putlen >= 8) puis
begin
Temp := lo(putbuf)
PutBytes(Temp, 1, Ai)
inc(codesize, 2)
dec(putlen, 8)
putbuf := c shl (l - putlen)
fin
else
begin
putbuf := putbuf shl 8
inc(codesize)
fin
fin
fin

{ initialiser freq arbre }

Procedure StartHuff
Var
i, j : Integer
begin
For i := 0 to pred(N_Char) ne
begin
freq^[i] := 1
fils^[i] := je T
prnt^[i, T] := i
fin
i := 0
j := N_Char
While (j <= R) ne
begin
freq^[j] := freq^[i] freq^[i 1]
fils^[j] := i
prnt^[i] := j
prnt^[i 1] := j
inc(i, 2)
inc(j)
fin
freq^[T] := $ffff
prnt^[R] := 0
fin

{ reconstruire freq arbre }

Procedure reConst
Var
j', j, k, tmp : Integer
F, l : Mot
begin
{ halven cumulatif freq Pour les nœuds feuilles }
j := 0
For i := 0 to pred(T) ne
begin
if (fils^[i] >= T)
begin
freq^[j] := succ(freq^[i]) div 2 {@@ Bug Fix MOD -> div @@}
fils^[j] := fils^[i]
inc(j)
fin
fin
{ faire un arbre : tout d'abord, connecter les noeuds enfants }
i := 0
j := N_Char
While (j < T) ne
begin
k := succ(i)
F := freq^[i] freq^[k]
freq^[j] := F
k := pred(j)
F < freq^[k]
dec(k)
inc(k)
l := (j - k) shl 1
tmp := succ(k)
move(freq^[k], freq^[tmp], l)
freq^[k] := F
move(fils^[k], fils^[tmp], l)
fils^[k] := i
inc(i, 2)
inc(j)
fin
{ connecter les nœuds parents }
For i := 0 to pred(T) ne
begin
k := fils^[i]
if (k >= T)
begin
prnt^[k] := i
fin
else
begin
prnt^[k] := i
prnt^[succ(k)] := i
fin
fin
fin

{ mise a jour de la frequence de l'arbre }

la Procedure de mise a jour(c : Entier)
Var
i, j, k, l : Entier
begin
if (freq^[R] = MAX_FREQ) puis
begin
reConst
fin
c := prnt^[c T]
Repeat
inc(freq^[c])
k := freq^[c]
{ swap nœuds de garder l'arbre freq-commande }
l := succ(c)
if (k > freq^[l]) puis
begin
While (k > freq^[l]) ne
inc(l)
dec(l)
freq^[c] := freq^[l]
freq^[l] := k
i := fils^[c]
prnt^[i] := l
if (i < T) puis prnt^[succ(i)] := l
j := fils^[l]
fils^[l] := i
prnt^[j] := c
if (j < T) puis prnt^[succ(j)] := c
fils^[c] := j
c := l
fin
c := prnt^[c]
Jusqu'a ce que (c = 0) { Repeter Jusqu'a atteindre la racine }
fin

Var
code, len : Word

Procedure EncodeChar(c : Word PutBytes : PutBytesProc)
Var
j' : Mot
j, k : Entier
begin
i := 0
j := 0
k := prnt^[c T]
{ rechercher les connexions a partir de nœud feuille a la racine }
Repeat
i := i shr 1
{
si le nœud & #39 s adresse est impair, la sortie 1
else sortie 0
}
si la valeur Booleenne(k et 1) then inc(i, $8000)
inc(j)
k := prnt^[k]
Jusqu'a ce que (k = R)
Putcode(j, i, PutBytes)
code := i
len := j
mise a jour(c)
fin

Procedure EncodePosition(c : Word PutBytes : PutBytesProc)
Var
i, j : Mot
begin
{ sortie superieure a 6 bits Avec le codage }
i := c shr 6
j := p_code[i]
Putcode(p_len[i], j shl 8, PutBytes)
{ sortie inferieure a 6 bits directement }
Putcode(6, c et $3f) shl 10, PutBytes)
fin

Procedure Encodeend(PutBytes : PutBytesProc)
Var
Temp : Octet
A : Mot
begin
si la valeur Booleenne(putlen)
begin
Temp := lo(putbuf shr 8)
PutBytes(Temp, 1, Ai)
inc(codesize)
fin
fin

la Fonction DecodeChar(GetBytes : GetBytesProc) : Integer
Var
c : Mot
begin
c := fils^[R]
{
* demarrer la recherche de l'arbre de la racine vers les feuilles.
* choisir nœud #(fils[]) si l'entree bit = 0
* sinon, choisissez #(fils[] 1) (entree bit = 1)
}
While (c < T) ne
begin
c := c GetBit(GetBytes)
c := fils^[c]
fin
c := c - T
mise a jour(c)
DecodeChar := Integer(c)
fin

la Fonction DecodePosition(GetBytes : GetBytesProc) : Mot
Var
i, j, c : Mot
begin
{ decoder superieure a 6 bits a partir de la table }
i := GetByte(GetBytes)
c := Mot(d_code[i] shl 6)
j := d_len[i]
{ entree inferieur a 6 bits directement }
dec(j, 2)
While j <> 0 do
begin
i: = i shl 1) GetBit(GetBytes)
dec(j)
fin
DecodePosition := c ou i et $3f
fin

{ Compression }

Procedure InitLZH
begin
getbuf := 0
getlen := 0
putlen := 0
putbuf := 0
TextSize := 0
codesize := 0
printcount := 0
match_position := 0
match_length := 0
nouveau(lson)
nouveau(papa)
nouveau(rson)
nouveau(Text_buf)
nouveau(freq)
nouveau(prnt)
nouveau(fils)
fin

Procedure endLZH
begin
disposer(fils)
disposer(prnt)
disposer(freq)
disposer(Text_buf)
disposer(rson)
disposer(papa)
disposer(lson)
fin

Procedure LZHPack(Var Bytes_Written : LongInt
GetBytes : GetBytesProc
PutBytes : PutBytesProc)
Var
ct : Octet
j', len, R, s, last_match_length : Integer
A : Mot
begin
InitLZH
TextSize := 0 { rewind et rescan }
StartHuff
InitTree
s := 0
R := N - F
fillChar(Text_buf^[0], R, & #39 & #39 )
len := 0
A := 1
While (len < F) et (<> 0) faire
begin
GetBytes(ct, 1, Ai)
si Ai <> 0 then
begin
Text_buf^[R len] := ct
inc(len)
fin
fin
TextSize := len
For i := 1 a F ne
InsertNode(R - i)
InsertNode(R)
Repeat
if (match_length > len)
match_length := len
if (match_length <= SEUIL)
begin
match_length := 1
EncodeChar(Text_buf^[R], PutBytes)
fin
else
begin
EncodeChar(255 SEUIL match_length, PutBytes)
EncodePosition(match_position, PutBytes)
fin
last_match_length := match_length
i := 0
A := 1
While (i < last_match_length) et (<> 0) faire
begin
GetBytes(ct, 1, Got)
si Ai <> 0 then
begin
DeleteNode(s)
Text_buf^[s] := ct
if (s < pred(F))
Text_buf^[N] := ct
s := succ(s) et pred(N)
R := succ(R) et pred(N)
InsertNode(R)
inc(i)
fin
fin
inc(TextSize, i)
While (i < last_match_length) ne
begin
inc(i)
DeleteNode(s)
s := succ(s) et pred(N)
R := succ(R) et pred(N)
dec(len)
si la valeur Booleenne(len) puis InsertNode(R)
fin
Jusqu'a ce que (len <= 0)
Encodeend(PutBytes)
endLZH
Bytes_Written := TextSize
fin

Procedure LZHUnpack(TextSize : LongInt
GetBytes : GetBytesProc
PutBytes : PutBytesProc)
Var
c, i, j, k, R : Entier
c2, un : Octet
count : LongInt
Mettre : Mot
begin
InitLZH
StartHuff
R := N - F
fillChar(Text_buf^[0], R, & #39 & #39 )
count := 0
While compteur < TextSize ne
begin
c := DecodeChar(GetBytes)
if (c < 256)
begin
c2 := lo(c)
PutBytes(c2, 1)
Text_buf^[R] := c
inc(R)
R := R et pred(N)
inc(nombre)
fin
else
begin
i := (R - succ(DecodePosition(GetBytes))) et pred(N)
j := c - 255 SEUIL de
Pour k := 0 pred(j) ne
begin
c := Text_buf^[(i k) et pred(N)]
c2 := lo(c)
PutBytes(c2, 1)
Text_buf^[R] := c
inc(R)
R := R et pred(N)
inc(nombre)
fin
fin
fin
endLZH
fin
a la fin.