home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / huffstuf.icn < prev    next >
Text File  |  2000-07-29  |  10KB  |  387 lines
  1. ############################################################################
  2. #
  3. #    File:     huffstuf.icn
  4. #
  5. #    Subject:  Program for huffman coding
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     April 30, 1993
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.2
  18. #
  19. ############################################################################
  20. #  
  21. #  An odd assortment of tools that lets me compress text using an
  22. #  Iconish version of a generic Huffman algorithm.
  23. #
  24. ############################################################################
  25. #
  26. #  Links:  codeobj, outbits, inbits
  27. #
  28. ############################################################################
  29. #
  30. #  See also: hufftab.icn, press.icn
  31. #
  32. ############################################################################
  33.  
  34. link codeobj
  35. link inbits
  36. link outbits
  37.  
  38. # Necessary records.
  39. record nodE(l,r,n)
  40. record _ND(l,r)
  41. record leaF(c,n)
  42. record huffcode(c,i,len)
  43.  
  44. # For debugging purposes.
  45. # link ximage
  46.  
  47. # Count of chars in input file.
  48. global count_of_all_chars
  49.  
  50.  
  51. procedure main(a)
  52.  
  53.     local direction, usage, size, char_tbl, heap, tree, h_tbl, intext
  54.     usage := "huffcode -i|o filename1"
  55.  
  56.     direction := pop(a) | stop(usage)
  57.     direction ?:= { ="-"; tab(any('oi')) } | stop(usage)
  58.     *a = 1 | stop(usage)
  59.  
  60.     intext := open(a[1]) | quitprog("huffcode", "can't open "||a[1], 1)
  61.     size   := 80
  62.  
  63.     if direction == "o" then {
  64.  
  65.     char_tbl := table()
  66.     while count_chars_in_s(reads(intext), char_tbl)
  67.     heap     := initialize_heap(char_tbl)
  68.     tree     := heap_2_tree(heap)
  69.     h_tbl    := hash_codes(tree)
  70.  
  71.     put_tree(&output, tree)
  72.     seek(intext, 1)
  73.     every writes(&output, encode_string(|reads(intext, size), h_tbl))
  74.  
  75.     }
  76.     else {
  77.     tree := get_tree(intext)
  78.     every writes(&output, decode_rest_of_file(intext, size, tree))
  79.     }
  80.  
  81. end
  82.  
  83.  
  84. procedure count_chars_in_s(s, char_tbl)
  85.  
  86.     #
  87.     # Count chars in s, placing stats in char_tbl (keys = chars in
  88.     # s, values = leaF records, with the counts for each chr in s
  89.     # contained in char_tbl[chr].n).
  90.     #
  91.     local chr
  92.     initial {
  93.     /char_tbl &
  94.         quitprog("count_chars_in_s", "need 2 args - 1 string, 2 table", 9)
  95.     *char_tbl ~= 0 &
  96.         quitprog("count_chars_in_s","start me with an empty table",8)
  97.     count_of_all_chars := 0
  98.     }
  99.  
  100.     # Reset character count on no-arg invocation.
  101.     /s & /char_tbl & {
  102.     count_of_all_chars := 0
  103.     return
  104.     }
  105.  
  106.     # Insert counts for characters into char_tbl.  Note that we don't
  107.     # just put them into the table as-is.  Rather, we put them into
  108.     # a record which contains the character associated with the count.
  109.     # These records are later used by the Huffman encoding algorithm.
  110.     s ? {
  111.     while chr := move(1) do {
  112.         count_of_all_chars +:= 1
  113.         /char_tbl[chr]   := leaF(chr,0)
  114.         char_tbl[chr].n +:= 1
  115.     }
  116.     }
  117.     return *char_tbl        # for lack of anything better
  118.  
  119. end
  120.  
  121.  
  122. procedure initialize_heap(char_tbl)
  123.  
  124.     #
  125.     # Create heap data structure out of the table filled out by
  126.     # successive calls to count_chars_in_s(s,t).  The heap is just a
  127.     # list.  Naturally, it's size can be obtained via *heap.
  128.     #
  129.     local heap
  130.  
  131.     heap := list()
  132.     every push(heap, !char_tbl) do
  133.     reshuffle_heap(heap, 1)
  134.     return heap
  135.  
  136. end
  137.  
  138.  
  139. procedure reshuffle_heap(h, k)
  140.  
  141.     #
  142.     # Based loosely on Sedgewick (2nd. ed., 1988), p. 160.  Take k-th
  143.     # node on the heap, and walk down the heap, switching this node
  144.     # along the way with the child whose value is the least AND whose
  145.     # value is less than this node's.  Stop when you find no children
  146.     # whose value is less than that of the original node.  Elements on
  147.     # heap are records of type leaF, with the values contained in the
  148.     # "n" field.
  149.     #
  150.     local j
  151.  
  152.     # While we haven't spilled off the end of the heap (the size of the
  153.     # heap is *h; *h / 2 is the biggest k we need to look at)...
  154.     while k <= (*h / 2) do {
  155.  
  156.     # ...double k, assign the result to j.
  157.     j := k+k
  158.  
  159.     # If we aren't at the end of the heap...
  160.     if j < *h then {
  161.         # ...check to see which of h[k]'s children is the smallest,
  162.         # and make j point to it.
  163.         if h[j].n > h[j+1].n then
  164.         # h[j] :=: h[j+1]
  165.         j +:= 1
  166.     }
  167.  
  168.     # If the current parent (h[k]) has a value less than those of its
  169.     # children, then break; we're done.
  170.     if h[k].n <= h[j].n then break
  171.  
  172.     # Otherwise, switch the parent for the child, and loop around
  173.         # again, with k (the pointer to the parent) now pointing to the
  174.     # new offset of the element we have been working on.
  175.     h[k] :=: h[j]
  176.     k := j
  177.  
  178.     }
  179.  
  180.     return k
  181.     
  182. end
  183.  
  184.  
  185. procedure heap_2_tree(h)
  186.  
  187.     #
  188.     # Construct the Huffman tree out of heap h.  Find the smallest
  189.     # element, pop it off the heap, then reshuffle the heap.  After
  190.     # reshuffling, replace the top record on the stack with a nodE()
  191.     # record whose n field equal to the sum of the n fields for the
  192.     # element popped off the stack originally, and the one that is
  193.     # now about to be replaced.  Link the new nodE record to the 2
  194.     # elements on the heap it is now replacing.  Reshuffle the heap
  195.     # again, then repeat.  You're done when the size of the heap is
  196.     # 1.  That one element remaining (h[1]) is your Huffman tree.
  197.     #
  198.     # Based loosely on Sedgewick (2nd ed., 1988), p. 328-9.
  199.     #
  200.     local frst, scnd, count
  201.  
  202.     until *h = 1 do {
  203.  
  204.     h[1] :=: h[*h]        # Reverse first and last elements.
  205.     frst := pull(h)        # Pop last elem off & save it.
  206.     reshuffle_heap(h, 1)    # Resettle the heap.
  207.     scnd := !h        # Save (but don't clobber) top element.
  208.  
  209.     count := frst.n + scnd.n
  210.     frst := { if *frst = 2 then frst.c else _ND(frst.l, frst.r) }
  211.     scnd := { if *scnd = 2 then scnd.c else _ND(scnd.l, scnd.r) }
  212.  
  213.     h[1] := nodE(frst, scnd, count) # Create new nodE().
  214.     reshuffle_heap(h, 1)    # Resettle once again.
  215.     }
  216.  
  217.     # H is no longer a stack.  It's single element - the root of a
  218.     # Huffman tree made up of nodE()s and leaF()s.  Put the l and r
  219.     # fields of that element into an _ND record, and return the new
  220.     # record.
  221.     return _ND(h[1].l, h[1].r)
  222.  
  223. end
  224.  
  225.  
  226. procedure hash_codes(tr)
  227.     local huff_tbl
  228.  
  229.     #
  230.     # Hash Huffman codes.  Tr (arg 1) is a Huffman tree created by
  231.     # heap_2_tree(heap).  Output is a table, with the keys
  232.     # representing characters, and the values being records of type
  233.     # huffcode(i,len), where i is the Huffcode (an integer) and len is
  234.     # the number of bits it occupies.
  235.     #
  236.     local code
  237.  
  238.     huff_tbl := table()
  239.     every code := collect_bits(tr) do
  240.     insert(huff_tbl, code.c, code)
  241.     return huff_tbl
  242.  
  243. end
  244.     
  245.  
  246. procedure collect_bits(tr, i, len)
  247.  
  248.     #
  249.     # Decompose Huffman tree tr into huffcode() records which contain
  250.     # 3 fields:  c (the character encoded), i (its integer code),
  251.     # and len (the number of bytes the integer code occupies).  Sus-
  252.     # pend one such record for each character encoded in tree tr.
  253.     #
  254.  
  255.     if type(tr) == "string" then
  256.     return huffcode(tr, i, len)
  257.     else {
  258.     (/len := 1) | (len +:= 1)
  259.     (/i   := 0) | (i   *:= 2)
  260.     suspend collect_bits(tr.l, i, len)
  261.     i   +:= 1
  262.     suspend collect_bits(tr.r, i, len)
  263.     }
  264.  
  265. end
  266.  
  267.  
  268. procedure put_tree(f, tr)
  269.  
  270.     #
  271.     # Writes Huffman tree tr to file f.  Uses first two bits to store
  272.     # the size of the tree.
  273.     #
  274.     local stringized_tr
  275.     # global count_of_all_chars
  276.  
  277.     /f | /tr & quitprog("put_tree","I need two nonnull arguments",7)
  278.  
  279.     stringized_tr := encode(tr)
  280.     every writes(f, outbits(*stringized_tr, 16))     # use two bytes
  281.     outbits()                         # just in case
  282.     writes(f, stringized_tr)
  283.     # How many characters are there in the input file?
  284.     every writes(f, outbits(count_of_all_chars, 32))
  285.     outbits()
  286.  
  287. end
  288.  
  289.  
  290. procedure get_tree(f)
  291.  
  292.     #
  293.     # Reads in Huffman tree from file f, sets pointer to the first
  294.     # encoded bit (as opposed to the bits which form the tree des-
  295.     # cription) in file f.
  296.     #
  297.     local stringized_tr_size, tr
  298.     # global count_of_all_chars
  299.  
  300.     stringized_tr_size := inbits(f, 16)
  301.     tr := decode(reads(f, stringized_tr_size)) |
  302.     quitprog("get_tree", "can't decode tree", 6)
  303.     count_of_all_chars := inbits(f, 32) |
  304.     quitprog("get_tree", "garbled input file", 10)
  305.     return tr
  306.  
  307. end
  308.  
  309.  
  310. procedure encode_string(s, huffman_table)
  311.  
  312.     #
  313.     # Encode string s using the codes in huffman_table (created by
  314.     # hash_codes, which in turns uses the Huffman tree created by
  315.     # heap_2_tree).
  316.     #
  317.     # Make sure you are using reads() and not read, unless you don't
  318.     # want to preserve newlines.
  319.     #
  320.     local s2, chr, hcode    # hcode stores huffcode records
  321.     static chars_written
  322.     initial chars_written := 0
  323.  
  324.     s2 := ""
  325.     s ? {
  326.     while chr := move(1) do {
  327.         chars_written +:= 1
  328.         hcode := \huffman_table[chr] |
  329.         quitprog("encode_string", "unexpected char, "||image(chr), 11)
  330.         every s2 ||:= outbits(hcode.i, hcode.len)
  331.     }
  332.     # If at end of output stream, then flush outbits buffer.
  333.     if chars_written = count_of_all_chars then {
  334.         chars_written := 0
  335.         s2 ||:= outbits()
  336.     } else {
  337.         if chars_written > count_of_all_chars then {
  338.         chars_written := 0
  339.         quitprog("encode_string", "you're trying to write _
  340.             more chars than you originally tabulated", 12)
  341.         }
  342.     }
  343.     }
  344.     return s2
  345.  
  346. end
  347.  
  348.  
  349. procedure decode_rest_of_file(f, size, huffman_tree)
  350.  
  351.     local s2, line, E, chr, bit
  352.     static chars_decoded
  353.     initial chars_decoded := 0
  354.  
  355.     E := huffman_tree
  356.     while line := reads(f, size) do {
  357.     line ? {
  358.         s2 := ""
  359.         while chr := move(1) do {
  360.         every bit := iand(1, ishift(ord(chr), -7 to 0)) do {
  361.             E := { if bit = 0 then E.l else E.r }
  362.             if s2 ||:= string(E) then {
  363.             chars_decoded +:= 1
  364.             if chars_decoded = count_of_all_chars then {
  365.                 chars_decoded := 0
  366.                 break { break break }
  367.             }
  368.             else E := huffman_tree
  369.             }
  370.         }
  371.         }
  372.         suspend s2
  373.     }
  374.     }
  375.     suspend s2
  376.  
  377. end
  378.  
  379.  
  380. procedure quitprog(p, m, c)
  381.  
  382.     /m := "program error"
  383.     write(&errout, p, ":  ", m)
  384.     exit(\c | 1)
  385.  
  386. end
  387.