Anonymous user
Huffman coding: Difference between revisions
Add factor example
(→{{header|Haskell}}: Specified imports, provided a `main`, some <$> -> fmap for simpler bracketing) |
(Add factor example) |
||
Line 2,125:
6 111</pre>
=={{header|Factor}}==
<lang factor>
USING: kernel sequences combinators accessors assocs math hashtables math.order
sorting.slots classes formatting prettyprint ;
IN: huffman
! -------------------------------------
! CLASSES -----------------------------
! -------------------------------------
TUPLE: huffman-node
weight element encoding left right ;
! For nodes
: <huffman-tnode> ( left right -- huffman )
huffman-node new [ left<< ] [ swap >>right ] bi ;
! For leafs
: <huffman-node> ( element -- huffman )
1 swap f f f huffman-node boa ;
! --------------------------------------
! INITIAL HASHTABLE --------------------
! --------------------------------------
<PRIVATE
! Increment node if it already exists
! Else make it and add it to the hash-table
: huffman-gen ( element nodes -- )
2dup at
[ [ [ 1 + ] change-weight ] change-at ]
[ [ dup <huffman-node> swap ] dip set-at ] if ;
! Curry node-hash. Then each over the seq
! to get the weighted values
: (huffman) ( nodes seq -- nodes )
dup [ [ huffman-gen ] curry each ] dip ;
! ---------------------------------------
! TREE GENERATION -----------------------
! ---------------------------------------
: (huffman-weight) ( node1 node2 -- weight )
[ weight>> ] dup bi* + ;
! Combine two nodes into the children of a parent
! node which has a weight equal to their collective
! weight
: (huffman-combine) ( node1 node2 -- node3 )
[ (huffman-weight) ]
[ <huffman-tnode> ] 2bi
swap >>weight ;
! Generate a tree by combining nodes
! in the priority queue until we're
! left with the root node
: (huffman-tree) ( nodes -- tree )
dup rest empty?
[ ] [
{ { weight>> <=> } } sort-by
[ rest rest ] [ first ]
[ second ] tri
(huffman-combine) prefix
(huffman-tree)
] if ; recursive
! --------------------------------------
! ENCODING -----------------------------
! --------------------------------------
: (huffman-leaf?) ( node -- bool )
[ left>> huffman-node instance? ]
[ right>> huffman-node instance? ] bi and not ;
: (huffman-leaf) ( leaf bit -- )
swap encoding<< ;
DEFER: (huffman-encoding)
! Recursively walk the nodes left and right
: (huffman-node) ( bit nodes -- )
[ 0 suffix ] [ 1 suffix ] bi
[ [ left>> ] [ right>> ] bi ] 2dip
[ swap ] dip
[ (huffman-encoding) ] 2bi@ ;
: (huffman-encoding) ( bit nodes -- )
over (huffman-leaf?)
[ (huffman-leaf) ]
[ (huffman-node) ] if ;
PRIVATE>
! -------------------------------
! USER WORDS --------------------
! -------------------------------
: huffman-print ( nodes -- )
"Element" "Weight" "Code" "\n%10s\t%10s\t%6s\n" printf
{ { weight>> >=< } } sort-by
[ [ encoding>> ] [ element>> ] [ weight>> ] tri
"%8c\t%7d\t\t" printf pprint "\n" printf ] each ;
: huffman ( sequence -- nodes )
H{ } clone (huffman) values
[ (huffman-tree) first { }
(huffman-encoding) ] keep ;
! ---------------------------------
! USAGE ---------------------------
! ---------------------------------
! { 1 2 3 4 } huffman huffman-print
! "this is an example of a huffman tree" huffman huffman-print
! Element Weight Code
! 7 { 0 0 0 }
! a 4 { 1 1 1 }
! e 4 { 1 1 0 }
! f 3 { 0 0 1 0 }
! h 2 { 1 0 1 0 }
! i 2 { 0 1 0 1 }
! m 2 { 0 1 0 0 }
! n 2 { 0 1 1 1 }
! s 2 { 0 1 1 0 }
! t 2 { 0 0 1 1 }
! l 1 { 1 0 1 1 1 }
! o 1 { 1 0 1 1 0 }
! p 1 { 1 0 0 0 1 }
! r 1 { 1 0 0 0 0 }
! u 1 { 1 0 0 1 1 }
! x 1 { 1 0 0 1 0 }
</lang>
=={{header|Fantom}}==
| |||