View difference between Paste ID: m7A7wGyN and zx4AQmY5
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;