Initial data commit

Task/Huffman-coding/M2000-Interpreter/huffman-coding.m2000

@@ -0,0 +1,84 @@
+Module Huffman {
+      comp=lambda (a, b) ->{
+            =array(a, 0)<array(b, 0)
+      }
+      module InsertPQ (a, n, &comp) {
+            if len(a)=0 then stack a {data n} : exit
+            if comp(n, stackitem(a)) then stack a {push n} : exit
+             stack a {
+                  push n
+                  t=2: b=len(a)
+                   m=b
+                   While t<=b {
+                         t1=m
+                        m=(b+t) div 2
+                        if m=0 then  m=t1 : exit
+                        If comp(stackitem(m),n) then t=m+1:  continue
+                        b=m-1
+                        m=b
+                  }
+                  if m>1 then shiftback m
+            }
+      }
+
+      a$="this is an example for huffman encoding"
+
+      inventory queue freq
+      For i=1 to len(a$)   {
+            b$=mid$(a$,i,1)
+            if exist(freq, b$) then Return freq, b$:=freq(b$)+1 : continue
+            append freq, b$:=1
+      }
+      sort ascending freq
+      b=stack
+      K=each(freq)
+      LenA=len(a$)
+      While k {
+            InsertPQ b, (Round(Eval(k)/lenA, 4), eval$(k, k^)), &comp
+      }
+      While len(b)>1 {
+            Stack b {
+                 Read m1, m2
+                 InsertPQ b, (Array(m1)+Array(m2), (m1, m2) ), &comp
+            }
+      }
+      Print  "Size of stack object (has only Root):"; len(b)
+      Print "Root probability:";Round(Array(Stackitem(b)), 3)
+      inventory encode, decode
+
+      Traverse(stackitem(b), "")
+      message$=""
+      For i=1 to len(a$)
+      message$+=encode$(mid$(a$, i, 1))
+      Next i
+
+      Print  message$
+      j=1
+      check$=""
+      For i=1 to len(a$)
+            d=each(encode)
+            While d {
+                  code$=eval$(d)
+                  if mid$(message$, j, len(code$))=code$ then {
+                        check$+=decode$(code$)
+                        Print decode$(code$); : j+=len(code$)
+                  }
+            }
+      Next i
+      Print
+      Print len(message$);" bits ", if$(a$=check$->"Encoding/decoding worked", "Encoding/Decoding failed")
+
+
+      Sub Traverse(a, a$)
+            local b=array(a,1)
+            if type$(b)="mArray"  Else {
+                  Print  @(10); quote$(array$(a, 1));" "; a$,@(20),array(a)
+                  Append decode, a$ :=array$(a, 1)
+                  Append encode, array$(a, 1):=a$
+                  Exit Sub
+            }
+            traverse(array(b), a$+"0")
+            traverse(array(b,1), a$+"1")
+      End Sub
+}
+Huffman