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

85 lines
2.4 KiB
Plaintext

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