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:
|
open System.Collections.Generic
type CodeTree<'T> = Leaf of 'T * int | Fork of CodeTree<'T> * CodeTree<'T> * 'T list * int
let chars = function | Leaf(c,_) -> [c] | Fork(_,_,l,_) -> l
let weight = function | Leaf(c,w) -> w | Fork(_,_,_,w) -> w
let mergeCT ct1 ct2 = Fork(ct1, ct2, chars ct1 @ chars ct2, weight ct1 + weight ct2)
let foldCodeTree fNode (fLeaf:'T -> 'a) (x:'T CodeTree) =
let rec f x = match x with | Leaf(e,w) -> fLeaf(e) | Fork(l,r,cs,w) -> fNode(f l)(f r)
f x
module List =
let span f xs =
let l,r = xs |> List.fold(fun (l,r: _ list) e -> if f e then e::l, r.Tail else l,r ) ([],xs)
l |> List.rev, r
module Huffman =
let buildFreq (sample : 'T list) =
if sample.Length = 0 then []
else let sample = sample |> List.sort
let rec count (sample: _ list) = [ if sample.Length <> 0 then
let left, right = sample |> List.span ((=) sample.Head)
yield sample.Head,left.Length
yield! count right ]
count sample |> List.sortBy snd
let buildFromFreq(distrib:('T*int) list) : CodeTree<'T> =
let rec loop = function
| [] -> failwith "not possible"
| [r] -> r
| f::s::xs -> let newCT = mergeCT f s
let left, right = List.span (fun e -> weight e < weight newCT) xs
loop(left @ (newCT:: right))
loop (distrib |> List.sortBy(snd) |> List.map(Leaf))
let decode (codeTree:_ CodeTree) (bits : int list) =
let o = bits |> List.fold(fun ((Fork(l,r,_,_)), decMsg) b -> let branch = if b = 0 then l else r
match branch with | Leaf(c,_) -> (codeTree, c::decMsg)
| _ -> (branch , decMsg))
(codeTree, [])
snd o |> List.rev
let makeEncoderDic (tree: 'T CodeTree) =
foldCodeTree (fun (lMap:Map<'T,int list>) rMap -> lMap |> Map.fold(fun m k v -> m.Add(k, 0::v)) (rMap |> Map.fold(fun m k v -> m.Add(k, 1::v)) Map.empty))
(fun c -> Map.empty.Add(c,[]))
tree
let encode (dic:Map<'T,int list>) (text : 'T list) = text |> List.fold(fun s e -> s@dic.[e]) ([])
let secret = [0;0;1;1;1;0;1;0;1;1;1;0;0;1;1;0;1;0;0;1;1;0;1;0;1;1;0;0;1;1;1;1;1;0;1;0;1;1;0;0;0;0;1;0;1;1;1;0;0;1;0;0;1;0;0;0;1;0;0;0;1;0;1]
let frenchCode = Fork(Fork(Fork(Leaf('s',121895),Fork(Leaf('d',56269),Fork(Fork(Fork(Leaf('x',5928),Leaf('j',8351),['x';'j'],14279),Leaf('f',16351),['x';'j';'f'],30630),Fork(Fork(Fork(Fork(Leaf('z',2093),Fork(Leaf('k',745),Leaf('w',1747),['k';'w'],2492),['z';'k';'w'],4585),Leaf('y',4725),['z';'k';'w';'y'],9310),Leaf('h',11298),['z';'k';'w';'y';'h'],20608),Leaf('q',20889),['z';'k';'w';'y';'h';'q'],41497),['x';'j';'f';'z';'k';'w';'y';'h';'q'],72127),['d';'x';'j';'f';'z';'k';'w';'y';'h';'q'],128396),['s';'d';'x';'j';'f';'z';'k';'w';'y';'h';'q'],250291),Fork(Fork(Leaf('o',82762),Leaf('l',83668),['o';'l'],166430),Fork(Fork(Leaf('m',45521),Leaf('p',46335),['m';'p'],91856),Leaf('u',96785),['m';'p';'u'],188641),['o';'l';'m';'p';'u'],355071),['s';'d';'x';'j';'f';'z';'k';'w';'y';'h';'q';'o';'l';'m';'p';'u'],605362),Fork(Fork(Fork(Leaf('r',100500),Fork(Leaf('c',50003),Fork(Leaf('v',24975),Fork(Leaf('g',13288),Leaf('b',13822),['g';'b'],27110),['v';'g';'b'],52085),['c';'v';'g';'b'],102088),['r';'c';'v';'g';'b'],202588),Fork(Leaf('n',108812),Leaf('t',111103),['n';'t'],219915),['r';'c';'v';'g';'b';'n';'t'],422503),Fork(Leaf('e',225947),Fork(Leaf('i',115465),Leaf('a',117110),['i';'a'],232575),['e';'i';'a'],458522),['r';'c';'v';'g';'b';'n';'t';'e';'i';'a'],881025),['s';'d';'x';'j';'f';'z';'k';'w';'y';'h';'q';'o';'l';'m';'p';'u';'r';'c';'v';'g';'b';'n';'t';'e';'i';'a'],1486387)
let r = decode frenchCode secret
let r' = decode frenchCode (encode (makeEncoderDic frenchCode) r)
|