68 lines
1.7 KiB
Plaintext
68 lines
1.7 KiB
Plaintext
[ 2dup peek 1+ unrot poke ] is itemincr ( [ n --> [ )
|
|
|
|
[ [ 0 128 of ] constant
|
|
swap witheach itemincr
|
|
' [ i^ join ] map
|
|
' [ 0 peek ] filter ] is countchars ( $ --> [ )
|
|
|
|
[ 0 peek dip [ 0 peek ] < ] is fewerchars ( [ [ --> b )
|
|
|
|
[ behead rot
|
|
behead rot + unrot
|
|
dip nested nested
|
|
join join ] is makenode ( [ [ --> [ )
|
|
|
|
[ [ dup pqsize 1 > while
|
|
frompq dip frompq
|
|
makenode topq again ]
|
|
frompq nip
|
|
0 pluck drop ] is maketree ( [ --> [ )
|
|
|
|
[ countchars
|
|
pqwith fewerchars
|
|
maketree ] is huffmantree ( $ --> [ )
|
|
|
|
[ stack ] is path.hfl ( --> s )
|
|
|
|
[ stack ] is list.hfl ( --> s )
|
|
|
|
forward is makelist ( [ --> )
|
|
[ dup size 1 = iff
|
|
[ 0 peek
|
|
path.hfl behead drop
|
|
nested join nested
|
|
list.hfl take
|
|
join
|
|
list.hfl put ] done
|
|
unpack
|
|
1 path.hfl put
|
|
makelist
|
|
0 path.hfl replace
|
|
makelist
|
|
path.hfl release ] resolves makelist ( [ --> )
|
|
|
|
[ sortwith
|
|
[ 0 peek swap 0 peek < ] ] is charsort ( [ --> [ )
|
|
|
|
[ [] list.hfl put
|
|
makelist
|
|
list.hfl take
|
|
charsort ] is huffmanlist ( [ --> [ )
|
|
|
|
[ sortwith
|
|
[ 1 peek size
|
|
swap 1 peek size < ] ] is codesort ( [ --> [ )
|
|
|
|
[ witheach
|
|
[ unpack swap
|
|
say ' "' emit
|
|
say '" ' echo cr ] ] is echohuff ( [ --> [ )
|
|
|
|
$ "this is an example for huffman encoding"
|
|
huffmantree
|
|
huffmanlist
|
|
say " Huffman codes sorted by character." cr
|
|
dup echohuff cr
|
|
say " Huffman codes sorted by code length." cr
|
|
codesort echohuff
|