Download text file
$if 0
After much searching and testing these HUFFMAN string (de)compression
functions are about the smallest, fastest I can come up with. I've done
away with the "hashing" functions the routines I've found used and just
created the bit masks mathmatically. They work the same and look the same
so "if it looks like a duck and quacks like a duck then....".
Anyhow, what Huffman compression does is counts all the incidences of byte
values used in a string (file), then stores the used vales in an array and
sorts that array in decending order. (highest count first) Then each
character is assigned a bit mask. The bit masks are then layed into a buffer
and viola! compressed data. Maybe! There is an outside chance that the data
won't comperss because there are too many varied and oft used odd-ball
characters but... this would be rare for text in a single language.
So lets take "PETER PIPER PICKED A PECK OF PICKLED PEPPERS." as a test
string. After the count, sort and bit map create you get a set of arrays
that look like this
"P" CharVal(01) = 80 : Count%(01) = 9 : BitCode??(1) = "00"
"E" CharVal(02) = 69 : Count%(02) = 8 : BitCode??(2) = "010"
" " CharVal(02) = 32 : Count%(02) = 7 : BitCode??(2) = "011"
"C" CharVal(02) = 67 : Count%(02) = 3 : BitCode??(2) = "1000"
"R" CharVal(02) = 82 : Count%(02) = 3 : BitCode??(2) = "1001"
"I" CharVal(02) = 73 : Count%(02) = 3 : BitCode??(2) = "1010"
"K" CharVal(02) = 75 : Count%(02) = 3 : BitCode??(2) = "1011"
"D" CharVal(02) = 68 : Count%(02) = 2 : BitCode??(2) = "11000"
"F" CharVal(02) = 70 : Count%(02) = 1 : BitCode??(2) = "11001"
"A" CharVal(02) = 65 : Count%(02) = 1 : BitCode??(2) = "11010"
"." CharVal(02) = 46 : Count%(02) = 1 : BitCode??(2) = "11011"
"O" CharVal(02) = 79 : Count%(02) = 1 : BitCode??(2) = "111000"
"L" CharVal(02) = 76 : Count%(02) = 1 : BitCode??(2) = "111001"
"S" CharVal(02) = 83 : Count%(02) = 1 : BitCode??(2) = "111010"
"T" CharVal(02) = 84 : Count%(02) = 1 : BitCode??(2) = "111011"
Packed up, "PETER" looks like this "000101110110101001" and takes up
18 bits or 2.25 bytes vs the original 5 bytes.
Unpacking requires that you keep thinking in BITS left to right (that's
backwards to the computer remember). When you read in the first bit and
it is OFF then you're dealing with either the first, second or third
character in the list ("P", "E" or " " ). If the next bit is, again
OFF then the coded letter is "P" and so on for the next two bits if
it is ON.
If that frist bit is ON then you have to keep checking until you get an
OFF bit and adding 4 for each ON bit you encounter. When you hit the OFF
bit the next two bits add to your counter to determine which character
in the list you're to use.
ÚÄÄÄÄÄÄ + 4
³ÚÄÄÄÄÄ + 4
³³ÚÄÄÄÄ + 4
³³³ÚÄÄÄÄÄÄÄÄÄ skip this bit
³³³³ÚÄÄ + 2
³³³³³ÚÄ + 1
"T" = "111011"
total = 15 so CharVal?(15) = 84
Here's the whole word "PETER" layed out with count and logic.
ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ the first bit is OFF so
³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ the next bit is OFF too so ============ "P"
³³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ the first bits OFF so
³³³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ the next bit is ON so at least 2
³³³³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ the next bit is OFF so it's a 2 ======= "E"
³³³³³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ the first bit is ON so at least 4
³³³³³³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄ the next bit is ON so +4 for 8
³³³³³³³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄ the next bit is ON so +4 for 12
³³³³³³³³ÚÄÄÄÄÄÄÄÄÄÄÄÄ this bit is OFF so end of 4's
³³³³³³³³³ÚÄÄÄÄÄÄÄÄÄÄÄ this bit is ON so +2 for 14
³³³³³³³³³³ÚÄÄÄÄÄÄÄÄÄÄ this bit is ON so +1 for 15 ======= "T"
³³³³³³³³³³³ÚÄÄÄÄÄÄÄÄÄ the first bits OFF so
³³³³³³³³³³³³ÚÄÄÄÄÄÄÄÄ the next bit is ON so at least 2
³³³³³³³³³³³³³ÚÄÄÄÄÄÄÄ the next bit is OFF so it's a 2 ======= "E"
³³³³³³³³³³³³³³ÚÄÄÄÄÄÄ this first bit is ON so at least 4
³³³³³³³³³³³³³³³ÚÄÄÄÄÄ the next bit is OFF so end of 4's
³³³³³³³³³³³³³³³³ÚÄÄÄÄ this bit is OFF so add 0
³³³³³³³³³³³³³³³³³ÚÄÄÄ this bit is ON so +1 for 5 ============ "R"
000101110110101001
Credit is due to that unknown individual who provided the HUFFMAN.TIP
file that came with one of the earlier versions of PowerBASIC. From his
or her notes I was able to decifer the coding system and create these
functions. And so I now pass them onto you for your use.
HAND,
Don Schullian
d83@ath.forthnet.gr
$endif
StartTestCode:
DIM Orig AS STRING
DIM Packed AS STRING
DIM UnPked AS STRING
DECLARE FUNCTION fHuffPack$ (O$)
DECLARE FUNCTION fHuffUnPack$(P$)
CLS
Orig$ = "PETER PIPER PICKED A PECK OF PICKLED PEPPERS."
Packed$ = fHuffPack$( Orig$ )
PRINT USING$( "Len = ## : >>", LEN(Orig$ ) ); Orig$ ; "<<"
PRINT USING$( "Len = ## : >>", LEN(Packed$) ); Packed$; "<<"
PRINT STRING$(79,45)
UnPked$ = fHuffUnPack$( Packed$ )
PRINT "Orig$: >>"; Orig$ ; "<<"
PRINT "UnPk$: >>"; UnPked$; "<<"
END
'=========================================================================
'== fHuffPack$( InString$ )
'==
'== PARAMS: InString$ = the data to be packed
'== RETURNS: Packed data string
'== 2 bytes = original length
'== 1 byte = number of unique characters
'== x bytes = unique characters
'== remainder = encoded data
'== NULL$ if packed version of InString$ would exceed the
'== string size limitations set with $STRING
'=========================================================================
FUNCTION fHuffPack( InString AS STRING ) LOCAL PUBLIC AS STRING
DIM Count (256) AS LOCAL INTEGER ' count of all chars
DIM CharVal(256) AS LOCAL BYTE ' assigned values
DIM BitCode(256) AS LOCAL WORD ' bit values
DIM Packed AS LOCAL STRING ' working string buffer
DIM InLen AS LOCAL INTEGER ' length of incoming $
DIM CharCount AS LOCAL INTEGER ' # of used chars
DIM I_ptr AS LOCAL BYTE PTR ' ptr to incoming $
DIM P_ptr AS LOCAL BYTE PTR ' ptr to working buffer
DIM BitBuf AS LOCAL LONG ' working buffer of bits
DIM BitCount AS LOCAL INTEGER ' current bit position
DIM X AS LOCAL INTEGER ' loop counter
DIM B AS LOCAL WORD ' counter
DIM F AS LOCAL WORD ' counter
DIM P AS LOCAL INTEGER ' counter
DIM S AS LOCAL INTEGER ' counter
'
I_ptr = STRPTR32( InString$ ) ' set incoming pointer
InLen% = LEN( InString$ ) ' set incoming length
'
FOR X% = 1 TO InLen% ' count each char in
INCR Count%(@I_ptr) ' the incoming string
INCR I_ptr '
NEXT '
DECR I_ptr, InLen% ' reset pointer to start
'
FOR X% = 1 TO 256 ' assign and count the #
IF Count%(X%) > 0 THEN ' of used characters
INCR CharCount% '
CharVal?(X%) = X% '
END IF '
NEXT '
' gets the char values in
ARRAY SORT Count%(), TAGARRAY CharVal?(), DESCEND ' highest first order
ARRAY INSERT CharVal?(0) ' (1) is now highest
'
BitCode??(2) = 2 ' create a set of bit
BitCode??(3) = 3 ' values
F?? = 8 ' 1 = "00"
FOR X% = 4 TO CharCount% ' 2 = "010"
BitCode??(X%) = F?? + B?? ' 3 = "011"
IF B?? < 3 THEN ' 4 = "1000"
INCR B?? ' 5 = "1001"
ELSE ' 6 = "1010"
B?? = F?? ' 7 = "1011"
SHIFT LEFT F??, 1 ' 8 = "11000"
F?? = ( F?? OR B?? ) ' 12 = "111000"
B?? = 0 '
END IF '
NEXT '
'
B?? = CharCount% + 3 ' count number of bytes
FOR X% = 1 TO InLen% ' required to hold the
ARRAY SCAN CharVal?(1), = @I_ptr, TO P% ' 3 byte header +
INCR I_ptr ' number of characters +
SELECT CASE P% ' the packed data
CASE 1 : INCR BitCount%, 2 ' (see list above for
CASE 2, 3 : INCR BitCount%, 3 ' bit counts)
CASE ELSE : INCR BitCount%, (P% \ 4) + 3 '
END SELECT '
IF BitCount% => 32000 THEN ' lay off 4000 bytes
INCR B??, 4000 '
DECR BitCount%, 32000 '
END IF '
NEXT '
IF BitCount% > 0 THEN ' clean-up leftover
INCR BitCount%, 7 ' bits + whatever is
INCR B??, ( BitCount% \ 8 ) ' needed to get a full
END IF ' bit
'================================================='
IF B?? > FRE(-4) THEN EXIT FUNCTION ' if not enough $ space
'================================================='
DECR I_ptr, InLen% ' reset incoming pointer
Packed$ = STRING$( B??, 0 ) ' create working buffer
MID$( Packed$, 1, 2 ) = MKI$(InLen%) ' put len of original $
P_ptr = STRPTR32( Packed$ ) + 2 ' set the working pointer
@P_ptr = CharCount% ' byte 3 = # of chars
FOR X% = 1 TO CharCount% ' bytes 4 -> are the
INCR P_ptr ' char values that
@P_ptr = CharVal?(X%) ' correspond to the bit
NEXT ' codes
'
BitCount% = 0 ' start processing bytes
FOR X% = 1 TO InLen% '
ARRAY SCAN CharVal?(1), = @I_ptr, TO P% ' find array pos of next
INCR I_ptr ' char / bump pointer
SELECT CASE P% ' set # of bits required
CASE 1 : S% = 2 ' to hold the bit-code
CASE 2, 3 : S% = 3 '
CASE ELSE : S% = (P% \ 4) + 3 '
END SELECT '
SHIFT LEFT BitBuf&, S% ' shift buffer # new bits
BitBuf& = ( BitBuf& OR BitCode??(P%) ) ' OR new bits into buffer
INCR BitCount%, S% ' incr bit counter
IF BitCount% => 16 THEN GOSUB fHuffPack1 ' if the buffer is full
NEXT '
IF BitCount% > 0 THEN ' clean-up leftover bits
IF BitCount% > 8 THEN GOSUB fHuffPack1 ' more than 1 byte
IF BitCount% > 0 THEN ' still not done?
SHIFT LEFT BitBuf&, 8 - BitCount% ' move bits to left
INCR P_ptr ' next/last pos in buf
@P_ptr = ( BitBuf& AND 255 ) ' put it there, dude!
END IF '
END IF '
'
FUNCTION = Packed$ ' RETURN packed data
EXIT FUNCTION '
'================================================ ' =======================
fHuffPack1: ' remove full bytes from
DO ' the bit buffer and put
DECR BitCount%, 8 ' them in the work buf
ROTATE RIGHT BitBuf&, BitCount% ' move the left most
INCR P_ptr ' bit to the right
@P_ptr = ( BitBuf& AND 255 ) ' stuff it into the $
SHIFT RIGHT BitBuf&, 8 ' strip right most bits
ROTATE LEFT BitBuf&, BitCount% + 8 ' move bits back in order
LOOP UNTIL BitCount% < 8 '
RETURN '
'
END FUNCTION
'=========================================================================
'== fHuffUnPack$( Packed$ )
'==
'== PARAMS: Packed$
'== SEE: fHuffPack$ for header details
'== RETURNS: Unpacked data
'== NOTE: There is NO error checking etc. as it is assumed that what
'== you send in Packed$ was created with fHuffPack$
'=========================================================================
FUNCTION fHuffUnPack( Packed AS STRING ) LOCAL PUBLIC AS STRING
DIM CharVal(256) AS LOCAL BYTE ' char values from $
DIM UnPacked AS LOCAL STRING ' working buffer
DIM InLen AS LOCAL INTEGER ' length of incoming $
DIM OutLen AS LOCAL INTEGER ' final length of out $
DIM I_ptr AS LOCAL BYTE PTR ' pointer to incoming $
DIM O_ptr AS LOCAL BYTE PTR ' pointer to outgoing $
DIM BitBuf AS LOCAL LONG ' buffer to work bits
DIM FirstBit AS LOCAL INTEGER ' current bit position
DIM S AS LOCAL INTEGER ' counter
DIM P AS LOCAL INTEGER ' counter
'
OutLen% = CVI( Packed$ ) ' final returned len
UnPacked$ = STRING$(OutLen%+4,0) ' create working $ buf
O_ptr = STRPTR32( UnPacked$ ) ' set working $ ptr
I_ptr = STRPTR32( Packed$ ) + 2 ' set incoming $ ptr
S% = @I_ptr ' # of chars used
InLen% = LEN( Packed$ ) - ( S% + 2 ) ' # of packed bytes
FirstBit% = -1 ' starts down here
'
FOR P% = 1 TO S% ' load char values
INCR I_ptr ' into array
CharVal?(P%) = @I_ptr '
NEXT '
'
DO ' start processing
WHILE ( FirstBit% < 15 ) AND ( InLen% > 0 ) ' if bit buffer empty
DECR InLen% ' knock off a byte
INCR I_ptr ' next byte in incoming
INCR FirstBit%, 8 ' loading 8 bits
SHIFT LEFT BitBuf&, 8 ' make room in bit buf
BitBuf& = ( BitBuf& OR @I_ptr ) ' stuff new byte
WEND '
IF BIT( BitBuf&, FirstBit% ) = 0 THEN ' if the bit is 0
DECR FirstBit% ' next bit position
IF BIT(BitBuf&,FirstBit%) = 0 THEN ' if still 0 then
P% = 1 ' this is code "00"
ELSE ' the bit is ON
DECR FirstBit% ' next bit position
P% = 2 + BIT(BitBuf&,FirstBit%) ' "01" or "11"
END IF '
ELSE ' else the bit is 1
P% = 0 ' clear code value
DO ' check next bits
INCR P%, 4 ' each ON = 4
DECR FirstBit% '
LOOP UNTIL BIT(BitBuf&,FirstBit%) = 0 ' until we hit an OFF
FOR S% = 2 TO 1 STEP -1 ' skip next bit then
DECR FirstBit% '
IF BIT(BitBuf&,FirstBit%) THEN INCR P%, S% ' add 2 and/or 1
NEXT '
END IF '
DECR FirstBit% ' next bit position
@O_ptr = CharVal?(P%) ' set the decoded char
INCR O_ptr ' move working buf ptr
LOOP UNTIL ( InLen% = 0 ) AND ( FirstBit% < 0 ) ' got to get them all
'
FUNCTION = LEFT$( UnPacked$, OutLen% ) ' RETURN truncated $
'
END FUNCTION