RosettaCodeData/Task/Huffman-coding/Oberon/huffman-coding.oberon

92 lines
1.8 KiB
Plaintext

MODULE HuffmanEncoding;
IMPORT
Object,
PriorityQueue,
Strings,
Out;
TYPE
Leaf = POINTER TO LeafDesc;
LeafDesc = RECORD
(Object.ObjectDesc)
c: CHAR;
END;
Inner = POINTER TO InnerDesc;
InnerDesc = RECORD
(Object.ObjectDesc)
left,right: Object.Object;
END;
VAR
str: ARRAY 128 OF CHAR;
i: INTEGER;
f: ARRAY 96 OF INTEGER;
q: PriorityQueue.Queue;
a: PriorityQueue.Node;
b: PriorityQueue.Node;
c: PriorityQueue.Node;
h: ARRAY 64 OF CHAR;
PROCEDURE NewLeaf(c: CHAR): Leaf;
VAR
x: Leaf;
BEGIN
NEW(x);x.c := c; RETURN x
END NewLeaf;
PROCEDURE NewInner(l,r: Object.Object): Inner;
VAR
x: Inner;
BEGIN
NEW(x); x.left := l; x.right := r; RETURN x
END NewInner;
PROCEDURE Preorder(n: Object.Object; VAR x: ARRAY OF CHAR);
BEGIN
IF n IS Leaf THEN
Out.Char(n(Leaf).c);Out.String(": ");Out.String(h);Out.Ln
ELSE
IF n(Inner).left # NIL THEN
Strings.Append("0",x);
Preorder(n(Inner).left,x);
Strings.Delete(x,(Strings.Length(x) - 1),1)
END;
IF n(Inner).right # NIL THEN
Strings.Append("1",x);
Preorder(n(Inner).right,x);
Strings.Delete(x,(Strings.Length(x) - 1),1)
END
END
END Preorder;
BEGIN
str := "this is an example for huffman encoding";
(* Collect letter frecuencies *)
i := 0;
WHILE str[i] # 0X DO INC(f[ORD(CAP(str[i])) - ORD(' ')]);INC(i) END;
(* Create Priority Queue *)
NEW(q);q.Clear();
(* Insert into the queue *)
i := 0;
WHILE (i < LEN(f)) DO
IF f[i] # 0 THEN
q.Insert(f[i]/Strings.Length(str),NewLeaf(CHR(i + ORD(' '))))
END;
INC(i)
END;
(* create tree *)
WHILE q.Length() > 1 DO
q.Remove(a);q.Remove(b);
q.Insert(a.w + b.w,NewInner(a.d,b.d));
END;
(* tree traversal *)
h[0] := 0X;q.Remove(c);Preorder(c.d,h);
END HuffmanEncoding.