home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / amigae / e_v3.2a / src / various / huff.e < prev    next >
Text File  |  2001-03-31  |  3KB  |  113 lines
  1. /* huffman crunching in E
  2.  
  3.    all it does is tell you how much gain you would have had
  4.    if crunching with huffman, it doesn't actually do it.
  5.  
  6.    sorry for the messy implementation here and there
  7. */
  8.  
  9. MODULE 'tools/file'
  10.  
  11. PROC countfreq(adr,num,freq:PTR TO LONG)
  12.   DEF a,ch,list=NIL
  13.   FOR a:=0 TO 255 DO freq[a]:=0
  14.   FOR a:=1 TO num
  15.     ch:=adr[]++
  16.     freq[ch]:=freq[ch]+1
  17.   ENDFOR
  18.   FOR a:=0 TO 255 DO list:=Link(c([freq[a],a]),list)
  19. ENDPROC Link(c([]),list)
  20.  
  21. PROC c(l)
  22.   DEF m
  23.   IF (m:=List(ListLen(l)))=NIL THEN Raise("MEM")
  24.   ListCopy(m,l)
  25. ENDPROC m
  26.  
  27. PROC takelowest(list:PTR TO LONG)
  28.   DEF l:PTR TO LONG,lf=1000000000,lp
  29.   WHILE l:=Next(list)
  30.     IF l[]<lf
  31.       lf:=l[]
  32.       lp:=list
  33.     ENDIF
  34.     list:=l
  35.   ENDWHILE
  36.   l:=Next(lp)
  37.   Link(lp,Next(l))
  38. ENDPROC l
  39.  
  40. PROC optimize(trees)
  41.   DEF numtrees=256,lowest:PTR TO LONG,low:PTR TO LONG
  42.   WHILE numtrees>1
  43.     lowest:=takelowest(trees)
  44.     low:=takelowest(trees)
  45.     Link(trees,Link(c([lowest[]+low[],lowest,low]),Next(trees)))
  46.     DEC numtrees
  47.   ENDWHILE
  48. ENDPROC Next(trees)
  49.  
  50. PROC writetree(tree:PTR TO LONG,off=0)
  51.   DEF a
  52.   IF ListLen(tree)=2
  53.     IF off THEN FOR a:=1 TO off DO WriteF('  ')
  54.     WriteF('[char=\d,freq=\d]\n',tree[1],tree[])
  55.   ELSE
  56.     writetree(tree[1],off+1)
  57.     writetree(tree[2],off+1)
  58.   ENDIF
  59. ENDPROC
  60.  
  61. PROC computetree(tree:PTR TO LONG,res:PTR TO LONG,bit,depth=0)
  62.   DEF a,b,r:PTR TO LONG,t,ar
  63.   IF ListLen(tree)=2
  64.     r:=36*tree[1]+res
  65.     r[0]:=depth
  66.     ar:=bit
  67.     FOR a:=1 TO 8
  68.       t:=0
  69.       FOR b:=0 TO 31 DO t:=t+IF ar[]++ THEN Shl(1,b) ELSE 0
  70.       r[a]:=t
  71.     ENDFOR
  72.   ELSE
  73.     bit[depth]:=1
  74.     computetree(tree[1],res,bit,depth+1)
  75.     bit[depth]:=0
  76.     computetree(tree[2],res,bit,depth+1)
  77.   ENDIF
  78. ENDPROC
  79.  
  80. PROC writebits(b:PTR TO LONG)
  81.   DEF a,d,e
  82.   d:=b
  83.   FOR a:=0 TO 255 
  84.     WriteF('b=\d\td=\d\t',b-d/36,b[]++)
  85.     FOR e:=0 TO 7 DO WriteF('\h[8]',b[]++)
  86.     WriteF('\n')
  87.   ENDFOR
  88. ENDPROC
  89.  
  90. PROC crunch(adr,num)
  91.   DEF trees, huffbits, bitarray[256]:ARRAY OF CHAR, a,freq[256]:ARRAY OF LONG,t=0
  92.   trees:=countfreq(adr,num,freq)
  93.   trees:=optimize(trees)
  94.   ->writetree(trees)
  95.   FOR a:=0 TO 255 DO bitarray[a]:=0
  96.   computetree(trees,huffbits:=NewR(36*256),bitarray)
  97.   ->writebits(huffbits)
  98.   FOR a:=0 TO 255 DO t:=t+Mul(freq[a],Long(a*36+huffbits))
  99.   WriteF('%crunched(gain)=\d%\n',100-Div(Mul(Div(t,8),100),num))
  100. ENDPROC
  101.  
  102. PROC main() HANDLE
  103.   DEF m,l
  104.   m,l:=readfile(arg)
  105.   WriteF('crunching file \s length \d\n',arg,l)
  106.   crunch(m,l)
  107. EXCEPT
  108.   SELECT exception
  109.     CASE "MEM"; WriteF('No Mem!\n')
  110.     CASE "OPEN";  WriteF('No File!\n')
  111.   ENDSELECT
  112. ENDPROC
  113.