record huffnode(l,r,n,c)                        # internal and leaf nodes
record huffcode(c,n,b,i)                        # encoding table char, freq, bitstring, bits (int)

procedure main()

s := "this is an example for huffman encoding"

Count := huffcount(s)                           # frequency count
Tree := huffTree(Count)                         # heap and tree

Code := []                                      # extract encodings
CodeT := table()
every x := huffBits(Tree) do
   put( Code, CodeT[c] := huffcode( c := x[-1], Count[c].n, b := x[1:-1], integer("2r"||b) ) )

Code := sortf( Code, 1 )                        # show table in char order
write("Input String : ",image(s))
write(right("char",5), right("freq",5), " encoding" )
every write(right(image((x := !Code).c),5), right(x.n,5), " ", x.b )

end

procedure huffBits(N)                           # generates huffman bitcodes with trailing character
if \N.c then return N.c                         # . append leaf char code
suspend "0" || huffBits(N.l)                    # . left
suspend "1" || huffBits(N.r)                    # . right
end

procedure huffTree(T)                           # two queue huffman tree method
local Q1,Q2,x,n1,n2

Q1 := []                                        # queue of characters and weights
every x := !T do                                # ensure all are huffnodes
   if type(x) == "huffnode" then put(Q1,x) else runerr(205,x)
Q1 := sortf(Q1,3)                               # sort by weight ( 3 means by .n  )

if *Q1 > 1 then Q2 := []
while *Q1+*\Q2 > 1 do {                         # While there is more than one node ...

   n1 := if Q1[1] & ( ( Q1[1].n <= Q2[1].n ) | not Q2[1] ) then get(Q1) else get(Q2)  # lowest weight from Q1 or Q2
   n2 := if Q1[1] & ( ( Q1[1].n <= Q2[1].n ) | not Q2[1] ) then get(Q1) else get(Q2)  # lowest weight from Q1 or Q2

   put( Q2, huffnode( n1, n2, n1.n + n2.n ) )   # new weighted node to end of Q2
}

return (\Q2 | Q1)[1]                            # return the root node
end

procedure huffcount(s)                          # return characters and frequencies in a table of huffnodes by char
local c,T

T := table()
every c := !s do {
   /T[c] := huffnode(,,0,c)
   T[c].n +:= 1
   }
return T
end


hc=: 4 : 0
 if. 1=#x do. y
 else. ((i{x),+/j{x) hc (i{y),<j{y [ i=. (i.#x) -. j=. 2{./:x end.
)

hcodes=: 4 : 0
 assert. x -:&$ y           NB. weights and words have same shape
 assert. (0<:x) *. 1=#$x    NB. weights are non-negative
 assert. 1 >: L.y           NB. words are boxed not more than once
 w=. ,&.> y                 NB. standardized words
 assert. w -: ~.w           NB. words are unique
 t=. 0 {:: x hc w           NB. minimal weight binary tree
 ((< S: 0 t) i. w) { <@(1&=)@; S: 1 {:: t
)


import java.util.*;

abstract class HuffmanTree implements Comparable<HuffmanTree> {
    public final int frequency; // the frequency of this tree
    public HuffmanTree(int freq) { frequency = freq; }

    // compares on the frequency
    public int compareTo(HuffmanTree tree) {
        return frequency - tree.frequency;
    }
}

class HuffmanLeaf extends HuffmanTree {
    public final char value; // the character this leaf represents

    public HuffmanLeaf(int freq, char val) {
        super(freq);
        value = val;
    }
}

class HuffmanNode extends HuffmanTree {
    public final HuffmanTree left, right; // subtrees

    public HuffmanNode(HuffmanTree l, HuffmanTree r) {
        super(l.frequency + r.frequency);
        left = l;
        right = r;
    }
}

public class HuffmanCode {
    // input is an array of frequencies, indexed by character code
    public static HuffmanTree buildTree(int[] charFreqs) {
        PriorityQueue<HuffmanTree> trees = new PriorityQueue<HuffmanTree>();
        // initially, we have a forest of leaves
        // one for each non-empty character
        for (int i = 0; i < charFreqs.length; i++)
            if (charFreqs[i] > 0)
                trees.offer(new HuffmanLeaf(charFreqs[i], (char)i));

        assert trees.size() > 0;
        // loop until there is only one tree left
        while (trees.size() > 1) {
            // two trees with least frequency
            HuffmanTree a = trees.poll();
            HuffmanTree b = trees.poll();

            // put into new node and re-insert into queue
            trees.offer(new HuffmanNode(a, b));
        }
        return trees.poll();
    }

    public static void printCodes(HuffmanTree tree, StringBuffer prefix) {
        assert tree != null;
        if (tree instanceof HuffmanLeaf) {
            HuffmanLeaf leaf = (HuffmanLeaf)tree;

            // print out character, frequency, and code for this leaf (which is just the prefix)
            System.out.println(leaf.value + "\t" + leaf.frequency + "\t" + prefix);

        } else if (tree instanceof HuffmanNode) {
            HuffmanNode node = (HuffmanNode)tree;

            // traverse left
            prefix.append('0');
            printCodes(node.left, prefix);
            prefix.deleteCharAt(prefix.length()-1);

            // traverse right
            prefix.append('1');
            printCodes(node.right, prefix);
            prefix.deleteCharAt(prefix.length()-1);
        }
    }

    public static void main(String[] args) {
        String test = "this is an example for huffman encoding";

        // we will assume that all our characters will have
        // code less than 256, for simplicity
        int[] charFreqs = new int[256];
        // read each character and record the frequencies
        for (char c : test.toCharArray())
            charFreqs[c]++;

        // build tree
        HuffmanTree tree = buildTree(charFreqs);

        // print out results
        System.out.println("SYMBOL\tWEIGHT\tHUFFMAN CODE");
        printCodes(tree, new StringBuffer());
    }
}


function HuffmanEncoding(str) {
    this.str = str;

    var count_chars = {};
    for (var i = 0; i < str.length; i++)
        if (str[i] in count_chars)
            count_chars[str[i]] ++;
        else
            count_chars[str[i]] = 1;

    var pq = new BinaryHeap(function(x){return x[0];});
    for (var ch in count_chars)
        pq.push([count_chars[ch], ch]);

    while (pq.size() > 1) {
        var pair1 = pq.pop();
        var pair2 = pq.pop();
        pq.push([pair1[0]+pair2[0], [pair1[1], pair2[1]]]);
    }

    var tree = pq.pop();
    this.encoding = {};
    this._generate_encoding(tree[1], "");

    this.encoded_string = ""
    for (var i = 0; i < this.str.length; i++) {
        this.encoded_string += this.encoding[str[i]];
    }
}

HuffmanEncoding.prototype._generate_encoding = function(ary, prefix) {
    if (ary instanceof Array) {
        this._generate_encoding(ary[0], prefix + "0");
        this._generate_encoding(ary[1], prefix + "1");
    }
    else {
        this.encoding[ary] = prefix;
    }
}

HuffmanEncoding.prototype.inspect_encoding = function() {
    for (var ch in this.encoding) {
        print("'" + ch + "': " + this.encoding[ch])
    }
}

HuffmanEncoding.prototype.decode = function(encoded) {
    var rev_enc = {};
    for (var ch in this.encoding)
        rev_enc[this.encoding[ch]] = ch;

    var decoded = "";
    var pos = 0;
    while (pos < encoded.length) {
        var key = ""
        while (!(key in rev_enc)) {
            key += encoded[pos];
            pos++;
        }
        decoded += rev_enc[key];
    }
    return decoded;
}


abstract type HuffmanTree end

struct HuffmanLeaf <: HuffmanTree
    ch::Char
    freq::Int
end

struct HuffmanNode <: HuffmanTree
    freq::Int
    left::HuffmanTree
    right::HuffmanTree
end

function makefreqdict(s::String)
    d = Dict{Char, Int}()
    for c in s
        if !haskey(d, c)
            d[c] = 1
        else
            d[c] += 1
        end
    end
    d
end

function huffmantree(ftable::Dict)
    trees::Vector{HuffmanTree} = [HuffmanLeaf(ch, fq) for (ch, fq) in ftable]
    while length(trees) > 1
        sort!(trees, lt = (x, y) -> x.freq < y.freq, rev = true)
        least = pop!(trees)
        nextleast = pop!(trees)
        push!(trees, HuffmanNode(least.freq + nextleast.freq, least, nextleast))
    end
    trees[1]
end

printencoding(lf::HuffmanLeaf, code) = println(lf.ch == ' ' ? "space" : lf.ch, "\t", lf.freq, "\t", code)

function printencoding(nd::HuffmanNode, code)
    code *= '0'
    printencoding(nd.left, code)
    code = code[1:end-1]

    code *= '1'
    printencoding(nd.right, code)
    code = code[1:end-1]
end

const msg = "this is an example for huffman encoding"

println("Char\tFreq\tHuffman code")

printencoding(huffmantree(makefreqdict(msg)), "")


import java.util.*

abstract class HuffmanTree(var freq: Int) : Comparable<HuffmanTree> {
    override fun compareTo(other: HuffmanTree) = freq - other.freq
}

class HuffmanLeaf(freq: Int, var value: Char) : HuffmanTree(freq)

class HuffmanNode(var left: HuffmanTree, var right: HuffmanTree) : HuffmanTree(left.freq + right.freq)

fun buildTree(charFreqs: IntArray) : HuffmanTree {
    val trees = PriorityQueue<HuffmanTree>()

    charFreqs.forEachIndexed { index, freq ->
        if(freq > 0) trees.offer(HuffmanLeaf(freq, index.toChar()))
    }

    assert(trees.size > 0)
    while (trees.size > 1) {
        val a = trees.poll()
        val b = trees.poll()
        trees.offer(HuffmanNode(a, b))
    }

    return trees.poll()
}

fun printCodes(tree: HuffmanTree, prefix: StringBuffer) {
    when(tree) {
        is HuffmanLeaf -> println("${tree.value}\t${tree.freq}\t$prefix")
        is HuffmanNode -> {
            //traverse left
            prefix.append('0')
            printCodes(tree.left, prefix)
            prefix.deleteCharAt(prefix.lastIndex)
            //traverse right
            prefix.append('1')
            printCodes(tree.right, prefix)
            prefix.deleteCharAt(prefix.lastIndex)
        }
    }
}

fun main(args: Array<String>) {
    val test = "this is an example for huffman encoding"

    val maxIndex = test.max()!!.toInt() + 1
    val freqs = IntArray(maxIndex) //256 enough for latin ASCII table, but dynamic size is more fun
    test.forEach { freqs[it.toInt()] += 1 }

    val tree = buildTree(freqs)
    println("SYMBOL\tWEIGHT\tHUFFMAN CODE")
    printCodes(tree, StringBuffer())
}


local build_freqtable = function (data)
  local freq = { }

  for i = 1, #data do
    local cur = string.sub (data, i, i)
    local count = freq [cur] or 0
    freq [cur] = count + 1
  end

  local nodes = { }
  for w, f in next, freq do
    nodes [#nodes + 1] = { word = w, freq = f }
  end

  table.sort (nodes, function (a, b) return a.freq > b.freq end) --- reverse order!

  return nodes
end

local build_hufftree = function (nodes)
  while true do
    local n = #nodes
    local left = nodes [n]
    nodes [n] = nil

    local right = nodes [n - 1]
    nodes [n - 1] = nil

    local new = { freq = left.freq + right.freq, left = left, right = right }

    if n == 2 then return new end

    --- insert new node at correct priority
    local prio = 1
    while prio < #nodes and nodes [prio].freq > new.freq do
      prio = prio + 1
    end
    table.insert (nodes, prio, new)
  end
end

local print_huffcodes do
  local rec_build_huffcodes
  rec_build_huffcodes = function (node, bits, acc)
    if node.word == nil then
      rec_build_huffcodes (node.left,  bits .. "0", acc)
      rec_build_huffcodes (node.right, bits .. "1", acc)
      return acc
    else --- leaf
      acc [#acc + 1] = { node.freq, node.word, bits }
    end
    return acc
  end

  print_huffcodes = function (root)
    local codes = rec_build_huffcodes (root, "", { })
    table.sort (codes, function (a, b) return a [1] < b [1] end)
    print ("frequency\tword\thuffman code")
    for i = 1, #codes do
      print (string.format ("%9d\t‘%s’\t“%s”", table.unpack (codes [i])))
    end
  end
end

local huffcode = function (data)
  local nodes = build_freqtable (data)
  local huff = build_hufftree (nodes)
  print_huffcodes (huff)
  return 0
end

return huffcode "this is an example for huffman encoding"


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


huffman[s_String] := huffman[Characters[s]];
huffman[l_List] := Module[{merge, structure, rules},

   (*merge front two branches. list is assumed to be sorted*)
   merge[k_] := Replace[k, {{a_, aC_}, {b_, bC_}, rest___} :> {{{a, b}, aC + bC}, rest}];

   structure = FixedPoint[
      Composition[merge, SortBy[#, Last] &],
      Tally[l]][[1, 1]];

   rules = (# -> Flatten[Position[structure, #] - 1]) & /@ DeleteDuplicates[l];

   {Flatten[l /. rules], rules}];


import tables, sequtils

type

  # Following range can be changed to produce Huffman codes on arbitrary alphabet (e.g. ternary codes)
  CodeSymbol = range[0..1]

  HuffCode = seq[CodeSymbol]

  Node = ref object
    f: int
    parent: Node
    case isLeaf: bool
    of true:
      c: char
    else:
      childs: array[CodeSymbol, Node]

func `<`(a: Node, b: Node): bool =
  # For min operator.
  a.f < b.f

func `$`(hc: HuffCode): string =
  result = ""
  for symbol in hc:
    result &= $symbol

func freeChildList(tree: seq[Node], parent: Node = nil): seq[Node] =
  ## Constructs a sequence of nodes which can be adopted
  ## Optional parent parameter can be set to ensure node will not adopt itself
  for node in tree:
    if node.parent.isNil and node != parent: result.add(node)

func connect(parent: Node, child: Node) =
  # Only call this proc when sure that parent has a free child slot
  child.parent = parent
  parent.f += child.f
  for i in parent.childs.low..parent.childs.high:
    if parent.childs[i] == nil:
      parent.childs[i] = child
      return

func generateCodes(codes: TableRef[char, HuffCode],
                   currentNode: Node, currentCode: HuffCode = @[]) =

  if currentNode.isLeaf:
    let key = currentNode.c
    codes[key] = currentCode
    return

  for i in currentNode.childs.low..currentNode.childs.high:
    if not currentNode.childs[i].isNil:
      let newCode = currentCode & i
      generateCodes(codes, currentNode.childs[i], newCode)

func buildTree(frequencies: CountTable[char]): seq[Node] =

  result = newSeq[Node](frequencies.len)
  for i in result.low..result.high:
    let key = toSeq(frequencies.keys)[i]
    result[i] = Node(f: frequencies[key], isLeaf: true, c: key)

  while result.freeChildList.len > 1:
    let currentNode = new Node
    result.add(currentNode)
    for c in currentNode.childs:
      currentNode.connect(min(result.freeChildList(currentNode)))
      if result.freeChildList.len <= 1: break

when isMainModule:

  import algorithm, strformat

  const
    SampleString = "this is an example for huffman encoding"
    SampleFrequencies = SampleString.toCountTable()

  func `<`(code1, code2: HuffCode): bool =
    # Used to sort the result.
    if code1.len == code2.len:
      result = false
      for (c1, c2) in zip(code1, code2):
        if c1 != c2: return c1 < c2
    else:
      result = code1.len < code2.len

  let
    tree = buildTree(SampleFrequencies)
    root = tree.freeChildList[0]

  var huffCodes = newTable[char, HuffCode]()
  generateCodes(huffCodes, root)

  for (key, value) in sortedByIt(toSeq(huffCodes.pairs), it[1]):
    echo &"'{key}' → {value}"


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.


#import <Foundation/Foundation.h>

@interface HuffmanTree : NSObject {
	int freq;
}
-(instancetype)initWithFreq:(int)f;
@property (nonatomic, readonly) int freq;
@end

@implementation HuffmanTree
@synthesize freq; // the frequency of this tree
-(instancetype)initWithFreq:(int)f {
	if (self = [super init]) {
		freq = f;
	}
	return self;
}
@end

const void *HuffmanRetain(CFAllocatorRef allocator, const void *ptr) {
	return (__bridge_retained const void *)(__bridge id)ptr;
}
void HuffmanRelease(CFAllocatorRef allocator, const void *ptr) {
	(void)(__bridge_transfer id)ptr;
}
CFComparisonResult HuffmanCompare(const void *ptr1, const void *ptr2, void *unused) {
	int f1 = ((__bridge HuffmanTree *)ptr1).freq;
	int f2 = ((__bridge HuffmanTree *)ptr2).freq;
	if (f1 == f2)
		return kCFCompareEqualTo;
	else if (f1 > f2)
		return kCFCompareGreaterThan;
	else
		return kCFCompareLessThan;
}

@interface HuffmanLeaf : HuffmanTree {
	char value; // the character this leaf represents
}
@property (readonly) char value;
-(instancetype)initWithFreq:(int)f character:(char)c;
@end

@implementation HuffmanLeaf
@synthesize value;
-(instancetype)initWithFreq:(int)f character:(char)c {
	if (self = [super initWithFreq:f]) {
		value = c;
	}
	return self;
}
@end

@interface HuffmanNode : HuffmanTree {
	HuffmanTree *left, *right; // subtrees
}
@property (readonly) HuffmanTree *left, *right;
-(instancetype)initWithLeft:(HuffmanTree *)l right:(HuffmanTree *)r;
@end

@implementation HuffmanNode
@synthesize left, right;
-(instancetype)initWithLeft:(HuffmanTree *)l right:(HuffmanTree *)r {
	if (self = [super initWithFreq:l.freq+r.freq]) {
		left = l;
		right = r;
	}
	return self;
}
@end

HuffmanTree *buildTree(NSCountedSet *chars) {

	CFBinaryHeapCallBacks callBacks = {0, HuffmanRetain, HuffmanRelease, NULL, HuffmanCompare};
	CFBinaryHeapRef trees = CFBinaryHeapCreate(NULL, 0, &callBacks, NULL);

	// initially, we have a forest of leaves
	// one for each non-empty character
	for (NSNumber *ch in chars) {
		int freq = [chars countForObject:ch];
		if (freq > 0)
			CFBinaryHeapAddValue(trees, (__bridge const void *)[[HuffmanLeaf alloc] initWithFreq:freq character:(char)[ch intValue]]);
	}

	NSCAssert(CFBinaryHeapGetCount(trees) > 0, @"String must have at least one character");
	// loop until there is only one tree left
	while (CFBinaryHeapGetCount(trees) > 1) {
		// two trees with least frequency
		HuffmanTree *a = (__bridge HuffmanTree *)CFBinaryHeapGetMinimum(trees);
		CFBinaryHeapRemoveMinimumValue(trees);
		HuffmanTree *b = (__bridge HuffmanTree *)CFBinaryHeapGetMinimum(trees);
		CFBinaryHeapRemoveMinimumValue(trees);

		// put into new node and re-insert into queue
		CFBinaryHeapAddValue(trees, (__bridge const void *)[[HuffmanNode alloc] initWithLeft:a right:b]);
	}
	HuffmanTree *result = (__bridge HuffmanTree *)CFBinaryHeapGetMinimum(trees);
	CFRelease(trees);
	return result;
}

void printCodes(HuffmanTree *tree, NSMutableString *prefix) {
	NSCAssert(tree != nil, @"tree must not be nil");
	if ([tree isKindOfClass:[HuffmanLeaf class]]) {
		HuffmanLeaf *leaf = (HuffmanLeaf *)tree;

		// print out character, frequency, and code for this leaf (which is just the prefix)
		NSLog(@"%c\t%d\t%@", leaf.value, leaf.freq, prefix);

	} else if ([tree isKindOfClass:[HuffmanNode class]]) {
		HuffmanNode *node = (HuffmanNode *)tree;

		// traverse left
		[prefix appendString:@"0"];
		printCodes(node.left, prefix);
		[prefix deleteCharactersInRange:NSMakeRange([prefix length]-1, 1)];

		// traverse right
		[prefix appendString:@"1"];
		printCodes(node.right, prefix);
		[prefix deleteCharactersInRange:NSMakeRange([prefix length]-1, 1)];
	}
}

int main(int argc, const char * argv[]) {
    @autoreleasepool {

	NSString *test = @"this is an example for huffman encoding";

	// read each character and record the frequencies
	NSCountedSet *chars = [[NSCountedSet alloc] init];
	int n = [test length];
	for (int i = 0; i < n; i++)
		[chars addObject:@([test characterAtIndex:i])];

	// build tree
	HuffmanTree *tree = buildTree(chars);

	// print out results
	NSLog(@"SYMBOL\tWEIGHT\tHUFFMAN CODE");
	printCodes(tree, [NSMutableString string]);

    }
    return 0;
}


type 'a huffman_tree =
  | Leaf of 'a
  | Node of 'a huffman_tree * 'a huffman_tree

module HSet = Set.Make
  (struct
     type t = int * char huffman_tree (* pair of frequency and the tree *)
     let compare = compare
       (* We can use the built-in compare function to order this: it will order
          first by the first element (frequency) and then by the second (the tree),
          the latter of which we don't care about but which helps prevent elements
          from being equal, since Set does not allow duplicate elements *)
   end);;

let build_tree charFreqs =
  let leaves = HSet.of_list (List.map (fun (c,f) -> (f, Leaf c)) charFreqs) in
  let rec aux trees =
    let f1, a = HSet.min_elt trees in
    let trees' = HSet.remove (f1,a) trees in
    if HSet.is_empty trees' then
      a
    else
      let f2, b = HSet.min_elt trees' in
      let trees'' = HSet.remove (f2,b) trees' in
      let trees''' = HSet.add (f1 + f2, Node (a, b)) trees'' in
      aux trees'''
  in
  aux leaves

let rec print_tree code = function
  | Leaf c ->
      Printf.printf "%c\t%s\n" c (String.concat "" (List.rev code));
  | Node (l, r) ->
      print_tree ("0"::code) l;
      print_tree ("1"::code) r

let () =
  let str = "this is an example for huffman encoding" in
  let charFreqs = Hashtbl.create 42 in
  String.iter (fun c ->
      let old =
        try Hashtbl.find charFreqs c
        with Not_found -> 0 in
      Hashtbl.replace charFreqs c (old+1)
    ) str;

  let charFreqs = Hashtbl.fold (fun c f acc -> (c,f)::acc) charFreqs [] in
  let tree = build_tree charFreqs in
  print_string "Symbol\tHuffman code\n";
  print_tree [] tree


(define phrase "this is an example for huffman encoding")

; prepare initial probabilities table
(define table (ff->list
   (fold (lambda (ff x)
            (put ff x (+ (ff x 0) 1)))
      {}
      (string->runes phrase))))

; just sorter...
(define (resort l)
   (sort (lambda (x y) (< (cdr x) (cdr y))) l))
; ...to sort table
(define table (resort table))

; build huffman tree
(define tree
   (let loop ((table table))
      (if (null? (cdr table))
         (car table)
         (loop (resort (cons
            (cons
               { 1 (car table) 0 (cadr table)}
               (+ (cdar table) (cdadr table)))
            (cddr table)))))))

; huffman codes
(define codes
   (map (lambda (i)
         (call/cc (lambda (return)
            (let loop ((prefix #null) (tree tree))
               (if (ff? (car tree))
                  (begin
                     (loop (cons 0 prefix) ((car tree) 0))
                     (loop (cons 1 prefix) ((car tree) 1)))
                  (if (eq? (car tree) i)
                     (return (reverse prefix))))))))
      (map car table)))


use 5.10.0;
use strict;

# produce encode and decode dictionary from a tree
sub walk {
	my ($node, $code, $h, $rev_h) = @_;

	my $c = $node->[0];
	if (ref $c) { walk($c->[$_], $code.$_, $h, $rev_h) for 0,1 }
	else        { $h->{$c} = $code; $rev_h->{$code} = $c }

	$h, $rev_h
}

# make a tree, and return resulting dictionaries
sub mktree {
	my (%freq, @nodes);
	$freq{$_}++ for split '', shift;
	@nodes = map([$_, $freq{$_}], keys %freq);

	do {	# poor man's priority queue
		@nodes = sort {$a->[1] <=> $b->[1]} @nodes;
		my ($x, $y) = splice @nodes, 0, 2;
		push @nodes, [[$x, $y], $x->[1] + $y->[1]]
	} while (@nodes > 1);

	walk($nodes[0], '', {}, {})
}

sub encode {
	my ($str, $dict) = @_;
	join '', map $dict->{$_}//die("bad char $_"), split '', $str
}

sub decode {
	my ($str, $dict) = @_;
	my ($seg, @out) = ("");

	# append to current segment until it's in the dictionary
	for (split '', $str) {
		$seg .= $_;
		my $x = $dict->{$seg} // next;
		push @out, $x;
		$seg = '';
	}
	die "bad code" if length($seg);
	join '', @out
}

my $txt = 'this is an example for huffman encoding';
my ($h, $rev_h) = mktree($txt);
for (keys %$h) { print "'$_': $h->{$_}\n" }

my $enc = encode($txt, $h);
print "$enc\n";

print decode($enc, $rev_h), "\n";


with javascript_semantics
function store_nodes(object key, object data, integer nodes)
    setd({data,key},0,nodes)
    return 1
end function

function build_freqtable(string data)
    integer freq = new_dict(),
            nodes = new_dict()
    for i=1 to length(data) do
        integer di = data[i]
        setd(di,getd(di,freq)+1,freq)
    end for
    traverse_dict(store_nodes, nodes, freq)
    destroy_dict(freq)
    return nodes
end function

function build_hufftree(integer nodes)
    sequence node
    while true do
        sequence lkey = getd_partial_key({0,0},nodes)
        integer lfreq = lkey[1]
        deld(lkey,nodes)
        sequence rkey = getd_partial_key({0,0},nodes)
        integer rfreq = rkey[1]
        deld(rkey,nodes)

        node = {lfreq+rfreq,{lkey,rkey}}

        if dict_size(nodes)=0 then exit end if

        setd(node,0,nodes)
    end while
    destroy_dict(nodes)
    return node
end function

procedure build_huffcodes(object node, string bits, integer d)
    {integer freq, object data} = node
    if sequence(data) then
        build_huffcodes(data[1],bits&'0',d)
        build_huffcodes(data[2],bits&'1',d)
    else
        setd(data,{freq,bits},d)
    end if
end procedure

function print_huffcode(integer key, sequence data, integer /*user_data*/)
    {integer i, string s} = data
    printf(1,"'%c' [%d] %s\n",{key,i,s})
    return 1
end function

procedure print_huffcodes(integer d)
    traverse_dict(print_huffcode, 0, d)
end procedure

function invert_huffcode(integer key, sequence data, integer rd)
    setd(data[2],key,rd)
    return 1
end function

procedure main(string data)
    if length(data)<2 then ?9/0 end if
    integer nodes = build_freqtable(data)
    sequence huff = build_hufftree(nodes)
    integer d = new_dict()
    build_huffcodes(huff, "", d)
    print_huffcodes(d)

    string encoded = ""
    for i=1 to length(data) do
        encoded &= getd(data[i],d)[2]
    end for
    ?shorten(encoded)

    integer rd = new_dict()
    traverse_dict(invert_huffcode, rd, d)
    string decoded = ""
    integer done = 0
    while done<length(encoded) do
        string key = ""
        integer node = 0
        while node=0 do
            done += 1
            key &= encoded[done]
            node = getd_index(key, rd)
        end while
        decoded &= getd_by_index(node,rd)
    end while
    ?decoded

end procedure

main("this is an example for huffman encoding")


<?php
function encode($symb2freq) {
    $heap = new SplPriorityQueue;
    $heap->setExtractFlags(SplPriorityQueue::EXTR_BOTH);
    foreach ($symb2freq as $sym => $wt)
        $heap->insert(array($sym => ''), -$wt);

    while ($heap->count() > 1) {
        $lo = $heap->extract();
        $hi = $heap->extract();
        foreach ($lo['data'] as &$x)
            $x = '0'.$x;
        foreach ($hi['data'] as &$x)
            $x = '1'.$x;
        $heap->insert($lo['data'] + $hi['data'],
                      $lo['priority'] + $hi['priority']);
    }
    $result = $heap->extract();
    return $result['data'];
}

$txt = 'this is an example for huffman encoding';
$symb2freq = array_count_values(str_split($txt));
$huff = encode($symb2freq);
echo "Symbol\tWeight\tHuffman Code\n";
foreach ($huff as $sym => $code)
    echo "$sym\t$symb2freq[$sym]\t$code\n";
?>


go =>
  huffman("this is an example for huffman encoding").

huffman(LA) :-
   LS=sort(LA),
   packList(LS,PL),
   PLS=sort(PL).remove_dups(),
   build_tree(PLS, A),
   coding(A, [], C),
   SC=sort(C).remove_dups(),
   println("Symbol\tWeight\tCode"),
   foreach(SS in SC) print_code(SS) end.

build_tree([[V1|R1], [V2|R2]|T], AF) :-
   V = V1 + V2,
   A = [V, [V1|R1], [V2|R2]],
   (   T=[] -> AF=A ; NT=sort([A|T]), build_tree(NT, AF) ).

coding([_A,FG,FD], Code, CF) :-
   (   is_node(FG) ->  coding(FG, [0 | Code], C1)
          ;  leaf_coding(FG, [0 | Code], C1) ),
   (   is_node(FD) ->  coding(FD, [1 | Code], C2)
          ;  leaf_coding(FD, [1 | Code], C2) ),
   append(C1, C2, CF).

leaf_coding([FG,FD], Code, CF) :-
   CodeR = reverse(Code),
   CF = [[FG, FD, CodeR]] .

is_node([_V, _FG, _FD]).

print_code([N, Car, Code]) :-
   printf("%w:\t%w\t", Car, N),
   foreach(V in Code) print(V) end,
   nl.

packList([], []).
packList([X],[[1,X]]).
packList([X|Rest], XRunPacked) :-
   XRunPacked = [XRun|Packed],
   run(X, Rest, XRun, RRest),
   packList(RRest, Packed).

run(V, [], VV, [])  :- VV=[1,V].
run(V, [V|LRest], [N1,V], RRest) :-
   run(V, LRest, [N, V], RRest),
   N1 = N + 1.
run(V, [Other|RRest], [1,V], [Other|RRest]) :-
   different_terms(V, Other).


(de prio (Idx)
   (while (cadr Idx) (setq Idx @))
   (car Idx) )

(let (A NIL  P NIL  L NIL)
   (for C (chop "this is an example for huffman encoding")
      (accu 'A C 1) )                  # Count characters
   (for X A                            # Build index tree as priority queue
      (idx 'P (cons (cdr X) (car X)) T) )
   (while (or (cadr P) (cddr P))       # Remove entries, insert as nodes
      (let (A (car (idx 'P (prio P) NIL))  B (car (idx 'P (prio P) NIL)))
         (idx 'P (cons (+ (car A) (car B)) A B) T) ) )
   (setq P (car P))
   (recur (P L)                        # Traverse and print
      (if (atom (cdr P))
         (prinl (cdr P)  " " L)
         (recurse (cadr P) (cons 0 L))
         (recurse (cddr P) (cons 1 L)) ) ) )


*process source attributes xref or(!);
 hencode: Proc Options(main);
 /*--------------------------------------------------------------------
 * 28.12.013 Walter Pachl  translated from REXX
 *-------------------------------------------------------------------*/
 Dcl debug Bit(1) Init('0'b);
 Dcl (i,j,k) Bin Fixed(15);
 Dcl c Char(1);
 Dcl s Char(100) Var Init('this is an example for huffman encoding');
 Dcl sc Char(1000) Var Init('');
 Dcl sr Char(100)  Var Init('');
 Dcl 1 cocc(100),
      2 c  Char(1),
      2 occ Bin Fixed(31);
 Dcl cocc_n Bin Fixed(15) Init(0);
 dcl 1 node,
      2 id      Bin Fixed(15),         /* Node id               */
      2 c       Char(1),               /* character             */
      2 occ     Bin Fixed(15),         /* number of occurrences */
      2 left    Bin Fixed(15),         /* left child            */
      2 rite    Bin Fixed(15),         /* right child           */
      2 father  Bin Fixed(15),         /* father                */
      2 digit   Pic'9',                /* digit (0 or 1)        */
      2 term    Pic'9';                /* 1=terminal node       */
 node='';
 Dcl 1 m(100) Like node;
 Dcl m_n Bin Fixed(15) Init(0);
 Dcl father(100) Bin Fixed(15);

 Dcl 1 t(100),
      2 char Char(1),
      2 code Char(20) Var;
 Dcl t_n Bin Fixed(15) Init(0);

 Do i=1 To length(s);               /* first collect used characters */
   c=substr(s,i,1);                 /* and number of occurrences     */
   Do j=1 To cocc_n;
     If cocc(j).c=c Then Leave;
     End;
   If j<= cocc_n Then
     cocc(j).occ+=1;
   Else Do;
     cocc(j).c=c;
     cocc(j).occ=1;
     cocc_n+=1;
     End;
   End;

 Do j=1 To cocc_n;                     /* create initial node list   */
   node.id+=1;
   node.c=cocc(j).c;
   node.occ=cocc(j).occ;
   node.term=1;
   Call add_node;
   End;

 If debug Then
   Call show;

 Do While(pairs());  /* while there is more than one fatherless node */
   Call mk_node;                       /* create a father node       */
   If debug Then
     Call show;
   End;

 Call show;                            /* show the node table        */

 Call mk_trans;                        /* create the translate table */
 Put Edit('The translate table:')(Skip,a);
 Do i=1 To t_n;                        /* show it                    */
   Put Edit(t(i).char,' -> ',t(i).code)(Skip,a,a,a);
   End;

 Call encode;                          /* encode the string s -> sc  */

 Put Edit('length(sc)=',length(sc))    /* show it                    */
         (Skip,a,f(3));
 Do i=1 By 70 To length(sc);
   Put Edit(substr(sc,i,70))(Skip,a);
   End;

 Call decode;                          /* decode the string sc -> sr */
 Put Edit('input : ',s)(skip,a,a);
 Put Edit('result: ',sr)(skip,a,a);
 Return;

 add_node: Proc;
 /*--------------------------------------------------------------------
 * Insert the node according to increasing occurrences
 *-------------------------------------------------------------------*/
 il:
   Do i=1 To m_n;
     If m(i).occ>=node.occ Then Do;
       Do k=m_n To i By -1;
         m(k+1)=m(k);
         End;
       Leave il;
       End;
     End;
   m(i)=node;
   m_n+=1;
 End;

 show: Proc;
 /*--------------------------------------------------------------------
 * Show the contents of the node table
 *-------------------------------------------------------------------*/
 Put Edit('The list of nodes:')(Skip,a);
 Put Edit('id c oc  l  r  f d  t')(Skip,a);
 Do i=1 To m_n;
   Put Edit(m(i).id,m(i).c,m(i).occ,
            m(i).left,m(i).rite,m(i).father,m(i).digit,m(i).term)
           (Skip,f(2),x(1),a,4(f(3)),f(2),f(3));
   End;
 End;

 mk_node: Proc;
 /*--------------------------------------------------------------------
 * construct and store a new intermediate node or the top node
 *-------------------------------------------------------------------*/
 Dcl z Bin Fixed(15);
 node='';
 node.id=m_n+1;                /* the next node id                   */
 node.c='*';
 ni=m_n+1;
 loop:
 Do i=1 To m_n;                /* loop over node lines               */
  If m(i).father=0 Then Do;    /* a fatherless node                  */
    z=m(i).id;                 /* its id                             */
    If node.left=0 Then Do;    /* new node has no left child         */
       node.left=z;            /* make this the lect child           */
       node.occ=m(i).occ;      /* occurrences                        */
       m(i).father=ni;         /* store father info                  */
       m(i).digit=0;           /* digit 0 to be used                 */
       father(z)=ni;           /* remember z's father (redundant)    */
       End;
     Else Do;                  /* New node has already left child    */
       node.rite=z;            /* make this the right child          */
       node.occ=node.occ+m(i).occ;  /* add in the occurrences        */
       m(i).father=ni;         /* store father info                  */
       m(i).digit=1;           /* digit 1 to be used                 */
       father(z)=ni;           /* remember z's father (redundant)    */
       Leave loop;
       End;
     End;
   End;
 Call add_node;
 End;

 pairs: Proc Returns(Bit(1));
 /*--------------------------------------------------------------------
 * Return true if there are at least 2 fatherless nodes
 *-------------------------------------------------------------------*/
 Dcl i   Bin Fixed(15);
 Dcl cnt Bin Fixed(15) Init(0);
 Do i=1 To m_n;
   If m(i).father=0 Then Do;
     cnt+=1;
     If cnt>1 Then
       Return('1'b);
     End;
   End;
 Return('0'b);
 End;

 mk_trans: Proc;
 /*--------------------------------------------------------------------
 * Compute the codes for all terminal nodes (characters)
 * and store the relation char -> code in array t(*)
 *-------------------------------------------------------------------*/
 Dcl (i,fi,fid,fidz,node,z) Bin Fixed(15);
 Dcl code Char(20) Var;
 Do i=1 To m_n;     /* now we loop over all lines representing nodes */
   If m(i).term Then Do;   /* for each terminal node                 */
     code=m(i).digit;      /* its digit is the last code digit       */
     node=m(i).id;         /* its id                                 */
     Do fi=1 To 1000;      /* actually Forever                       */
       fid=father(node);   /* id of father                           */
       If fid>0 Then Do;   /* father exists                          */
         fidz=zeile(fid);  /* line that contains the father          */
         code=m(fidz).digit!!code;    /* prepend the digit           */
         node=fid;         /* look for next father                   */
         End;
       Else                /* no father (we reached the top          */
         Leave;
       End;
     If length(code)>1 Then /* more than one character in input      */
       code=substr(code,2); /* remove the the top node's 0           */
     call dbg(m(i).c!!' -> '!!code); /* character is encoded this way*/
 ti_loop:
     Do ti=1 To t_n;
       If t(ti).char>m(i).c Then Do;
         Do tj=t_n To ti By -1
           t(tj+1)=t(tj);
           End;
         Leave ti_loop;
         End;
       End;
     t(ti).char=m(i).c;
     t(ti).code=code;
     t_n+=1;
     Call dbg(t(ti).char!!' -> '!!t(ti).code);
     End;
   End;
 End;

 zeile: Proc(nid) Returns(Bin Fixed(15));
 /*--------------------------------------------------------------------
 * find and return line number containing node-id
 *-------------------------------------------------------------------*/
 Dcl (nid,i) Bin Fixed(15);
 do i=1 To m_n;
   If m(i).id=nid Then
     Return(i);
   End;
 Stop;
 End;

 dbg: Proc(txt);
 /*--------------------------------------------------------------------
 * Show text if debug is enabled
 *-------------------------------------------------------------------*/
 Dcl txt Char(*);
 If debug Then
   Put Skip List(txt);
 End;

 encode: Proc;
 /*--------------------------------------------------------------------
 * encode the string s -> sc
 *-------------------------------------------------------------------*/
 Dcl (i,j) Bin Fixed(15);
 Do i=1 To length(s);
   c=substr(s,i,1);
   Do j=1 To t_n;
     If c=t(j).char Then
       Leave;
     End;
   sc=sc!!t(j).code;
   End;
 End;

 decode: Proc;
 /*--------------------------------------------------------------------
 * decode the string sc -> sr
 *-------------------------------------------------------------------*/
 Dcl (i,j) Bin Fixed(15);
 Do While(sc>'');
   Do j=1 To t_n;
     If substr(sc,1,length(t(j).code))=t(j).code Then
       Leave;
     End;
   sr=sr!!t(j).char;
   sc=substr(sc,length(t(j).code)+1);
   End;
 End;

 End;


function Get-HuffmanEncodingTable ( $String )
    {
    #  Create leaf nodes
    $ID = 0
    $Nodes = [char[]]$String |
        Group-Object |
        ForEach { $ID++; $_ } |
        Select  @{ Label = 'Symbol'  ; Expression = { $_.Name  } },
                @{ Label = 'Count'   ; Expression = { $_.Count } },
                @{ Label = 'ID'      ; Expression = { $ID      } },
                @{ Label = 'Parent'  ; Expression = { 0        } },
                @{ Label = 'Code'    ; Expression = { ''       } }

    #  Grow stems under leafs
    ForEach ( $Branch in 2..($Nodes.Count) )
        {
        #  Get the two nodes with the lowest count
        $LowNodes = $Nodes | Where Parent -eq 0 | Sort Count | Select -First 2

        #  Create a new stem node
        $ID++
        $Nodes += '' |
            Select  @{ Label = 'Symbol'  ; Expression = { ''       } },
                    @{ Label = 'Count'   ; Expression = { $LowNodes[0].Count + $LowNodes[1].Count } },
                    @{ Label = 'ID'      ; Expression = { $ID      } },
                    @{ Label = 'Parent'  ; Expression = { 0        } },
                    @{ Label = 'Code'    ; Expression = { ''       } }

        #  Put the two nodes in the new stem node
        $LowNodes[0].Parent = $ID
        $LowNodes[1].Parent = $ID

        #  Assign 0 and 1 to the left and right nodes
        $LowNodes[0].Code = '0'
        $LowNodes[1].Code = '1'
        }

    #  Assign coding to nodes
    ForEach ( $Node in $Nodes[($Nodes.Count-2)..0] )
        {
        $Node.Code = ( $Nodes | Where ID -eq $Node.Parent ).Code + $Node.Code
        }

    $EncodingTable = $Nodes | Where { $_.Symbol } | Select Symbol, Code | Sort Symbol
    return $EncodingTable
    }

#  Get table for given string
$String = "this is an example for huffman encoding"
$HuffmanEncodingTable = Get-HuffmanEncodingTable $String

#  Display table
$HuffmanEncodingTable | Format-Table -AutoSize

#  Encode string
$EncodedString = $String
ForEach ( $Node in $HuffmanEncodingTable )
    {
    $EncodedString = $EncodedString.Replace( $Node.Symbol, $Node.Code )
    }
$EncodedString


huffman :-
	L = 'this is an example for huffman encoding',
	atom_chars(L, LA),
	msort(LA, LS),
	packList(LS, PL),
	sort(PL, PLS),
	build_tree(PLS, A),
	coding(A, [], C),
	sort(C, SC),
	format('Symbol~t   Weight~t~30|Code~n'),
	maplist(print_code, SC).

build_tree([[V1|R1], [V2|R2]|T], AF) :-
	V is V1 + V2,
	A = [V, [V1|R1], [V2|R2]],
	(   T=[] -> AF=A ;  sort([A|T], NT), build_tree(NT, AF) ).

coding([_A,FG,FD], Code, CF) :-
	(   is_node(FG) ->  coding(FG, [0 | Code], C1)
			 ;  leaf_coding(FG, [0 | Code], C1) ),
	(   is_node(FD) ->  coding(FD, [1 | Code], C2)
			 ;  leaf_coding(FD, [1 | Code], C2) ),
	append(C1, C2, CF).

leaf_coding([FG,FD], Code, CF) :-
	reverse(Code, CodeR),
	CF = [[FG, FD, CodeR]] .

is_node([_V, _FG, _FD]).

print_code([N, Car, Code]):-
	format('~w :~t~w~t~30|', [Car, N]),
	forall(member(V, Code), write(V)),
	nl.

packList([], []).
packList([X], [[1,X]]) :- !.
packList([X|Rest], [XRun|Packed]):-
    run(X, Rest, XRun, RRest),
    packList(RRest, Packed).

run(V, [], [1,V], []).
run(V, [V|LRest], [N1,V], RRest):-
    run(V, LRest, [N, V], RRest),
    N1 is N + 1.
run(V, [Other|RRest], [1,V], [Other|RRest]):-
    dif(V, Other).


OpenConsole()

SampleString.s="this is an example for huffman encoding"
datalen=Len(SampleString)

Structure ztree
  linked.c
  ischar.c
  char.c
  number.l
  left.l
  right.l
EndStructure

Dim memc.c(datalen)
CopyMemory(@SampleString, @memc(0), datalen * SizeOf(Character))

Dim tree.ztree(255)

For i=0 To datalen-1
  tree(memc(i))\char=memc(i)
  tree(memc(i))\number+1
  tree(memc(i))\ischar=1
Next

SortStructuredArray(tree(),#PB_Sort_Descending,OffsetOf(ztree\number),#PB_Integer)

For i=0 To 255
  If tree(i)\number=0
    ReDim tree(i-1)
    Break
  EndIf
Next

dimsize=ArraySize(tree())
Repeat
  min1.l=0
  min2.l=0
  For i=0 To dimsize
    If tree(i)\linked=0
      If tree(i)\number<min1 Or min1=0
        min1=tree(i)\number
        hmin1=i
      ElseIf tree(i)\number<min2 Or min2=0
        min2=tree(i)\number
        hmin2=i
      EndIf
    EndIf
  Next

  If min1=0 Or min2=0
    Break
  EndIf

  dimsize+1
  ReDim tree(dimsize)
  tree(dimsize)\number=tree(hmin1)\number+tree(hmin2)\number
  tree(hmin1)\left=dimsize
  tree(hmin2)\right=dimsize
  tree(hmin1)\linked=1
  tree(hmin2)\linked=1
ForEver

i=0
While tree(i)\ischar=1
  str.s=""
  k=i
  ZNEXT:
  If tree(k)\left<>0
    str="0"+str
    k=tree(k)\left
    Goto ZNEXT
  ElseIf tree(k)\right<>0
    str="1"+str
    k=tree(k)\right
    Goto ZNEXT
  EndIf
  PrintN(Chr(tree(i)\char)+" "+str)
  i+1
Wend
Input()

CloseConsole()


from heapq import heappush, heappop, heapify
from collections import defaultdict

def encode(symb2freq):
    """Huffman encode the given dict mapping symbols to weights"""
    heap = [[wt, [sym, ""]] for sym, wt in symb2freq.items()]
    heapify(heap)
    while len(heap) > 1:
        lo = heappop(heap)
        hi = heappop(heap)
        for pair in lo[1:]:
            pair[1] = '0' + pair[1]
        for pair in hi[1:]:
            pair[1] = '1' + pair[1]
        heappush(heap, [lo[0] + hi[0]] + lo[1:] + hi[1:])
    return sorted(heappop(heap)[1:], key=lambda p: (len(p[-1]), p))

txt = "this is an example for huffman encoding"
symb2freq = defaultdict(int)
for ch in txt:
    symb2freq[ch] += 1
# in Python 3.1+:
# symb2freq = collections.Counter(txt)
huff = encode(symb2freq)
print "Symbol\tWeight\tHuffman Code"
for p in huff:
    print "%s\t%s\t%s" % (p[0], symb2freq[p[0]], p[1])


  [ 2dup peek 1+ unrot poke ]    is itemincr    ( [ n --> [   )

  [ [ 0 128 of ] constant
    swap witheach itemincr
    ' [ i^ join ] map
    ' [ 0 peek ] filter ]        is countchars  (   $ --> [   )

  [ 0 peek dip [ 0 peek ] < ]    is fewerchars  ( [ [ --> b   )

  [ behead rot
    behead rot + unrot
    dip nested nested
    join join ]                  is makenode    ( [ [ --> [   )

  [ [ dup pqsize 1 > while
      frompq dip frompq
      makenode topq again ]
    frompq nip
    0 pluck drop ]               is maketree    (   [ --> [   )

  [ countchars
    pqwith fewerchars
    maketree ]                   is huffmantree (   $ --> [   )

  [ stack ]                      is path.hfl    (     --> s   )

  [ stack ]                      is list.hfl    (     --> s   )

                         forward is makelist    (   [ -->     )
  [ dup size 1 = iff
      [ 0 peek
        path.hfl behead drop
        nested join nested
        list.hfl take
        join
        list.hfl put ] done
    unpack
    1 path.hfl put
    makelist
    0 path.hfl replace
    makelist
    path.hfl release ]     resolves makelist    (   [ -->     )

  [ sortwith
      [ 0 peek swap 0 peek < ] ] is charsort    (   [ --> [   )

  [ [] list.hfl put
    makelist
    list.hfl take
    charsort ]                   is huffmanlist (   [ --> [   )

  [ sortwith
      [ 1 peek size
        swap 1 peek size < ] ]   is codesort    (   [ --> [   )

  [ witheach
      [ unpack swap
         say ' "' emit
         say '" ' echo cr ] ]    is echohuff    (   [ --> [   )

  $ "this is an example for huffman encoding"
  huffmantree
  huffmanlist
  say " Huffman codes sorted by character." cr
  dup echohuff cr
  say " Huffman codes sorted by code length." cr
  codesort echohuff


#lang racket

(require data/heap
         data/bit-vector)

;; A node is either an interior, or a leaf.
;; In either case, they record an item with an associated frequency.
(struct node (freq) #:transparent)
(struct interior node (left right) #:transparent)
(struct leaf node (val) #:transparent)

;; node<=?: node node -> boolean
;; Compares two nodes by frequency.
(define (node<=? x y)
  (<= (node-freq x) (node-freq y)))

;; make-huffman-tree: (listof leaf) -> interior-node
(define (make-huffman-tree leaves)
  (define a-heap (make-heap node<=?))
  (heap-add-all! a-heap leaves)
  (for ([i (sub1 (length leaves))])
    (define min-1 (heap-min a-heap))
    (heap-remove-min! a-heap)
    (define min-2 (heap-min a-heap))
    (heap-remove-min! a-heap)
    (heap-add! a-heap (interior (+ (node-freq min-1) (node-freq min-2))
                                min-1 min-2)))
  (heap-min a-heap))

;; string->huffman-tree: string -> node
;; Given a string, produces its huffman tree.  The leaves hold the characters
;; and their relative frequencies.
(define (string->huffman-tree str)
  (define ht (make-hash))
  (define n (sequence-length str))
  (for ([ch str])
     (hash-update! ht ch add1 (λ () 0)))
  (make-huffman-tree
   (for/list ([(k v) (in-hash ht)])
     (leaf (/ v n) k))))

;; make-encoder: node -> (string -> bit-vector)
;; Given a huffman tree, generates the encoder function.
(define (make-encoder a-tree)
  (define dict (huffman-tree->dictionary a-tree))
  (lambda (a-str)
    (list->bit-vector (apply append (for/list ([ch a-str]) (hash-ref dict ch))))))

;; huffman-tree->dictionary: node -> (hashof val (listof boolean))
;; A helper for the encoder: maps characters to their code sequences.
(define (huffman-tree->dictionary a-node)
  (define ht (make-hash))
  (let loop ([a-node a-node]
             [path/rev '()])
    (cond
      [(interior? a-node)
       (loop (interior-left a-node) (cons #f path/rev))
       (loop (interior-right a-node) (cons #t path/rev))]
      [(leaf? a-node)
        (hash-set! ht (reverse path/rev) (leaf-val a-node))]))

  (for/hash ([(k v) ht])
    (values v k)))

;; make-decoder: interior-node -> (bit-vector -> string)
;; Generates the decoder function from the tree.
(define (make-decoder a-tree)
  (lambda (a-bitvector)
    (define-values (decoded/rev _)
      (for/fold ([decoded/rev '()]
                 [a-node a-tree])
                ([bit a-bitvector])
        (define next-node
          (cond
            [(not bit)
             (interior-left a-node)]
            [else
             (interior-right a-node)]))
        (cond [(leaf? next-node)
               (values (cons (leaf-val next-node) decoded/rev)
                       a-tree)]
              [else
               (values decoded/rev next-node)])))
    (apply string (reverse decoded/rev))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example application:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define msg "this is an example for huffman encoding")

(define tree (string->huffman-tree msg))

;; We can print out the mapping for inspection:
(huffman-tree->dictionary tree)

(define encode (make-encoder tree))
(define encoded (encode msg))

;; Here's what the encoded message looks like:
(bit-vector->string encoded)

(define decode (make-decoder tree))
;; Here's what the decoded message looks like:
(decode encoded)


sub huffman (%frequencies) {
    my @queue = %frequencies.map({ [.value, .key] }).sort;
    while @queue > 1 {
        given @queue.splice(0, 2) -> ([$freq1, $node1], [$freq2, $node2]) {
            @queue = (|@queue, [$freq1 + $freq2, [$node1, $node2]]).sort;
        }
    }
    hash gather walk @queue[0][1], '';
}

multi walk ($node,            $prefix) { take $node => $prefix; }
multi walk ([$node1, $node2], $prefix) { walk $node1, $prefix ~ '0';
                                         walk $node2, $prefix ~ '1'; }


Red [file: %huffy.red]

;; message to encode:
msg: "this is an example for huffman encoding"

;;map to collect leave knots  per uniq character of message
m: make map! []

knot: make object! [
	left: right: none    ;; pointer to left/right sibling
	code: none        ;; first holds char for debugging, later binary code
	count: depth: 1     ;;occurence of character - length of branch
]

;;-----------------------------------------
set-code: func  ["recursive function to generate binary code sequence"
			wknot
			wcode [string!]] [
;;-----------------------------------------
	either wknot/left = none [
		wknot/code:  wcode
	] [
		set-code wknot/left rejoin [wcode "1"]
		set-code wknot/right rejoin [wcode "0"]
	]
]	;;-- end func

;-------------------------------
merge-2knots: func ["function to merge 2 knots into 1 new"
	t [block!]][
;-------------------------------
	nknot: copy knot      ;; create new knot
	nknot/count:  t/1/count + t/2/count
	nknot/right: t/1
	nknot/left: t/2
	nknot/depth: t/1/depth + 1
	tab: remove/part t 2	;; delete first 2 knots
	insert t nknot  ;; insert new generated knot
]	;;-- end func

;; count occurence of characters, save in map: m
foreach chr msg [
	either k:  select/case m chr [
			k/count: k/count + 1
	][
		put/case m chr nknot: copy knot
		nknot/code: chr
	]
]

;; create sortable block (=tab) for use as prio queue
foreach k  keys-of m [	append tab: []  :m/:k ]

;; build tree
while [ 1 <  length? tab][
	sort/compare tab function [a b] [
					a/count  <  b/count
		  or (   a/count = b/count and ( a/depth > b/depth ) )
	]
	merge-2knots tab	;; merge 2 knots with lowest count / max depth
]

set-code tab/1 ""		;; generate binary codes, save at leave knot

;;  display codes
foreach k sort keys-of m [
	print [k " = " m/:k/code]
	append codes: "" m/:k/code
]

;; encode orig message string
foreach chr msg [
	k: select/case m chr
	 append msg-new: ""   k/code
]

print [ "length of encoded msg "  length? msg-new]
print [ "length of (binary) codes "  length? codes ]

print ["orig. message: "  msg newline "encoded message: " "^/" msg-new]
prin "decoded: "

;; decode message (destructive! ):
while [ not empty? msg-new ][
  foreach [k v] body-of   m [
    if  t: find/match msg-new v/code   [
      prin k
      msg-new: t
    ]
  ]
 ]


/* REXX ---------------------------------------------------------------
* 27.12.2013 Walter Pachl
* 29.12.2013 -"- changed for test of s=xrange('00'x,'ff'x)
* 14.03.2018 -"- use format instead of right to diagnose size poblems
* Stem m contains eventually the following node data
* m.i.0id Node id
* m.i.0c  character
* m.i.0o  number of occurrences
* m.i.0l  left child
* m.i.0r  right child
* m.i.0f  father
* m.i.0d  digit (0 or 1)
* m.i.0t  1=a terminal node 0=an intermediate or the top node
*--------------------------------------------------------------------*/
Parse Arg s
If s='' Then
  s='this is an example for huffman encoding'
Say 'We encode this string:'
Say s
debug=0
o.=0
c.=0
codel.=0
code.=''
father.=0
cl=''                                  /* list of characters         */
do i=1 To length(s)
  Call memorize substr(s,i,1)
  End
If debug Then Do
  Do i=1 To c.0
    c=c.i
    Say i c o.c
    End
  End
n.=0
Do i=1 To c.0
  c=c.i
  n.i.0c=c
  n.i.0o=o.c
  n.i.0id=i
  Call dbg i n.i.0id n.i.0c n.i.0o
  End
n=c.0                                  /* number of nodes            */
m.=0
Do i=1 To n                            /* construct initial array    */
  Do j=1 To m.0                        /* sorted by occurrences      */
    If m.j.0o>n.i.0o Then
      Leave
    End
  Do k=m.0 To j By -1
    k1=k+1
    m.k1.0id=m.k.0id
    m.k1.0c =m.k.0c
    m.k1.0o =m.k.0o
    m.k1.0t =m.k.0t
    End
  m.j.0id=i
  m.j.0c =n.i.0c
  m.j.0o =n.i.0o
  m.j.0t =1
  m.0=m.0+1
  End
If debug Then
  Call show

Do While pairs()>1    /* while there are at least 2 fatherless nodes */
  Call mknode         /* create and fill a new father node           */
  If debug Then
    Call show
  End

Call show
c.=0
Do i=1 To m.0       /* now we loop over all lines representing nodes */
  If m.i.0t Then Do   /* for each terminal node                 */
    code=m.i.0d       /* its digit is the last code digit            */
    node=m.i.0id      /* its id                                      */
    Do fi=1 To 1000   /* actually Forever                            */
      fid=father.node           /* id of father                      */
      If fid<>0 Then Do         /* father exists                     */
        fidz=zeile(fid)         /* line that contains the father     */
        code=m.fidz.0d||code    /* prepend the digit                 */
        node=fid                /* look for next father              */
        End
      Else                      /* no father (we reached the top     */
        Leave
      End
    If length(code)>1 Then      /* more than one character in input  */
      code=substr(code,2)       /* remove the the top node's 0       */
    call dbg m.i.0c '->' code   /* character is encoded this way     */
    char=m.i.0c
    code.char=code
    z=codel.0+1
    codel.z=code
    codel.0=z
    char.code=char
    End
  End

Call show_char2code  /* show used characters and corresponding codes */

codes.=0               /* now we build the array of codes/characters */
Do j=1 To codel.0
  z=codes.0+1
  code=codel.j
  codes.z=code
  chars.z=char.code
  codes.0=z
  Call dbg codes.z '----->' chars.z
  End

sc=''                  /* here we ecnode the string                  */
Do i=1 To length(s)    /* loop over input                            */
  c=substr(s,i,1)      /* a character                                */
  sc=sc||code.c        /* append the corresponding code              */
  End
Say 'Length of encoded string:' length(sc)
Do i=1 To length(sc) by 70
  Say substr(sc,i,70)
  End

sr=''                  /* now decode the string                      */
Do si=1 To 999 While sc<>''
  Do i=codes.0 To 1 By -1              /* loop over codes            */
    cl=length(codes.i)                 /* length of code             */
    If left(sc,cl)==codes.i Then Do    /* found on top of string     */
      sr=sr||chars.i                   /* append character to result */
      sc=substr(sc,cl+1)               /* cut off the used code      */
      Leave                            /* this was one character     */
      End
    End
  End
Say 'Input ="'s'"'
Say 'result="'sr'"'

Exit

show:
/*---------------------------------------------------------------------
* show all lines representing node data
*--------------------------------------------------------------------*/
Say '  i   pp  id   c   f   l r d'
Do i=1 To m.0
  Say format(i,3) format(m.i.0o,4) format(m.i.0id,3),
          format(m.i.0f,3) format(m.i.0l,3) format(m.i.0r,3) m.i.0d m.i.0t
  End
Call dbg copies('-',21)
Return

pairs: Procedure Expose m.
/*---------------------------------------------------------------------
* return number of fatherless nodes
*--------------------------------------------------------------------*/
  res=0
  Do i=1 To m.0
    If m.i.0f=0 Then
      res=res+1
    End
  Return res

mknode:
/*---------------------------------------------------------------------
* construct and store a new intermediate or the top node
*--------------------------------------------------------------------*/
new.=0
ni=m.0+1                 /* the next node id                         */
Do i=1 To m.0            /* loop over node lines                     */
  If m.i.0f=0 Then Do    /* a fatherless node                        */
    z=m.i.0id            /* its id                                   */
    If new.0l=0 Then Do  /* new node has no left child               */
      new.0l=z           /* make this the lect child                 */
      new.0o=m.i.0o      /* occurrences                              */
      m.i.0f=ni          /* store father info                        */
      m.i.0d='0'         /* digit 0 to be used                       */
      father.z=ni        /* remember z's father (redundant)          */
      End
    Else Do              /* New node has already left child          */
      new.0r=z           /* make this the right child                */
      new.0o=new.0o+m.i.0o  /* add in the occurrences                */
      m.i.0f=ni          /* store father info                        */
      m.i.0d=1           /* digit 1 to be used                       */
      father.z=ni        /* remember z's father (redundant)          */
      Leave
      End
    End
  End
Do i=1 To m.0            /* Insert new node according to occurrences */
  If m.i.0o>=new.0o Then Do
    Do k=m.0 To i By -1
      k1=k+1
      m.k1.0id=m.k.0id
      m.k1.0o =m.k.0o
      m.k1.0c =m.k.0c
      m.k1.0l =m.k.0l
      m.k1.0r =m.k.0r
      m.k1.0f =m.k.0f
      m.k1.0d =m.k.0d
      m.k1.0t =m.k.0t
      End
    Leave
    End
  End
m.i.0id=ni
m.i.0c ='*'
m.i.0o =new.0o
m.i.0l =new.0l
m.i.0r =new.0r
m.i.0t =0
father.ni=0
m.0=ni
Return

zeile:
/*---------------------------------------------------------------------
* find and return line number containing node-id
*--------------------------------------------------------------------*/
  do fidz=1 To m.0
    If m.fidz.0id=arg(1) Then
      Return fidz
    End
  Call dbg arg(1) 'not found'
  Pull .

dbg:
/*---------------------------------------------------------------------
* Show text if debug is enabled
*--------------------------------------------------------------------*/
  If debug=1 Then
    Say arg(1)
  Return

memorize: Procedure Expose c. o.
/*---------------------------------------------------------------------
* store characters and corresponding occurrences
*--------------------------------------------------------------------*/
  Parse Arg c
  If o.c=0 Then Do
    z=c.0+1
    c.z=c
    c.0=z
    End
  o.c=o.c+1
  Return

show_char2code:
/*---------------------------------------------------------------------
* show used characters and corresponding codes
*--------------------------------------------------------------------*/
cl=xrange('00'x,'ff'x)
Say 'char --> code'
Do While cl<>''
  Parse Var cl c +1 cl
  If code.c<>'' Then
    Say '   'c '-->' code.c
  End
Return


require 'priority_queue'

def huffman_encoding(str)
  char_count = Hash.new(0)
  str.each_char {|c| char_count[c] += 1}

  pq = CPriorityQueue.new
  # chars with fewest count have highest priority
  char_count.each {|char, count| pq.push(char, count)}

  while pq.length > 1
    key1, prio1 = pq.delete_min
    key2, prio2 = pq.delete_min
    pq.push([key1, key2], prio1 + prio2)
  end

  Hash[*generate_encoding(pq.min_key)]
end

def generate_encoding(ary, prefix="")
  case ary
  when Array
    generate_encoding(ary[0], "#{prefix}0") + generate_encoding(ary[1], "#{prefix}1")
  else
    [ary, prefix]
  end
end

def encode(str, encoding)
  str.each_char.collect {|char| encoding[char]}.join
end

def decode(encoded, encoding)
  rev_enc = encoding.invert
  decoded = ""
  pos = 0
  while pos < encoded.length
    key = ""
    while rev_enc[key].nil?
      key << encoded[pos]
      pos += 1
    end
    decoded << rev_enc[key]
  end
  decoded
end

str = "this is an example for huffman encoding"
encoding = huffman_encoding(str)
encoding.to_a.sort.each {|x| p x}

enc = encode(str, encoding)
dec = decode(enc, encoding)
puts "success!" if str == dec


package  {

    import flash.display.GraphicsPathCommand;
    import flash.display.Sprite;
    import flash.text.TextField;
    import flash.text.TextFieldAutoSize;
    import flash.text.TextFormat;

    /**
     * A honeycomb.
     */
    public class Honeycomb extends Sprite {

        /**
         * The sine of 60 degrees.
         *
         * @private
         */
        private static const SIN_60:Number = Math.sin(Math.PI / 3);

        /**
         * The cosine of 60 degrees.
         *
         * @private
         */
        private static const COS_60:Number = Math.cos(Math.PI / 3);

        /**
         * The drawing commands to be passed to Graphics.drawPath()
         *
         * @private
         */
        private static var _gCommands:Vector.<int> = new Vector.<int>(7, true);

        /**
         * The coordinates to be passed to Graphics.drawPath()
         *
         * @private
         */
        private static var _gCoords:Vector.<Number> = new Vector.<Number>(14, true);

        /**
         * The side length of the last honeycomb created.
         */
        private static var _lastSide:Number;

        /**
         * The horizontal space difference (between the leftmost and topmost vertex) of the last hexagon drawn.
         *
         * @private
         */
        private static var _lastHSpace:Number;

        /**
         * The heightof the last hexagon drawn.
         *
         * @private
         */
        private static var _lastHeight:Number;

        {
            _staticInit();
        }

        /**
         * Initialises the Honeycomb class.
         *
         * @private
         */
        private static function _staticInit():void {
            _gCommands[0] = GraphicsPathCommand.MOVE_TO;
            _gCommands[1] = _gCommands[2] = _gCommands[3] = _gCommands[4] = _gCommands[5] = _gCommands[6] = GraphicsPathCommand.LINE_TO;
        }

        /**
         * Calculates the points of the hexagon for a given side length.
         *
         * @param side The length of the side.
         */
        private static function _calculatePoints(side:Number):void {

            var height:Number = side * SIN_60 * 2;
            var hSpace:Number = side * COS_60;

            _gCoords[0] = _gCoords[12] = 0;
            _gCoords[2] = _gCoords[10] = hSpace;
            _gCoords[4] = _gCoords[8] = hSpace + side;
            _gCoords[6] = side + hSpace * 2;

            _gCoords[1] = _gCoords[7] = _gCoords[13] = height / 2;
            _gCoords[3] = _gCoords[5] = height;
            _gCoords[9] = _gCoords[11] = 0;

            _lastSide = side;
            _lastHSpace = hSpace;
            _lastHeight = height;

        }

        /**
         * The side length of the honeycomb.
         *
         * @private
         */
        private var _side:Number;

        /**
         * The text field displaying the character in the honeycomb.
         *
         * @private
         */
        private var _text:TextField;

        /**
         * The character code of the character in the honeycomb.
         *
         * @private
         */
        private var _charCode:uint;

        /**
         * Whether the honeycomb has been activated (i.e. the activate() method has been called).
         *
         * @private
         */
        private var _activated:Boolean = false;

        /**
         * Creates a new Honeycomb object.
         *
         * @param side The length of the side of the honeycomb.
         * @param fill The honeycomb's fill colour.
         * @param letter The character code of the letter to be displayed in the honeycomb.
         * @param textColour The colour of the letter displayed inside the honeycomb.
         */
        public function Honeycomb(side:Number, fill:uint, letter:uint, textColour:uint) {
            _init(side, fill, letter, textColour);
        }

        /**
         * Initialises the Honeycomb object.
         *
         * @param side The length of the side of the honeycomb.
         * @param fill The honeycomb's fill colour.
         * @param letter The character code of the letter to be displayed in the honeycomb.
         * @param textColour The colour of the letter displayed inside the honeycomb.
         */
        private function _init(side:Number, fill:uint, letter:uint, textColour:uint):void {

            mouseChildren = false;
            buttonMode = true;
            useHandCursor = false;

            graphics.beginFill(fill);
            graphics.lineStyle(3, 0x000000);

            if ( side != _lastSide )
                _calculatePoints(side);

            _side = side;
            _charCode = letter;

            graphics.drawPath(_gCommands, _gCoords);

            _text = new TextField();
            _text.autoSize = TextFieldAutoSize.CENTER;
            _text.defaultTextFormat = new TextFormat('_sans', side * 1.2, textColour, true);
            _text.text = String.fromCharCode(letter);
            _text.x = (side + _lastHSpace * 2 - _text.width) / 2;
            _text.y = (_lastHeight - _text.height) / 2;

            addChild(_text);

        }

        /**
         * The character code of the character in the honeycomb.
         */
        public function get charCode():uint {
            return _charCode;
        }

        /**
         * Whether the honeycomb has been activated (i.e. the activate() method has been called).
         */
        public function get activated():Boolean {
            return _activated;
        }

        /**
         * Activates the honeycomb and changes its colour.
         *
         * @param backColour The new fill colour of the honeycomb.
         * @param textColour The new text colour of the honeycomb.
         */
        public function activate(backColour:uint, textColour:uint):void {

            if ( _side != _lastSide )
                _calculatePoints(_side);

            graphics.beginFill(backColour);
            graphics.drawPath(_gCommands, _gCoords);

            var textFormat:TextFormat = _text.getTextFormat();
            textFormat.color = textColour;
            _text.setTextFormat(textFormat);

            _activated = true;

        }

    }

}


use std::collections::BTreeMap;
use std::collections::binary_heap::BinaryHeap;

#[derive(Debug, Eq, PartialEq)]
enum NodeKind {
    Internal(Box<Node>, Box<Node>),
    Leaf(char),
}

#[derive(Debug, Eq, PartialEq)]
struct Node {
    frequency: usize,
    kind: NodeKind,
}

impl Ord for Node {
    fn cmp(&self, rhs: &Self) -> std::cmp::Ordering {
        rhs.frequency.cmp(&self.frequency)
    }
}

impl PartialOrd for Node {
    fn partial_cmp(&self, rhs: &Self) -> Option<std::cmp::Ordering> {
        Some(self.cmp(&rhs))
    }
}

type HuffmanCodeMap = BTreeMap<char, Vec<u8>>;

fn main() {
    let text = "this is an example for huffman encoding";

    let mut frequencies = BTreeMap::new();
    for ch in text.chars() {
        *frequencies.entry(ch).or_insert(0) += 1;
    }

    let mut prioritized_frequencies = BinaryHeap::new();
    for counted_char in frequencies {
        prioritized_frequencies.push(Node {
            frequency: counted_char.1,
            kind: NodeKind::Leaf(counted_char.0),
        });
    }

    while prioritized_frequencies.len() > 1 {
        let left_child = prioritized_frequencies.pop().unwrap();
        let right_child = prioritized_frequencies.pop().unwrap();
        prioritized_frequencies.push(Node {
            frequency: right_child.frequency + left_child.frequency,
            kind: NodeKind::Internal(Box::new(left_child), Box::new(right_child)),
        });
    }

    let mut codes = HuffmanCodeMap::new();
    generate_codes(
        prioritized_frequencies.peek().unwrap(),
        vec![0u8; 0],
        &mut codes,
    );

    for item in codes {
        print!("{}: ", item.0);
        for bit in item.1 {
            print!("{}", bit);
        }
        println!();
    }
}

fn generate_codes(node: &Node, prefix: Vec<u8>, out_codes: &mut HuffmanCodeMap) {
    match node.kind {
        NodeKind::Internal(ref left_child, ref right_child) => {
            let mut left_prefix = prefix.clone();
            left_prefix.push(0);
            generate_codes(&left_child, left_prefix, out_codes);

            let mut right_prefix = prefix;
            right_prefix.push(1);
            generate_codes(&right_child, right_prefix, out_codes);
        }
        NodeKind::Leaf(ch) => {
            out_codes.insert(ch, prefix);
        }
    }
}


object Huffman {
  import scala.collection.mutable.{Map, PriorityQueue}

  sealed abstract class Tree
  case class Node(left: Tree, right: Tree) extends Tree
  case class Leaf(c: Char) extends Tree

  def treeOrdering(m: Map[Tree, Int]) = new Ordering[Tree] {
     def compare(x: Tree, y: Tree) = m(y).compare(m(x))
  }

  def stringMap(text: String) = text groupBy (x => Leaf(x) : Tree) mapValues (_.length)

  def buildNode(queue: PriorityQueue[Tree], map: Map[Tree,Int]) {
    val right = queue.dequeue
    val left = queue.dequeue
    val node = Node(left, right)
    map(node) = map(left) + map(right)
    queue.enqueue(node)
  }

  def codify(tree: Tree, map: Map[Tree, Int]) = {
    def recurse(tree: Tree, prefix: String): List[(Char, (Int, String))] = tree match {
      case Node(left, right) => recurse(left, prefix+"0") ::: recurse(right, prefix+"1")
      case leaf @ Leaf(c) => c -> ((map(leaf), prefix)) :: Nil
    }
    recurse(tree, "")
  }

  def encode(text: String) = {
    val map = Map.empty[Tree,Int] ++= stringMap(text)
    val queue = new PriorityQueue[Tree]()(treeOrdering(map)) ++= map.keysIterator

    while(queue.size > 1) {
      buildNode(queue, map)
    }
    codify(queue.dequeue, map)
  }

  def main(args: Array[String]) {
    val text = "this is an example for huffman encoding"
    val code = encode(text)
    println("Char\tWeight\t\tEncoding")
    code sortBy (_._2._1) foreach {
      case (c, (weight, encoding)) => println("%c:\t%3d/%-3d\t\t%s" format (c, weight, text.length, encoding))
    }
  }
}


with Ada.Numerics.Elementary_Functions;
with Ada.Numerics.Discrete_Random;

with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Video.Surfaces;
with SDL.Video.Rectangles;
with SDL.TTFs.Makers;
with SDL.Events.Events;
with SDL.Events.Keyboards;
with SDL.Events.Mice;

procedure Honeycombs is
   use SDL.Video.Rectangles;
   use SDL.C;

   Width    : constant := 560;
   Height   : constant := 595;
   Offset_X : constant := 10.0;
   Offset_Y : constant := 40.0;
   Radius   : constant := 60.0;
   Rows     : constant := 4;
   Cols     : constant := 5;
   TTF_File : constant String := "NotoSans-Bold.ttf";
   TTF_Size_Cell : constant   := 72;
   TTF_Size_Sum  : constant   := 38;
   Offset_Sum_X  : constant   := 35;
   Offset_Sum_Y  : constant   := 530;

   type Node_Id    is mod 6;
   type Shape_List is array (Node_Id) of Point;

   type Cell_Info is record
      Center : Point;
      Marked : Boolean;
      Label  : String (1 .. 1);
   end record;
   type Cell_List  is array (Positive range <>) of Cell_Info;

   function Make_Shape return Shape_List is
      use Ada.Numerics.Elementary_Functions;
      Shape : Shape_List;
   begin
      for I in Shape'Range loop
         Shape (I) := (X => int (Radius * Cos (Float (I), Cycle => 6.0)),
                       Y => int (Radius * Sin (Float (I), Cycle => 6.0)));
      end loop;
      return Shape;
   end Make_Shape;

   function Make_Cells (Rows, Cols : in Positive) return Cell_List is
      subtype Label_Type is Character range 'A' .. 'Z';
      package Randoms is new Ada.Numerics.Discrete_Random (Label_Type);
      use Randoms;
      Y_Scale : constant Float := Ada.Numerics.Elementary_Functions.Sqrt (3.0);
      List    : Cell_List (1 .. Rows * Cols);
      Info    : Cell_Info;
      Gen     : Generator;
   begin
      Reset (Gen);
      for R in 1 .. Rows loop
         for C in 1 .. Cols loop
            Info.Center.X := int (Offset_X + Radius * 1.5 * Float (C));
            Info.Center.Y := int (Offset_Y + Radius * Y_Scale * (Float (R) -
                                                                   Float (C mod 2) / 2.0));
            Info.Marked    := False;
            Info.Label (1) := Random (Gen);
            List ((R - 1) * Cols + C) := Info;
         end loop;
      end loop;
      return List;
   end Make_Cells;

   Window    : SDL.Video.Windows.Window;
   Win_Surf  : SDL.Video.Surfaces.Surface;
   Renderer  : SDL.Video.Renderers.Renderer;
   Font_Cell : SDL.TTFs.Fonts;
   Font_Sum  : SDL.TTFs.Fonts;

   Cells     :           Cell_List := Make_Cells (Rows, Cols);
   Shape     : constant Shape_List := Make_Shape;
   Sum_Text  : String (1 .. Rows * Cols);
   Sum_Last  : Natural := Sum_Text'First - 1;

   function Orient_2D (A, B, C : Point) return int is
      ((B.X - A.X) * (C.Y - A.Y) - (B.Y - A.Y) * (C.X - A.X));

   function "+" (Left, Right : Point) return Point is
      ((Left.X + Right.X, Left.Y + Right.Y));

   function Inside (P : Point; Cell : Cell_Info) return Boolean is
      Count : Natural := 0;
   begin
      for Node in Shape'Range loop
         Count := Count +
           (if Orient_2D (Cell.Center + Shape (Node),
                          Cell.Center + Shape (Node + 1),
                          P) > 0 then 1 else 0);
      end loop;
      return Count = 6;
   end Inside;

   procedure Draw (Cell : Cell_Info) is
      Surface     : constant SDL.Video.Surfaces.Surface :=
        Font_Cell.Render_Solid (Cell.Label, (30, 230, 230, 255));
      Self_Area   : SDL.Video.Rectangles.Rectangle;
      Source_Area : SDL.Video.Rectangles.Rectangle := (0, 0, 0, 0);
   begin
      --  Fill
      for Y in int (-Radius) .. int (Radius) loop
         for X in int (-Radius) .. int (Radius) loop
            if Inside (Cell.Center + (X, Y), Cell) then
               Renderer.Draw (Point => Cell.Center + (X, Y));
            end if;
         end loop;
      end loop;

      --  Label
      Self_Area := (Cell.Center.X - Surface.Size.Width  / 2,
                    Cell.Center.Y - Surface.Size.Height / 2, 0, 0);
      Win_Surf.Blit (Self_Area, Surface, Source_Area);

      --  Outline
      Renderer.Set_Draw_Colour ((0, 0, 0, 255));
      for Id in Shape'Range loop
         Renderer.Draw (Line => (Cell.Center + Shape (Id),
                                 Cell.Center + Shape (Id + 1)));
      end loop;
   end Draw;

   procedure Find_And_Mark (Click : Point; Key : String) is
      Self_Area   : SDL.Video.Rectangles.Rectangle;
      Source_Area : SDL.Video.Rectangles.Rectangle := (0, 0, 0, 0);
   begin
      for Cell of Cells loop
         if not Cell.Marked and then (Inside (Click, Cell) or Cell.Label = Key) then
            Cell.Marked         := True;
            Sum_Last            := Sum_Last + 1;
            Sum_Text (Sum_Last) := Cell.Label (1);
            Renderer.Set_Draw_Colour ((230, 20, 220, 255));
            Draw (Cell);

            --  Update sum text
            Self_Area := (Offset_Sum_X, Offset_Sum_Y, 0, 0);
            Win_Surf.Blit
              (Self_Area, Font_Sum.Render_Solid (Sum_Text (Sum_Text'First .. Sum_Last),
                                                 (0, 200, 200, 255)), Source_Area);
            Window.Update_Surface;
            exit;
         end if;
      end loop;
   end Find_And_Mark;

   procedure Wait is
      use type SDL.Events.Event_Types;
      use SDL.Events.Keyboards;
      Event : SDL.Events.Events.Events;
   begin
      loop
         SDL.Events.Events.Wait (Event);
         case Event.Common.Event_Type is
            when SDL.Events.Quit => return;
            when SDL.Events.Mice.Button_Down =>
               Find_And_Mark
                 ((Event.Mouse_Button.X,
                   Event.Mouse_Button.Y), "");
            when SDL.Events.Keyboards.Key_Down =>
               Find_And_Mark
                 ((0, 0), Image (Event.Keyboard.Key_Sym.Key_Code));
               null;
            when others => null;
         end case;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;
   if not SDL.TTFs.Initialise then
      null;
   end if;
   SDL.TTFs.Makers.Create (Font_Cell, TTF_File, TTF_Size_Cell);
   SDL.TTFs.Makers.Create (Font_Sum,  TTF_File, TTF_Size_Sum);

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Honeycombs",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   Win_Surf := Window.Get_Surface;
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));

   for Cell of Cells loop
      Renderer.Set_Draw_Colour ((230, 230, 0, 255));
      Draw (Cell);
   end loop;
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Honeycombs;


(define (char-freq port table)
  (if
   (eof-object? (peek-char port))
   table
   (char-freq port (add-char (read-char port) table))))

(define (add-char char table)
  (cond
   ((null? table) (list (list char 1)))
   ((eq? (caar table) char) (cons (list char (+ (cadar table) 1)) (cdr table)))
   (#t (cons (car table) (add-char char (cdr table))))))

(define (nodeify table)
  (map (lambda (x) (list x '() '())) table))

(define node-freq cadar)

(define (huffman-tree nodes)
  (let ((queue (sort nodes (lambda (x y) (< (node-freq x) (node-freq y))))))
    (if
     (null? (cdr queue))
     (car queue)
     (huffman-tree
      (cons
       (list
        (list 'notleaf (+ (node-freq (car queue)) (node-freq (cadr queue))))
        (car queue)
        (cadr queue))
       (cddr queue))))))

(define (list-encodings tree chars)
  (for-each (lambda (c) (format #t "~a:~a~%" c (encode c tree))) chars))

(define (encode char tree)
  (cond
   ((null? tree) #f)
   ((eq? (caar tree) char) '())
   (#t
    (let ((left (encode char (cadr tree))) (right (encode char (caddr tree))))
      (cond
       ((not (or left right)) #f)
       (left (cons #\1 left))
       (right (cons #\0 right)))))))

(define (decode digits tree)
  (cond
   ((not (eq? (caar tree) 'notleaf)) (caar tree))
   ((eq? (car digits) #\0) (decode (cdr digits) (cadr tree)))
   (#t (decode (cdr digits) (caddr tree)))))

(define input "this is an example for huffman encoding")
(define freq-table (char-freq (open-input-string input) '()))
(define tree (huffman-tree (nodeify freq-table)))
(list-encodings tree (map car freq-table))


Columns := 5							; cater for a different number of columns
hexPerCol := 4							; cater for a different number of hexagons
size := 40

w := sqrt(3) * size
h := 2 * size
Coord := [], Chosen := [], Seq:= ""
Letters := StrSplit("ABCDEFGHIJKLMNOPQRSTUVWXYZ")
x := A_ScreenWidth/2  - w*(Columns/2) + w/2
y := A_ScreenHeight/2 - h*(hexPerCol/2) + h/2
x1:= x, y1:=y

Gdip()
; Draw High Columns
loop % Ceil(Columns/2)
{
	col := A_Index
	loop % hexPerCol
	{
		Random, rnd, 1, % Letters.count()
		letter := Letters.RemoveAt(rnd)
		Draw_Hexagon(x,y,size,Letter)
		y += sqrt(3) * size
	}
	x:=x1, y:=y1
	x+= col*3*size
}

; Draw Low Columns
x:= x1, y:=y1
x+= size*1.5, y += sqrt(3) * size/2
loop % Floor(Columns/2)
{
	col := A_Index
	loop % hexPerCol
	{
		Random, rnd, 1, % Letters.count()
		letter := Letters.RemoveAt(rnd)
		Draw_Hexagon(x,y,size,Letter)
		y += sqrt(3) * size
	}
	x:=x1, y:=y1
	x+= size*1.5,	y += sqrt(3) * size/2
	x+= col*3*size
}
OnExit, Exit
Return
;---------------------------------------------------------------
~LButton::
CoordMode, Mouse, Screen
MouseGetPos, mx, my, mc, mw
if (mc <> hwnd1)
	return
minD := []
for L, c in coord
{
	x := c.x
	y := c.y
	D := Sqrt((x-mx)**2 + (y-my)**2)
	minD[D] := L
	min := A_Index = 1 ? D : min < D ? min : D
}
thisLetter := minD[min]
gosub SelectHex
return;
;---------------------------------------------------------------
KeyPress:
thisLetter := A_ThisHotkey
gosub, SelectHex
return
;---------------------------------------------------------------
SelectHex:
if Chosen[thisLetter]
	return
Chosen[thisLetter] := true					; record of chosen letters
Seq .= thisLetter						; record of the chosen letters in order chosed
pBrush := Gdip_BrushCreateSolid(0xFFFF00FF)
x := coord[thisLetter, "x"]
y := coord[thisLetter, "y"]
Draw_Hexagon(x,y,size,thisLetter, "FF000000")
Progress, % "m2 b fs16 zh0 y0 w400 x" A_ScreenWidth/2-200, % Seq,,, Courier New
if (Chosen.Count() = Columns * hexPerCol)
	ExitApp
return
;---------------------------------------------------------------
Draw_Hexagon(x,y,size,Letter,TextColor:="FFFF0000"){
	global
	deg2rad := 3.141592653589793/180
	a := x + Size "," y
	b := x+ Size*Cos(60*deg2rad) "," y + Size*Sin(60*deg2rad)
	c := x+ Size*Cos(120*deg2rad) "," y + Size*Sin(120*deg2rad)
	d := x - Size "," y
	e := x+ Size*Cos(240*deg2rad) "," y + Size*Sin(240*deg2rad)
	f := x+ Size*Cos(300*deg2rad) "," y + Size*Sin(300*deg2rad)
	Gdip_FillPolygon(G, pBrush, a "|" b "|" c "|" d "|" e "|" f)
	Gdip_DrawLines(G, pPen, a "|" b "|" c "|" d "|" e "|" f "|" a)
	Font := "Arial", Gdip_FontFamilyCreate(Font)
	Options := "x" x-size/2 " y" y-size/2 "c" TextColor " Bold s" size
	Gdip_TextToGraphics(G, Letter, Options, Font)
	UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
	Hotkey, % letter, KeyPress
	Coord[letter, "x"] := x
	Coord[letter, "y"] := y
}
;---------------------------------------------------------------
gdip(){
	global
	Gdip_Startup()
	Width := A_ScreenWidth, Height := A_ScreenHeight
	Gui, 1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
	Gui, 1: Show, NA
	hwnd1 := WinExist()
	hbm := CreateDIBSection(Width, Height)
	hdc := CreateCompatibleDC()
	obm := SelectObject(hdc, hbm)
	G := Gdip_GraphicsFromHDC(hdc)
	Gdip_SetSmoothingMode(G, 4)
	pBrush := Gdip_BrushCreateSolid(0xFFFFFF00)
	pPen := Gdip_CreatePen(0xFF000000, 3)
}
;---------------------------------------------------------------
Exit:
Gdip_DeleteBrush(pBrush)
Gdip_DeletePen(pPen)
SelectObject(hdc, obm)
DeleteObject(hbm)
DeleteDC(hdc)
Gdip_DeleteGraphics(G)
Gdip_Shutdown(pToken)
ExitApp
Return
;---------------------------------------------------------------


var forest := {}, encTab := {};

plaintext := 'this is an example for huffman encoding';

ft := {};
(for c in plaintext)
  ft(c) +:= 1;
end;

forest := {[f, c]: [c, f] in ft};
(while 1 < #forest)
  [f1, n1] := getLFN();
  [f2, n2] := getLFN();
  forest with:= [f1+f2, [n1,n2]];
end;
addToTable('', arb range forest);

(for e = encTab(c))
  print(c, ft(c), e);
end;

print(+/ [encTab(c): c in plaintext]);

proc addToTable(prefix, node);
  if is_tuple node then
    addToTable(prefix + '0', node(1));
    addToTable(prefix + '1', node(2));
  else
    encTab(node) := prefix;
  end;
end proc;

proc getLFN();
  f := min/ domain forest;
  n := arb forest{f};
  forest less:= [f, n];
  return [f, n];
end proc;


func walk(n, s, h) {
    if (n.contains(:a)) {
        h{n{:a}} = s
        say "#{n{:a}}: #{s}"
        return nil
    }
    walk(n{:0}, s+'0', h)
    walk(n{:1}, s+'1', h)
}

func make_tree(text) {
    var letters = Hash()
    text.each { |c| letters{c} := 0 ++ }
    var nodes = letters.keys.map { |l|
        Hash(a => l, freq => letters{l})
    }

    var n = Hash()
    while (nodes.sort_by!{|c| c{:freq} }.len > 1) {
        n = Hash(:0 => nodes.shift, :1 => nodes.shift)
        n{:freq} = (n{:0}{:freq} + n{:1}{:freq})
        nodes.append(n)
    }

    walk(n, "", n{:tree} = Hash())
    return n
}

func encode(s, t) {
    t = t{:tree}
    s.chars.map{|c| t{c} }.join
}

func decode (enc, tree) {
    var n = tree
    var out = ""

    enc.each {|bit|
        n = n{bit}
        if (n.contains(:a)) {
            out += n{:a}
            n = tree
        }
    }

    return out
}

var text = "this is an example for huffman encoding"
var tree = make_tree(text)
var enc = encode(text, tree)

say enc
say decode(enc, tree)


      ALTERNATE = 1
      VDU 23,22,252;252;8,16,16,128
      *FONT Arial,24,B

      Letters$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
      Letters% = !^Letters$
      FOR i% = 0 TO 24
        SWAP Letters%?i%, Letters%?(i%+RND(26-i%)-1)
      NEXT

      DIM xpos%(20), ypos%(20), hrgn%(20)
      C% = 1
      FOR Y% = 36 TO 192 STEP 52
        FOR X% = 35 TO 215 STEP 90
          xpos%(C%) = X%
          ypos%(C%) = Y%
          C% += 1
        NEXT
        FOR X% = 80 TO 170 STEP 90
          xpos%(C%) = X%
          ypos%(C%) = Y%+26
          C% += 1
        NEXT
      NEXT

      REM Plot the hexagons:
      FOR C% = 1 TO 20
        hrgn%(C%) = FNplothexagon(xpos%(C%), ypos%(C%), &00FFFF, \
        \           MID$(Letters$,C%,1), &0000FF)
      NEXT
      SYS "InvalidateRect", @hwnd%, 0, 0

      REM Initialise word selected:
      Word$ = ""

      REM Monitor mouse clicks:
      ON MOUSE PROCmouse(@wparam%,@lparam%) : RETURN

      REM Monitor keypresses:
      REPEAT
        key$ = INKEY$(1)
        IF key$ >= "a" key$ = CHR$(ASCkey$-32)
        C% = INSTR(Letters$, key$)
        IF C% IF C%<21 IF hrgn%(C%) PROCselect(C%)
      UNTIL FALSE
      END

      REM Select a hexagon with the keyboard or mouse:
      DEF PROCselect(C%)
      hrgn%(C%) = 0 * FNplothexagon(xpos%(C%), ypos%(C%), &FF00FF, \
      \               MID$(Letters$,C%,1), &000000)
      SYS "InvalidateRect", @hwnd%, 0, 0
      Word$ += MID$(Letters$, C%, 1)
      SYS "SetWindowText", @hwnd%, Word$
      ENDPROC

      DEF PROCmouse(W%, L%)
      LOCAL C%, R%
      IF W%<>1 ENDPROC
      FOR C% = 1 TO 20
        SYS "PtInRegion", hrgn%(C%), L% AND &FFFF, L% >>> 16 TO R%
        IF R% PROCselect(C%)
      NEXT
      ENDPROC

      DEF FNplothexagon(x%, y%, hcol%, text$, tcol%)
      LOCAL brush%, pen%, hrgn%, pt%(), size{}
      DIM pt%(5,1), size{dx%,dy%}
      pt%() = x%-30,y%,x%-15,y%+26,x%+15,y%+26,x%+30,y%,x%+15,y%-26,x%-15,y%-26
      SYS "CreatePen", 0, 3, 0 TO pen%
      SYS "CreateSolidBrush", hcol% TO brush%
      SYS "SelectObject", @memhdc%, pen% TO pen%
      SYS "SelectObject", @memhdc%, brush% TO brush%
      SYS "Polygon", @memhdc%, ^pt%(0,0), 6
      SYS "SelectObject", @memhdc%, pen% TO pen%
      SYS "SelectObject", @memhdc%, brush% TO brush%
      SYS "DeleteObject", pen%
      SYS "DeleteObject", brush%
      SYS "GetTextExtentPoint32", @memhdc%, text$, LEN(text$), size{}
      SYS "SetTextColor", @memhdc%, tcol%
      SYS "SetBkColor", @memhdc%, hcol%
      SYS "TextOut", @memhdc%, x%-size.dx%/2, y%-size.dy%/2, text$, LEN(text$)
      SYS "CreatePolygonRgn", ^pt%(0,0), 6, ALTERNATE TO hrgn%
      = hrgn%