Advertisement
Guest User

Untitled

a guest
Jun 1st, 2017
58
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.59 KB | None | 0 0
  1. datatype HuffmanTree =
  2. Node of (string * int) * HuffmanTree * HuffmanTree
  3. | Symbol of char * int;
  4.  
  5. local
  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));
  9. fun countLetter (x:string,a:char) = if size(x)=0 then 0 else countLetterAux(x,a,0);
  10.  
  11. in
  12. fun computeHistogram "" = []
  13. | computeHistogram s = map (fn x => (x,countLetter(s,x))) (unique(explode s))
  14. end;
  15.  
  16. local
  17. local
  18. fun merge _ [] [] = []
  19. | 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))
  22. else (x::(merge pred xs (y::ys)))
  23. in
  24. fun mergesort _ [] = []
  25. | mergesort _ [x] = [x]
  26. | mergesort pred l = merge pred
  27. (mergesort pred (List.take (l,((length l) div 2))))
  28. (mergesort pred (List.drop (l,((length l) div 2))))
  29. end;
  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))
  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))
  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))
  36. else Node((s^str(y),n1+n2),Node((s,n1),T1,T2),Symbol(y,n2))
  37. fun buildHuffmanList (x::[]) = x
  38. | buildHuffmanList lst = buildHuffmanList((buildHuffmanTreeAux (List.take(lst,2)))::(List.drop(lst,2)))
  39. in
  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)]
  46. | LetterEncodingHist (Node(_,T1,T2),s) = (LetterEncodingHist (T1,s^"0"))@(LetterEncodingHist (T2,s^"1"))
  47. fun LetterEncoding ([],_) = ""
  48. | LetterEncoding ((y,s)::lst,x) = if y=x then s else LetterEncoding (lst,x)
  49. val hist = LetterEncodingHist(tree,"")
  50. in
  51. foldr op^ "" (map (fn c => LetterEncoding(hist,c)) (explode s))
  52. end;
  53.  
  54. local
  55. fun decodeMessageAux (Symbol(a,n)) _ [] = str(a)
  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)
  58. else decodeMessageAux TR T2 (tl lst)
  59. in
  60. fun decodeMessage tree s = decodeMessageAux tree tree (explode s)
  61. end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement