SHOW:
|
|
- or go back to the newest paste.
1 | - | datatype HuffmanTree = |
1 | + | datatype HuffmanTree = |
2 | Node of (string * int) * HuffmanTree * HuffmanTree | |
3 | | Symbol of char * int; | |
4 | ||
5 | local | |
6 | - | fun unique [] = [] |
6 | + | fun unique [] = [] |
7 | | unique (x::xs) = x:: unique (List.filter (fn y => y<>x) xs); | |
8 | - | fun countLetterAux (x:string,a:char,i:int) = if i=size(x) then 0 else (if String.sub(x,i)=a then 1+countLetterAux(x,a,i+1) else countLetterAux(x,a,i+1)); |
8 | + | fun countLetterAux (x:string,a:char,i:int) = if i=size(x) then 0 else (if String.sub(x,i)=a then 1+countLetterAux(x,a,i+1) else countLetterAux(x,a,i+1)); |
9 | - | fun countLetter (x:string,a:char) = if size(x)=0 then 0 else countLetterAux(x,a,0); |
9 | + | fun countLetter (x:string,a:char) = if size(x)=0 then 0 else countLetterAux(x,a,0); |
10 | ||
11 | in | |
12 | - | fun computeHistogram "" = [] |
12 | + | fun computeHistogram "" = [] |
13 | - | | computeHistogram s = map (fn x => (x,countLetter(s,x))) (unique(explode s)) |
13 | + | | computeHistogram s = map (fn x => (x,countLetter(s,x))) (unique(explode s)) |
14 | end; | |
15 | ||
16 | local | |
17 | - | local |
17 | + | local |
18 | - | fun merge _ [] [] = [] |
18 | + | fun merge _ [] [] = [] |
19 | - | | merge _ list [] = list |
19 | + | | merge _ list [] = list |
20 | - | | merge _ [] list = list |
20 | + | | merge _ [] list = list |
21 | - | | merge pred (x::xs) (y::ys) = if pred(x,y) then (y::(merge pred (x::xs) ys)) |
21 | + | | merge pred (x::xs) (y::ys) = if pred(x,y) then (y::(merge pred (x::xs) ys)) |
22 | - | else (x::(merge pred xs (y::ys))) |
22 | + | else (x::(merge pred xs (y::ys))) |
23 | - | in |
23 | + | in |
24 | - | fun mergesort _ [] = [] |
24 | + | fun mergesort _ [] = [] |
25 | - | | mergesort _ [x] = [x] |
25 | + | | mergesort _ [x] = [x] |
26 | - | | mergesort pred l = merge pred |
26 | + | | mergesort pred l = merge pred |
27 | - | (mergesort pred (List.take (l,((length l) div 2)))) |
27 | + | (mergesort pred (List.take (l,((length l) div 2)))) |
28 | - | (mergesort pred (List.drop (l,((length l) div 2)))) |
28 | + | (mergesort pred (List.drop (l,((length l) div 2)))) |
29 | - | end; |
29 | + | end; |
30 | - | fun compareTuple ((x:string,n1),(y:string,n2)) = if n1=n2 then y<x else n2<n1 |
30 | + | fun compareTuple ((x:string,n1),(y:string,n2)) = if n1=n2 then y<x else n2<n1 |
31 | - | fun compareTuple2 ((x:char,n1),(y:char,n2)) = compareTuple((str(x),n1),(str(y),n2)) |
31 | + | fun compareTuple2 ((x:char,n1),(y:char,n2)) = compareTuple((str(x),n1),(str(y),n2)) |
32 | - | fun sortAndConvert lst = map (fn (x,n) => Symbol(x,n)) (mergesort compareTuple2 lst) |
32 | + | fun sortAndConvert lst = map (fn (x,n) => Symbol(x,n)) (mergesort compareTuple2 lst) |
33 | - | fun buildHuffmanTreeAux (Symbol(x,n1)::Symbol(y,n2)::_) = Node(((str(x)^str(y)),(n1+n2)),Symbol(x,n1),Symbol(y,n2)) |
33 | + | fun buildHuffmanTreeAux (Symbol(x,n1)::Symbol(y,n2)::_) = Node(((str(x)^str(y)),(n1+n2)),Symbol(x,n1),Symbol(y,n2)) |
34 | - | | buildHuffmanTreeAux (Node((s,n1),T1,T2)::Symbol(y,n2)::_) = if compareTuple((s,n1),(str(y),n2)) |
34 | + | | buildHuffmanTreeAux (Node((s,n1),T1,T2)::Symbol(y,n2)::_) = if compareTuple((s,n1),(str(y),n2)) |
35 | - | then Node((str(y)^s,n1+n2),Symbol(y,n2),Node((s,n1),T1,T2)) |
35 | + | then Node((str(y)^s,n1+n2),Symbol(y,n2),Node((s,n1),T1,T2)) |
36 | - | else Node((s^str(y),n1+n2),Node((s,n1),T1,T2),Symbol(y,n2)) |
36 | + | else Node((s^str(y),n1+n2),Node((s,n1),T1,T2),Symbol(y,n2)) |
37 | - | fun buildHuffmanList (x::[]) = x |
37 | + | fun buildHuffmanList (x::[]) = x |
38 | - | | buildHuffmanList lst = buildHuffmanList((buildHuffmanTreeAux (List.take(lst,2)))::(List.drop(lst,2))) |
38 | + | | buildHuffmanList lst = buildHuffmanList((buildHuffmanTreeAux (List.take(lst,2)))::(List.drop(lst,2))) |
39 | in | |
40 | - | fun buildHuffmanTree lst = buildHuffmanList (sortAndConvert lst) |
40 | + | fun buildHuffmanTree lst = buildHuffmanList (sortAndConvert lst) |
41 | end; | |
42 | ||
43 | fun encodeMessage tree s = | |
44 | let | |
45 | - | fun LetterEncodingHist (Symbol(x,n),s) = [(x,s)] |
45 | + | fun LetterEncodingHist (Symbol(x,n),s) = [(x,s)] |
46 | - | | LetterEncodingHist (Node(_,T1,T2),s) = (LetterEncodingHist (T1,s^"0"))@(LetterEncodingHist (T2,s^"1")) |
46 | + | | LetterEncodingHist (Node(_,T1,T2),s) = (LetterEncodingHist (T1,s^"0"))@(LetterEncodingHist (T2,s^"1")) |
47 | - | fun LetterEncoding ([],_) = "" |
47 | + | fun LetterEncoding ([],_) = "" |
48 | - | | LetterEncoding ((y,s)::lst,x) = if y=x then s else LetterEncoding (lst,x) |
48 | + | | LetterEncoding ((y,s)::lst,x) = if y=x then s else LetterEncoding (lst,x) |
49 | - | val hist = LetterEncodingHist(tree,"") |
49 | + | val hist = LetterEncodingHist(tree,"") |
50 | in | |
51 | - | foldr op^ "" (map (fn c => LetterEncoding(hist,c)) (explode s)) |
51 | + | foldr op^ "" (map (fn c => LetterEncoding(hist,c)) (explode s)) |
52 | end; | |
53 | ||
54 | local | |
55 | - | fun decodeMessageAux (Symbol(a,n)) _ [] = str(a) |
55 | + | fun decodeMessageAux (Symbol(a,n)) _ [] = str(a) |
56 | - | | decodeMessageAux (Symbol(a,n)) T2 lst = str(a)^(decodeMessageAux T2 T2 lst) |
56 | + | | decodeMessageAux (Symbol(a,n)) T2 lst = str(a)^(decodeMessageAux T2 T2 lst) |
57 | - | | decodeMessageAux (Node((x,n),TL,TR)) T2 lst = if (hd lst) = #"0" then decodeMessageAux TL T2 (tl lst) |
57 | + | | decodeMessageAux (Node((x,n),TL,TR)) T2 lst = if (hd lst) = #"0" then decodeMessageAux TL T2 (tl lst) |
58 | - | else decodeMessageAux TR T2 (tl lst) |
58 | + | else decodeMessageAux TR T2 (tl lst) |
59 | in | |
60 | - | fun decodeMessage tree s = decodeMessageAux tree tree (explode s) |
60 | + | fun decodeMessage tree s = decodeMessageAux tree tree (explode s) |
61 | end; | |
62 | ||
63 | fun encodeTree tree = | |
64 | let | |
65 | fun num2binary_aux(0,false) = "0" | |
66 | | num2binary_aux(0,true) = "" | |
67 | | num2binary_aux(n,_) = if (n mod 2) = 0 then num2binary_aux((n div 2),true)^"0" | |
68 | else num2binary_aux((n div 2),true)^"1" | |
69 | fun num2binary 0 = num2binary_aux(0,false) | |
70 | | num2binary n = num2binary_aux(n,true) | |
71 | fun char2binary c = num2binary(ord(c)) | |
72 | fun max_appearance (Symbol(x,n)) = n | |
73 | | max_appearance (Node((_,_),Symbol(_,n),_)) = n | |
74 | | max_appearance (Node((_,_),_,Symbol(_,n))) = n | |
75 | fun LetterEncodingHist (Symbol(x,n)) = [(x,n)] | |
76 | | LetterEncodingHist (Node(_,T1,T2)) = (LetterEncodingHist T1)@(LetterEncodingHist T2) | |
77 | fun complete_zeros(n,lst) = if length(lst) = n then lst else #"0"::complete_zeros(n-1,lst) | |
78 | val hist = LetterEncodingHist(tree) | |
79 | val max_app = max_appearance(tree) | |
80 | val max_app_encode = complete_zeros(19,explode(num2binary(max_app))) | |
81 | fun encode_tuple (x,y) = complete_zeros(8,explode(char2binary(x))) @ (complete_zeros(max_app,explode(num2binary(y)))) | |
82 | fun append_to_complete lst = if (length(lst) mod 8) = 0 then lst else append_to_complete(lst@[#"0"]) | |
83 | fun binary_to_num [] _ = 0 | |
84 | | binary_to_num (x::xs) m = if x = #"1" then (m + (binary_to_num xs (2*m))) else (binary_to_num xs (2*m)) | |
85 | fun encode_list [] _= "" | |
86 | | encode_list (x::xs) temp = if length(temp) = 8 then str(chr(binary_to_num temp 1))^(encode_list xs [x]) | |
87 | else (encode_list xs (temp@[x])) | |
88 | in | |
89 | encode_list (append_to_complete(max_app_encode @ (foldr op@ [] (map encode_tuple hist)))) [] | |
90 | end; |