Fork me on GitHub

Huffman Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#!/usr/bin/env fsharpi

(* This construct is for ML compatibility. The syntax '(typ,...,typ) ident'
is not used in F# code. Consider using 'ident<typ,...,typ>' instead. *)

#nowarn "62"

[<RequireQualifiedAccess>]
module Huffman =

type tree =
| Leaf of frecuency * char
| Node of frecuency * tree * tree
and frecuency = int

let frecuency : tree -> frecuency * tree = function
| Leaf (f,_) as t -> f,t
| Node (f,_,_) as t -> f,t

let encoding : string -> tree =
fun text ->
let rec aux : tree Set -> tree =
fun acc0 ->
if Set.isEmpty acc0 then
failwith "Set is empty"
else if Set.count acc0 = 1 then
Set.minElement acc0
else
let (f1,x) = acc0 |> Set.minElement |> frecuency
let (acc1) = acc0 |> Set.remove x
let (f2,y) = acc1 |> Set.minElement |> frecuency
let (acc2) = acc1 |> Set.remove y

acc2 |> Set.add (Node (f1+f2,x,y)) |> aux
text
|> Seq.groupBy id
|> Seq.map (fun (x,xs) -> xs |> Seq.length,x)
|> Set.ofSeq
|> Set.map Leaf
|> aux

let tree2charmap : tree -> (char, int list) Map =
fun t ->
let rec aux acc : tree -> (char, int list) Map = function
| Leaf (_,c) -> Map.empty |> Map.add c (List.rev acc)
| Node (_,l,r) ->
let ml = aux (0::acc) l
let mr = aux (1::acc) r
ml |> Map.fold(fun a k v -> a |> Map.add k v) mr
aux [] t

let table : (char, int list) Map -> string =
fun map ->
map
|> Map.toList
|> List.map (fun (k,v) -> sprintf "'%c': %A\n" k v)
|> List.fold (fun a x -> a + x) ""

let tree2codemap : tree -> (int list, char) Map =
fun t ->
let rec aux acc : tree -> (int list, char) Map = function
| Leaf (_,c) -> Map.empty |> Map.add (List.rev acc) c
| Node (_,l,r) ->
let ml = aux (0::acc) l
let mr = aux (1::acc) r
ml |> Map.fold(fun a k v -> a |> Map.add k v) mr
aux [] t

let compress : (char, int list) Map -> string -> string =
fun map text ->
text
|> Seq.map (fun c -> map |> Map.find c)
|> Seq.collect id
|> Seq.fold (fun a x -> a + (string x)) ""

let decompress : (int list, char) Map -> string -> string =
fun map code ->
let rec aux acc code = function
| [ ] -> acc |> List.rev
| x :: xs ->
let code' = code @ [x]
let copt = map |> Map.tryFind code'
let acc',code'' =
match copt with
| Some c -> c::acc, [ ]
| None -> acc, code'
aux acc' code'' xs
let xs = code |> Seq.map (string >> int) |> Seq.toList
aux [] [] xs |> List.fold (fun a x -> a + (string x)) ""

Huffman Code output:

module Huffman = begin
type tree =
| Leaf of frecuency * char
| Node of frecuency * tree * tree
and frecuency = int
val frecuency : _arg1:tree -> frecuency * tree
val encoding : text:string -> tree
val tree2charmap : t:tree -> Map<char,int list>
val table : map:Map<char,int list> -> string
val tree2codemap : t:tree -> Map<int list,char>
val compress : map:Map<char,int list> -> text:string -> string
val decompress : map:Map<int list,char> -> code:string -> string
end

Execution Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
let text = """this is an example of a huffman tree"""

let encoding =
text
|> Huffman.encoding

let tree2charmap =
encoding
|> Huffman.tree2charmap

let tree2codemap =
encoding
|> Huffman.tree2codemap

let table =
tree2charmap
|> Huffman.table

let compressed =
text
|> Huffman.compress tree2charmap

let decompressed =
compressed
|> Huffman.decompress tree2codemap

printfn "* Text:\n«%s»\n" text
printfn "* Table:\n%s" table
printfn "* Compressed:\n%s\n" compressed
printfn "* Decompressed:\n«%s»\n" decompressed
mon@razerRamon:~/tmp$ ./HuffmanCoding.fsx

Execution Code output:

* Text:
«this is an example of a huffman tree»

* Table:
' ': [1; 1; 1]
'a': [0; 0; 1]
'e': [1; 1; 0]
'f': [0; 0; 0]
'h': [1; 0; 1; 1; 0]
'i': [1; 0; 1; 1; 1]
'l': [1; 0; 0; 0; 0]
'm': [0; 1; 0; 0]
'n': [0; 1; 0; 1]
'o': [1; 0; 0; 0; 1]
'p': [1; 0; 0; 1; 0]
'r': [1; 0; 0; 1; 1]
's': [0; 1; 1; 0]
't': [0; 1; 1; 1]
'u': [1; 0; 1; 0; 0]
'x': [1; 0; 1; 0; 1]

* Compressed:
0111101101011101101111011101101110010101111110101010010100100101000011011110001000111001111101101010000000001000010101111011110011110110

* Decompressed:
«this is an example of a huffman tree»

References:

comments powered by Disqus