Adaptación de la codificación huffman

Adaptacion de la codificacion huffman

Adaptacion de la codificacion huffman : Multi-millones de consejos para hacer su vida mas facil.

LZH implementacion en Pascal

Colaborador: DOUGLAS WEBB

la Unidad de LZH

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

(*
* LZHUF.C ingles version 1.0
* Basado en la version Japonesa 29-NOV-1988
* LZSS codificado por Haruhiko OKUMURA
* Adaptacion de la Codificacion Huffman codificado por Haruyasu YOSHIZAKI
* Editado y traducido al ingles por Kenji RIKITAKE
* Traducido del C a Turbo Pascal por Douglas Webb 2/18/91
* Actualizacion y correccion de la correccion de TP version 4/29/91 (lo Siento!!)
*)

{
Esta Unidad permite al usuario commpress de datos utilizando una combinacion de
LZSS de Compresion y de adaptacion de la codificacion Huffman, o por el contrario para descomprimir
los datos que previamente fue Comprimido por esta Unidad.

Hay una serie de opciones en cuanto a donde los datos se Comprimen/
descomprimido viene/va.

De hecho, se requiere que se le pase el 'LZHPack' Procedimiento 2 procedimiento
parametro de Tipo & #39 GetProcType & #39 y & #39 PutProcType & #39 (declarado abajo) que
se aceptan 3 parametros y actuar en todos los sentidos, como una & #39 BlockRead & #39 / & #39 BlockWrite & #39
Procedimiento de llamada. Tu & #39 GetProcType & #39 Procedimiento debe devolver los datos
para ser Comprimido, y Su & #39 PutProcType & #39 Procedimiento deberia hacer algo con
los datos Comprimidos (ie., colocar en un Archivo). En Caso de que usted necesita saber (y
hay que hacer si quieres descomprimir estos datos de nuevo) el numero de Bytes en el
datos Comprimidos (original, no tamaño Comprimido) se devuelve en & #39 Bytes_Written & #39 .

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

DTA es el inicio de una ubicacion de memoria donde la informacion devuelta debe
ser. NBytes es el numero de Bytes solicitado. El numero real de Bytes
devuelto debe ser aprobada en Bytes_Got (si no hay mas datos, a continuacion, 0
debe ser devuelto).

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

Como el anterior, excepto que en lugar de pedir los datos el Procedimiento es el dumping
datos Comprimidos, hacer algo Con el.

'LZHUnPack' es basicamente lo mismo a la inversa. Se requiere
procedimiento de parametros de Tipo & #39 PutProcType & #39 / & #39 GetProcType & #39, que
actuara como anteriormente. & #39 GetProcType & #39 debe recuperar datos Comprimidos el uso de
'LZHPack' (arriba) y alimentar el desembalaje de rutina conforme a lo solicitado.
& #39 PutProcType & #39 debe aceptar los datos comprimidos y hacer algo
withit. Tambien se debe pasar en el tamaño original de los datos comprimidos,
no hacerlo puede tener resultados adversos.

No & #39 t Olvidar que como procedimiento de los parametros de la & #39 GetProcType & #39 / & #39 PutProcType & #39
Procedimientos deben ser Compilados en el & #39 F & #39 estado para evitar una catastrofe.

}

{ nota: Todas las grandes estructuras de datos Para estas rutinas son asignados cuando
se necesita del monton, y se desasignan cuando haya terminado. Asi que cuando no este en uso
requisitos de memoria son minimos. Sin embargo, esta Unidad Utiliza sobre 34K de
espacio de monton, y 400 Bytes de la pila cuando esta en uso. }

Interfaz

Tipo

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

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

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

Aplicacion

Const
Exit_OK = 0
Exit_FAILED = 1

{ LZSS Parametros }
N = 4096 { Tamaño de bufer de Cadena }
F = 60 { Tamaño de look-ahead buffer }
UMBRAL = 2
NUL = N { fin de arbol & #39 s nodo }

{ la codificacion Huffman parametros }
N_Char = (256 - UMBRAL F)

{ codigo de Caracteres (:= 0..N_Char-1) }
T = (N_Char * 2 - 1) { Tamaño de la tabla }
R = (T - 1) { la posicion de la raiz }

{ actualizacion cuando la frecuencia acumulativa }
{ llegue a este valor }
MAX_FREQ = $8000

{
* Tablas De codificacion/decodificacion superior 6 bits
* deslizamiento diccionario Puntero
}

{ codificador de tabla }
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, $CE,
$D0, $D2, $D4, $D6, $8, $DA, $DC $DE,
$E0, $E2 $E4, $E6, $E8, $EA $CE $EE,
$F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,
$F8, $F9, $FA, $FB, $FC $FD, $FE, $FF)

{ decodificador de tabla }
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,
$0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,
$0, $0, $0, $0, $0, $0, $0, $0,
$0, $0, $0, $0, $0D, $0D, $0D, $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, $1B, $1B,
$1C $1C $1D, $1D, $1E, $1E, $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, $2C, $2D, $2D, $2E $2E $2F, $2F
$30, $31, $32, $33, $34, $35, $36, $37,
$38, $39, $3A $3B, $3C, $3D, $3E, $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 : Palabra = 0
getlen : Bytes = 0
putlen : Bytes = 0
putbuf : Palabra = 0
TextSize : LongInt = 0
codesize : LongInt = 0
printcount : LongInt = 0
match_position : Integer = 0
match_length : Integer = 0

Tipo
FreqType = Array[0..N] de la Palabra
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 Bytes
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 { acumulativo de frecuencias de la tabla }

{
* señalar los padres de los nodos.
* [T..(T N_Char - 1)] son Punteros Para las hojas
}
prnt : pntrPtr

{ señalando los nodos hijos (hijo[], hijo de[] 1)}
hijo : SonPtr

Procedimiento InitTree { Inicializar arbol }
Var
i : Integer
begin
For i := N 1 a N 256
rson^[i] := NUL { root }
For i := 0 para N
papa^[i] := NUL { nodo }
fin

Procedimiento InsertNode(R : Entero) { Insertar nodo en el arbol }
Var
tmp, i, p, cmp : Integer
clave : TBufPtr
c : Word
begin
cmp := 1
clave := @Text_buf^[R]
p := succ(N)^[0]
rson^[R] := NUL
lson^[R] := NUL
match_length := 0
Mientras match_length < F
begin
si (cmp >= 0) entonces
begin
si (rson^[p] <> NULL) entonces
p := rson^[p]
else
begin
rson^[p] := R
papa^[R] := p
Salir
fin
fin
else
begin
si (lson^[p] <> NULL) entonces
p := lson^[p]
else
begin
lson^[p] := R
papa^[R] := p
Salir
fin
fin
i := 0
cmp := 0
Mientras (i < F) y (cmp = 0) hacer
begin
inc(i)
cmp : tecla = ^[i] - Text_buf^[p, i]
fin
if (i > UMBRAL) a continuacion,
begin
tmp := pred((R - p) y pred(N))
if (i > match_length), a continuacion,
begin
match_position := tmp
match_length := i
fin
si (match_length < F) y (i = match_length), a continuacion,
begin
c := tmp
if (c < match_position), a continuacion,
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
si (rson^[papa^[p]] = p) entonces
rson^[papa^[p]] := R
else
lson^[papa^[p]] := R
papa^[p] := NUL { remove p }
fin

Procedimiento DeleteNode(p : Entero) { Borrar nodo del arbol }
Var
q : Integer
begin
si (papa^[p] = NULL) entonces
Salida { no registrados }
si (rson^[p] = NULL) entonces
p := lson^[p]
else if (lson^[p] = NULL) entonces
p := rson^[p]
else
begin
p := lson^[p]
si (rson^[q] <> NULL) entonces
begin
Repetir
p := rson^[q]
Hasta que (rson^[q] = NULL)
rson^[papa^[q]] := lson^[q]
papa^[lson^[q]] := papa^[q]
lson^[p] := lson^[p]
papa^[lson^[p]] := q
fin
rson^[p] := rson^[p]
papa^[rson^[p]] := q
fin
papa^[p] := papa^[p]
si (rson^[papa^[p]] = p) entonces
rson^[papa^[p]] := q
else
lson^[papa^[p]] := q
papa^[p] := NUL
fin

{ la codificacion Huffman parametros }

la Funcion de GetBit(GetBytes : GetBytesProc) : Integer { obtener un bit }
Var
i : Byte
i2 : Integer
resultado :
begin
Mientras (getlen <= 8) hacer
begin
metodo GetBytes(i, 1, resultado)
si el resultado es = 1, a continuacion,
i2 := i
otra cosa i2 := 0
getbuf := getbuf o (i2 shl (8 - getlen))
inc(getlen, 8)
fin
i2 := getbuf
getbuf := getbuf shl 1
dec(getlen)
GetBit := Entero((i2 < 0))
fin

la Funcion de GetByte(GetBytes : GetBytesProc) : Integer { obtener un Byte }
Var
j : Byte
i, resultado : Word
begin
Mientras (getlen <= 8) hacer
begin
metodo GetBytes(j, 1, resultado)
si el resultado es = 1, a continuacion,
i := j
else
i := 0
getbuf := getbuf o (i shl (8 - getlen))
inc(getlen, 8)
fin
i := getbuf
getbuf := getbuf shl 8
dec(getlen, 8)
GetByte := Integer(i shr 8)
fin

Procedimiento Putcode(l : Integer c : Word
PutBytes : PutBytesProc) { salida de c bits }
Var
Temp : Byte
Tengo : Wor
begin
putbuf := putbuf o (c shr putlen)
inc(putlen, l)
si (putlen >= 8), a continuacion,
begin
Temp := putbuf shr 8
PutBytes(Temp, 1, Got)
dec(putlen, 8)
si (putlen >= 8) a continuacion,
begin
Temp := lo(putbuf)
PutBytes(Temp, 1, Got)
inc(codesize, 2)
dec(putlen, 8)
putbuf : c= shl (l - putlen)
fin
else
begin
putbuf := putbuf shl 8
inc(codesize)
fin
fin
fin

{ inicializar freq arbol }

Procedimiento StartHuff
Var
i, j : Integer
begin
For i := 0 a pred(N_Char)
begin
freq^[i] := 1
hijo^[i] := i T
prnt^[T] := i
fin
i := 0
j := N_Char
Mientras (j <= R)
begin
freq^[j] := freq^[i] frec^[i 1]
hijo^[j] := i
prnt^[i] := j
prnt^[i 1] := j
inc(i, 2)
inc(j)
fin
freq^[T] := $ffff
prnt^[I] := 0
fin

{ reconstruir freq arbol }

el Procedimiento de reConst
Var
yo, j, k, tmp : Integer
F, l : Palabra
begin
{ halven acumulativo de frecuencias Para los nodos hoja }
j := 0
For i := 0 a pred(T)
begin
si (hijo^[i] >= T) entonces
begin
freq^[j] := succ(freq^[i]) div 2 {@@ Correccion de Error MOD -> div @@}
hijo^[j] := hijo^[i]
inc(j)
fin
fin
{ hacer un arbol : en primer lugar, conecte los nodos hijos }
i := 0
j := N_Char
Mientras (j < T) hacer
begin
k := succ(i)
F := freq^[i] frec^[k]
freq^[j] := F
k := pred(j)
Mientras que la F < freq^[k]
dec(k)
inc(k)
l := (j - k) shl 1
tmp := succ(k)
mover(freq^[k], freq^[tmp], l)
freq^[k] := F
mover(hijo^[k], hijo^[tmp], l)
hijo^[k] := i
inc(i, 2)
inc(j)
fin
{ conectar nodos primarios }
For i := 0 a pred(T)
begin
k := hijo^[i]
if (k >= T) entonces
begin
prnt^[k] := i
fin
else
begin
prnt^[k] := i
prnt^[e(k)] := i
fin
fin
fin

{ actualizacion freq arbol }

actualizacion de Procedimiento(c : Integer)
Var
i, j, k, l : Integer
begin
si (freq^[R] = MAX_FREQ) a continuacion,
begin
reConst
fin
c := prnt^[c, T]
Repetir
inc(freq^[c])
k := freq^[c]
{ swap nodos para mantener el arbol freq-ordeno }
l := succ(c)
if (k > freq^[l]) a continuacion,
begin
Mientras (k > freq^[l])
inc(l)
dec(l)
freq^[c] := freq^[l]
freq^[l] := k
i := hijo^[c]
prnt^[i] := l
if (i < T) luego prnt^[e(i)] := l
j := hijo^[l]
hijo^[l] := i
prnt^[j] := c
if (j < T), a continuacion, prnt^[succ(j)] := c
hijo^[c] := j
c := l
fin
c := prnt^[c]
Hasta (c = 0) { Repetir Hasta llegar a la raiz }
fin

Var
codigo, len : Word

Procedimiento EncodeChar(c : Palabra PutBytes : PutBytesProc)
Var
yo : Word
j, k : Integer
begin
i := 0
j := 0
k := prnt^[c, T]
{ busqueda de conexiones del nodo hoja a la raiz }
Repetir
i := i shr 1
{
si el nodo & #39 s direccion es impar, la salida 1
otro de salida 0
}
si Booleano(k y 1), a continuacion, inc(i, $8000)
inc(j)
k := prnt^[k]
Hasta (k = R)
Putcode(j, i, PutBytes)
codigo := i
len := j
update(c)
fin

Procedimiento EncodePosition(c : Palabra PutBytes : PutBytesProc)
Var
i, j : Word
begin
{ salida superior de 6 bits Con codificacion }
i := c shr 6
j := p_code[i]
Putcode(p_len[i], j shl 8, PutBytes)
{ salida inferior de 6 bits directamente }
Putcode(6, c y $3f) shl 10, PutBytes)
fin

Procedimiento Encodeend(PutBytes : PutBytesProc)
Var
Temp : Byte
Tengo : Word
begin
si Booleano(putlen), a continuacion,
begin
Temp := lo(putbuf shr 8)
PutBytes(Temp, 1, Got)
inc(codesize)
fin
fin

la Funcion de DecodeChar(GetBytes : GetBytesProc) : Integer
Var
c : Word
begin
c := hijo^[R]
{
* iniciar la busqueda del arbol desde la raiz a las hojas.
* seleccione el nodo #(hijo[]) si la entrada de bit = 0
* persona elija #(hijo[] 1) de entrada (bit = 1)
}
Mientras (c < T)
begin
c := c GetBit(GetBytes)
c := hijo^[c]
fin
c := c - T
update(c)
DecodeChar := Integer(c)
fin

la Funcion de DecodePosition(GetBytes : GetBytesProc) : Word
Var
i, j, c : Word
begin
{ decodificar superior 6 bits de la tabla de la base de }
i := GetByte(GetBytes)
c := Palabra(d_code[i] shl 6)
j := d_len[i]
{ entrada de menores de 6 bits directamente }
dec(j, 2)
Mientras j <> 0 hacer
begin
i: = i shl 1) GetBit(GetBytes)
dec(j)
fin
DecodePosition := c o i y $3f
fin

{ Compresion }

Procedimiento InitLZH
begin
getbuf := 0
getlen := 0
putlen := 0
putbuf := 0
TextSize := 0
codesize := 0
printcount := 0
match_position := 0
match_length := 0
nuevo(lson)
nuevo(papa)
nuevo(rson)
nuevo(Text_buf)
nuevo(freq)
nuevo(prnt)
nuevo(hijo)
fin

Procedimiento endLZH
begin
dispose(hijo)
dispose(prnt)
dispose(freq)
dispose(Text_buf)
dispose(rson)
dispose(papa)
dispose(lson)
fin

Procedimiento LZHPack(Var Bytes_Written : LongInt
GetBytes : GetBytesProc
PutBytes : PutBytesProc)
Var
ct : Byte
yo, len, R, s, last_match_length : Integer
Tengo : Word
begin
InitLZH
TextSize := 0 { rebobinar y volver a examinar }
StartHuff
InitTree
s := 0
R := N - F
fillChar(Text_buf^[0], R, & #39 & #39 )
len := 0
Tengo := 1
While (len < F) y (Got <> 0) hacer
begin
metodo GetBytes(ct, 1, Got)
si Tienes <> 0 then
begin
Text_buf^[R len] := ct
inc(len)
fin
fin
TextSize := len
For i := 1 a F
InsertNode(R - i)
InsertNode(R)
Repetir
si (match_length > len), a continuacion,
match_length := len
si (match_length <= UMBRAL), a continuacion,
begin
match_length := 1
EncodeChar(Text_buf^[R], PutBytes)
fin
else
begin
EncodeChar(255 - UMBRAL match_length, PutBytes)
EncodePosition(match_position, PutBytes)
fin
last_match_length := match_length
i := 0
Tengo := 1
Mientras (i < last_match_length) y (Got <> 0) hacer
begin
metodo GetBytes(ct, 1, Got)
si Tienes <> 0 then
begin
DeleteNode(s)
Text_buf^[s] := ct
if (s < pred(F)) entonces
Text_buf^[s N] := ct
s := succ(s) y pred(N)
R := succ(R) y pred(N)
InsertNode(R)
inc(i)
fin
fin
inc(TextSize, i)
Mientras (i < last_match_length)
begin
inc(i)
DeleteNode(s)
s := succ(s) y pred(N)
R := succ(R) y pred(N)
dec(len)
si Booleano(len), a continuacion, InsertNode(R)
fin
Hasta que (len <= 0)
Encodeend(PutBytes)
endLZH
Bytes_Written := TextSize
fin

Procedimiento LZHUnpack(TextSize : LongInt
GetBytes : GetBytesProc
PutBytes : PutBytesProc)
Var
c, i, j, k, R : Entero
c2, r : Byte
conteo : LongInt
Poner : Word
begin
InitLZH
StartHuff
R := N - F
fillChar(Text_buf^[0], R, & #39 & #39 )
conteo := 0
Mientras que la cuenta < TextSize hacer
begin
c := DecodeChar(GetBytes)
if (c < 256), a continuacion,
begin
c2 := lo(c)
PutBytes(c2, 1,)
Text_buf^[R] := c
inc(R)
R := R y pred(N)
inc(recuento)
fin
else
begin
i := (R - succ(DecodePosition(GetBytes))) y pred(N)
j := c - 255 UMBRAL
Para k := 0 a pred(j)
begin
c := Text_buf^[(i k) y pred(N)]
c2 := lo(c)
PutBytes(c2, 1,)
Text_buf^[R] := c
inc(R)
R := R y pred(N)
inc(recuento)
fin
fin
fin
endLZH
fin
final.