Skip to content

Instantly share code, notes, and snippets.

@kermitaner

kermitaner/huffy.red

Created February 1, 2018 22:04
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save kermitaner/606c10fd4fec5e9d7d52f9e0f5b3e289 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save kermitaner/606c10fd4fec5e9d7d52f9e0f5b3e289 to your computer and use it in GitHub Desktop.
Download ZIP
huffman coding in Red, example for Rosetta code task...
Raw
huffy.red
Red [file: %huffy.red]
;; message to encode:
msg: "this is an example for huffman encoding"
;;map to collect leave knots per uniq character of message
m: make map! []
knot: make object! [
left: right: none ;; pointer to left/right sibling
code: none ;; first holds char for debugging, later binary code
count: depth: 1 ;;occurence of character - length of branch
]
;;-----------------------------------------
set-code: func ["recursive function to generate binary code sequence"
wknot
wcode [string!]] [
;;-----------------------------------------
either wknot/left = none [
wknot/code: wcode
] [
set-code wknot/left rejoin [wcode "1"]
set-code wknot/right rejoin [wcode "0"]
]
] ;;-- end func
;-------------------------------
merge-2knots: func ["function to merge 2 knots into 1 new"
t [block!]][
;-------------------------------
nknot: copy knot ;; create new knot
nknot/count: t/1/count + t/2/count
nknot/right: t/1
nknot/left: t/2
nknot/depth: t/1/depth + 1
tab: remove/part t 2 ;; delete first 2 knots
insert t nknot ;; insert new generated knot
] ;;-- end func
;; count occurence of characters, save in map: m
foreach chr msg [
either k: select/case m chr [
k/count: k/count + 1
][
put/case m chr nknot: copy knot
nknot/code: chr
]
]
;; create sortable block (=tab) for use as prio queue
foreach k keys-of m [ append tab: [] :m/:k ]
;; build tree
while [ 1 < length? tab][
sort/compare tab function [a b] [ a/count < b/count
or ( a/count = b/count and ( a/depth > b/depth ) )
]
merge-2knots tab ;; merge 2 knots with lowest count / max depth
]
set-code tab/1 "" ;; generate binary codes, save at leave knot
;; display codes
foreach k sort keys-of m [
print [k " = " m/:k/code]
append codes: "" m/:k/code
]
;; encode orig message string
foreach chr msg [
k: select/case m chr
append msg-new: "" k/code
]
print [ "length of encoded msg " length? msg-new]
print [ "length of (binary) codes " length? codes ]
print ["orig. message: " msg newline "encoded message: " "^/" msg-new]
prin "decoded: "
;; decode message (destructive! ):
while [ not empty? msg-new ][
foreach [k v] body-of m [
if t: find/match msg-new v/code [
prin k
msg-new: t
]
]
]
@kermitaner
Copy link
Author

kermitaner commented Feb 1, 2018

output:

   =  111
a  =  1101
c  =  00101
d  =  00100
e  =  1011
f  =  1100
g  =  10010
h  =  1000
i  =  1010
l  =  00000
m  =  0001
n  =  011
o  =  0101
p  =  00001
r  =  00111
s  =  0100
t  =  100111
u  =  100110
x  =  00110
length of encoded msg  157
length of (binary) codes  85
orig. message:  this is an example for huffman encoding 
encoded message:  
1001111000101001001111010010011111010111111011001101101000100001000001011111110001010011111110001001101100110000011101011111101101100101010100100101001110010
decoded: this is an example for huffman encoding>>

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment