Data update

Task/Huffman-coding/Ada/huffman-coding-1.adb

@@ -0,0 +1,83 @@
+with Ada.Containers.Indefinite_Ordered_Maps;
+with Ada.Containers.Ordered_Maps;
+with Ada.Finalization;
+generic
+   type Symbol_Type is private;
+   with function "<" (Left, Right : Symbol_Type) return Boolean is <>;
+   with procedure Put (Item : Symbol_Type);
+   type Symbol_Sequence is array (Positive range <>) of Symbol_Type;
+   type Frequency_Type is private;
+   with function "+" (Left, Right : Frequency_Type) return Frequency_Type
+     is <>;
+   with function "<" (Left, Right : Frequency_Type) return Boolean is <>;
+package Huffman is
+   -- bits = booleans (true/false = 1/0)
+   type Bit_Sequence is array (Positive range <>) of Boolean;
+   Zero_Sequence : constant Bit_Sequence (1 .. 0) := (others => False);
+   -- output the sequence
+   procedure Put (Code : Bit_Sequence);
+
+   -- type for freqency map
+   package Frequency_Maps is new Ada.Containers.Ordered_Maps
+     (Element_Type => Frequency_Type,
+      Key_Type     => Symbol_Type);
+
+   type Huffman_Tree is private;
+   -- create a huffman tree from frequency map
+   procedure Create_Tree
+     (Tree        : out Huffman_Tree;
+      Frequencies : Frequency_Maps.Map);
+   -- encode a single symbol
+   function Encode
+     (Tree   : Huffman_Tree;
+      Symbol : Symbol_Type)
+      return   Bit_Sequence;
+   -- encode a symbol sequence
+   function Encode
+     (Tree    : Huffman_Tree;
+      Symbols : Symbol_Sequence)
+      return    Bit_Sequence;
+   -- decode a bit sequence
+   function Decode
+     (Tree : Huffman_Tree;
+      Code : Bit_Sequence)
+      return Symbol_Sequence;
+   -- dump the encoding table
+   procedure Dump_Encoding (Tree : Huffman_Tree);
+private
+   -- type for encoding map
+   package Encoding_Maps is new Ada.Containers.Indefinite_Ordered_Maps
+     (Element_Type => Bit_Sequence,
+      Key_Type     => Symbol_Type);
+
+   type Huffman_Node;
+   type Node_Access is access Huffman_Node;
+   -- a node is either internal (left_child/right_child used)
+   -- or a leaf (left_child/right_child are null)
+   type Huffman_Node is record
+      Frequency   : Frequency_Type;
+      Left_Child  : Node_Access := null;
+      Right_Child : Node_Access := null;
+      Symbol      : Symbol_Type;
+   end record;
+   -- create a leaf node
+   function Create_Node
+     (Symbol    : Symbol_Type;
+      Frequency : Frequency_Type)
+      return      Node_Access;
+   -- create an internal node
+   function Create_Node (Left, Right : Node_Access) return Node_Access;
+   -- fill the encoding map
+   procedure Fill
+     (The_Node : Node_Access;
+      Map      : in out Encoding_Maps.Map;
+      Prefix   : Bit_Sequence);
+
+   -- huffman tree has a tree and an encoding map
+   type Huffman_Tree is new Ada.Finalization.Controlled with record
+      Tree : Node_Access       := null;
+      Map  : Encoding_Maps.Map := Encoding_Maps.Empty_Map;
+   end record;
+   -- free memory after finalization
+   overriding procedure Finalize (Object : in out Huffman_Tree);
+end Huffman;

Task/Huffman-coding/Ada/huffman-coding-2.adb

@@ -0,0 +1,244 @@
+with Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with Ada.Containers.Vectors;
+package body Huffman is
+   package Node_Vectors is new Ada.Containers.Vectors
+     (Element_Type => Node_Access,
+      Index_Type   => Positive);
+
+   function "<" (Left, Right : Node_Access) return Boolean is
+   begin
+      -- compare frequency
+      if Left.Frequency < Right.Frequency then
+         return True;
+      elsif Right.Frequency < Left.Frequency then
+         return False;
+      end if;
+      -- same frequency, choose leaf node
+      if Left.Left_Child = null and then Right.Left_Child /= null then
+         return True;
+      elsif Left.Left_Child /= null and then Right.Left_Child = null then
+         return False;
+      end if;
+      -- same frequency, same node type (internal/leaf)
+      if Left.Left_Child /= null then
+         -- for internal nodes, compare left children, then right children
+         if Left.Left_Child < Right.Left_Child then
+            return True;
+         elsif Right.Left_Child < Left.Left_Child then
+            return False;
+         else
+            return Left.Right_Child < Right.Right_Child;
+         end if;
+      else
+         -- for leaf nodes, compare symbol
+         return Left.Symbol < Right.Symbol;
+      end if;
+   end "<";
+   package Node_Vector_Sort is new Node_Vectors.Generic_Sorting;
+
+   procedure Create_Tree
+     (Tree        : out Huffman_Tree;
+      Frequencies : Frequency_Maps.Map) is
+      Node_Queue : Node_Vectors.Vector := Node_Vectors.Empty_Vector;
+   begin
+      -- insert all leafs into the queue
+      declare
+         use Frequency_Maps;
+         Position : Cursor      := Frequencies.First;
+         The_Node : Node_Access := null;
+      begin
+         while Position /= No_Element loop
+            The_Node :=
+              Create_Node
+                (Symbol    => Key (Position),
+                 Frequency => Element (Position));
+            Node_Queue.Append (The_Node);
+            Next (Position);
+         end loop;
+      end;
+      -- sort by frequency (see "<")
+      Node_Vector_Sort.Sort (Node_Queue);
+      -- iterate over all elements
+      while not Node_Queue.Is_Empty loop
+         declare
+            First : constant Node_Access := Node_Queue.First_Element;
+         begin
+            Node_Queue.Delete_First;
+            -- if we only have one node left, it is the root node of the tree
+            if Node_Queue.Is_Empty then
+               Tree.Tree := First;
+            else
+               -- create new internal node with two smallest frequencies
+               declare
+                  Second : constant Node_Access := Node_Queue.First_Element;
+               begin
+                  Node_Queue.Delete_First;
+                  Node_Queue.Append (Create_Node (First, Second));
+               end;
+               Node_Vector_Sort.Sort (Node_Queue);
+            end if;
+         end;
+      end loop;
+      -- fill encoding map
+      Fill (The_Node => Tree.Tree, Map => Tree.Map, Prefix => Zero_Sequence);
+   end Create_Tree;
+
+   -- create leaf node
+   function Create_Node
+     (Symbol    : Symbol_Type;
+      Frequency : Frequency_Type)
+      return      Node_Access
+   is
+      Result : Node_Access := new Huffman_Node;
+   begin
+      Result.Frequency := Frequency;
+      Result.Symbol    := Symbol;
+      return Result;
+   end Create_Node;
+
+   -- create internal node
+   function Create_Node (Left, Right : Node_Access) return Node_Access is
+      Result : Node_Access := new Huffman_Node;
+   begin
+      Result.Frequency   := Left.Frequency + Right.Frequency;
+      Result.Left_Child  := Left;
+      Result.Right_Child := Right;
+      return Result;
+   end Create_Node;
+
+   -- fill encoding map
+   procedure Fill
+     (The_Node : Node_Access;
+      Map      : in out Encoding_Maps.Map;
+      Prefix   : Bit_Sequence) is
+   begin
+      if The_Node.Left_Child /= null then
+         -- append false (0) for left child
+         Fill (The_Node.Left_Child, Map, Prefix & False);
+         -- append true (1) for right child
+         Fill (The_Node.Right_Child, Map, Prefix & True);
+      else
+         -- leaf node reached, prefix = code for symbol
+         Map.Insert (The_Node.Symbol, Prefix);
+      end if;
+   end Fill;
+
+   -- free memory after finalization
+   overriding procedure Finalize (Object : in out Huffman_Tree) is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Name   => Node_Access,
+         Object => Huffman_Node);
+      -- recursively free all nodes
+      procedure Recursive_Free (The_Node : in out Node_Access) is
+      begin
+         -- free node if it is a leaf
+         if The_Node.Left_Child = null then
+            Free (The_Node);
+         else
+            -- free left and right child if node is internal
+            Recursive_Free (The_Node.Left_Child);
+            Recursive_Free (The_Node.Right_Child);
+            -- free node afterwards
+            Free (The_Node);
+         end if;
+      end Recursive_Free;
+   begin
+      -- recursively free root node
+      Recursive_Free (Object.Tree);
+   end Finalize;
+
+   -- encode single symbol
+   function Encode
+     (Tree   : Huffman_Tree;
+      Symbol : Symbol_Type)
+      return   Bit_Sequence
+   is
+   begin
+      -- simply lookup in map
+      return Tree.Map.Element (Symbol);
+   end Encode;
+
+   -- encode symbol sequence
+   function Encode
+     (Tree    : Huffman_Tree;
+      Symbols : Symbol_Sequence)
+      return    Bit_Sequence
+   is
+   begin
+      -- only one element
+      if Symbols'Length = 1 then
+         -- see above
+         return Encode (Tree, Symbols (Symbols'First));
+      else
+         -- encode first element, append result of recursive call
+         return Encode (Tree, Symbols (Symbols'First)) &
+         Encode (Tree, Symbols (Symbols'First + 1 .. Symbols'Last));
+      end if;
+   end Encode;
+
+   -- decode a bit sequence
+   function Decode
+     (Tree : Huffman_Tree;
+      Code : Bit_Sequence)
+      return Symbol_Sequence
+   is
+      -- maximum length = code length
+      Result   : Symbol_Sequence (1 .. Code'Length);
+      -- last used index of result
+      Last     : Natural     := 0;
+      The_Node : Node_Access := Tree.Tree;
+   begin
+      -- iterate over the code
+      for I in Code'Range loop
+         -- if current element is true, descent the right branch
+         if Code (I) then
+            The_Node := The_Node.Right_Child;
+         else
+            -- false: descend left branch
+            The_Node := The_Node.Left_Child;
+         end if;
+         if The_Node.Left_Child = null then
+            -- reached leaf node: append symbol to result
+            Last          := Last + 1;
+            Result (Last) := The_Node.Symbol;
+            -- reset current node to root
+            The_Node := Tree.Tree;
+         end if;
+      end loop;
+      -- return subset of result array
+      return Result (1 .. Last);
+   end Decode;
+
+   -- output a bit sequence
+   procedure Put (Code : Bit_Sequence) is
+      package Int_IO is new Ada.Text_IO.Integer_IO (Integer);
+   begin
+      for I in Code'Range loop
+         if Code (I) then
+            -- true = 1
+            Int_IO.Put (1, 0);
+         else
+            -- false = 0
+            Int_IO.Put (0, 0);
+         end if;
+      end loop;
+      Ada.Text_IO.New_Line;
+   end Put;
+
+   -- dump encoding map
+   procedure Dump_Encoding (Tree : Huffman_Tree) is
+      use type Encoding_Maps.Cursor;
+      Position : Encoding_Maps.Cursor := Tree.Map.First;
+   begin
+      -- iterate map
+      while Position /= Encoding_Maps.No_Element loop
+         -- key
+         Put (Encoding_Maps.Key (Position));
+         Ada.Text_IO.Put (" = ");
+         -- code
+         Put (Encoding_Maps.Element (Position));
+         Encoding_Maps.Next (Position);
+      end loop;
+   end Dump_Encoding;
+end Huffman;

Task/Huffman-coding/Ada/huffman-coding-3.adb

@@ -0,0 +1,49 @@
+with Ada.Text_IO;
+with Huffman;
+procedure Main is
+   package Char_Natural_Huffman_Tree is new Huffman
+     (Symbol_Type => Character,
+      Put => Ada.Text_IO.Put,
+      Symbol_Sequence => String,
+      Frequency_Type => Natural);
+   Tree         : Char_Natural_Huffman_Tree.Huffman_Tree;
+   Frequencies  : Char_Natural_Huffman_Tree.Frequency_Maps.Map;
+   Input_String : constant String :=
+     "this is an example for huffman encoding";
+begin
+   -- build frequency map
+   for I in Input_String'Range loop
+      declare
+         use Char_Natural_Huffman_Tree.Frequency_Maps;
+         Position : constant Cursor := Frequencies.Find (Input_String (I));
+      begin
+         if Position = No_Element then
+            Frequencies.Insert (Key => Input_String (I), New_Item => 1);
+         else
+            Frequencies.Replace_Element
+              (Position => Position,
+               New_Item => Element (Position) + 1);
+         end if;
+      end;
+   end loop;
+
+   -- create huffman tree
+   Char_Natural_Huffman_Tree.Create_Tree
+     (Tree        => Tree,
+      Frequencies => Frequencies);
+
+   -- dump encodings
+   Char_Natural_Huffman_Tree.Dump_Encoding (Tree => Tree);
+
+   -- encode example string
+   declare
+      Code : constant Char_Natural_Huffman_Tree.Bit_Sequence :=
+        Char_Natural_Huffman_Tree.Encode
+          (Tree    => Tree,
+           Symbols => Input_String);
+   begin
+      Char_Natural_Huffman_Tree.Put (Code);
+      Ada.Text_IO.Put_Line
+        (Char_Natural_Huffman_Tree.Decode (Tree => Tree, Code => Code));
+   end;
+end Main;

Task/Huffman-coding/PowerShell/huffman-coding.ps1

@@ -0,0 +1,61 @@
+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

Task/Huffman-coding/Rebol/huffman-coding.rebol

@@ -0,0 +1,111 @@
+Rebol [
+    title: "Rosetta code: Huffman coding"
+    file:  %Huffman_coding.r3
+    url:   https://rosettacode.org/wiki/Huffman_coding
+    note:  "Based on Red language solution"
+    needs: 3.15.0 ;; or something like that
+]
+
+register-codec [
+    name: 'huffman                         ;; Codec identifier name
+    type: 'compression                     ;; Type: compression algorithm
+    title: "Huffman encoding example"      ;; User-facing title
+
+    decode: function [
+        "Huffman decoding"
+        data [any-string!]
+    ][
+        output: copy ""                    ;; Initialize the output string
+        while [ not empty? data ][         ;; Loop through encoded data until empty
+            foreach [k v] knots [          ;; For each character-knot mapping
+                if t: find/match/tail data v/code [   ;; Check if the encoded string starts with the knot's code
+                    append output k        ;; If so, append the corresponding character to output
+                    data: t                ;; Consume matched part from data
+                ]
+            ]
+        ]
+        output                             ;; Return the decoded string
+    ]
+
+    encode: func [
+        "Huffman encoding"
+        data [any-string! binary!]
+        /local k nknot output
+    ][
+        output: copy ""                    ;; Initialize output string
+        foreach chr data [                 ;; For each character in input
+            either k: select/case knots chr [ ;; If knot already exists for the character
+                k/count: k/count + 1       ;; Increment frequency count
+            ][
+                ;; Otherwise, create new knot object and add to map
+                nknot: make knot [code: chr]
+                put/case knots chr nknot
+            ]
+        ]
+        table: values-of knots             ;; Extract all knots
+        while [1 < length? table][         ;; Build Huffman tree until only root remains
+            sort/compare table :compare-knots ;; Sort knots by ascending frequency
+            merge-2knots table             ;; Merge two lowest-count knots into new parent knot
+        ]
+        set-code table/1 copy ""           ;; Recursively assign binary codes by tree depth
+        foreach chr msg [                  ;; Encode the original message
+            k: select/case knots chr
+            append output k/code           ;; Append binary code for each character
+        ]
+        output                             ;; Return Huffman encoded string
+    ]
+
+    knot: make object! [
+        left: right: none                  ;; References to left and right children in the binary tree
+        code: none                         ;; Stores char (debug) and binary code for encoding
+        count: depth: 1                    ;; Frequency count and branch/tree depth
+    ]
+
+    knots: make map! []                    ;; Map to store character -> knot objects
+    table: none                            ;; Used for sorting the tree
+
+    compare-knots: function [a b] [
+        any [
+            a/count < b/count
+            all [
+                a/count = b/count
+                a/depth > b/depth
+            ]
+        ]
+    ]
+
+    set-code: func  [
+        "Recursive function to generate binary code sequence"
+        wknot
+        wcode [string!]
+    ][
+        either wknot/left [
+            set-code wknot/left  join wcode "1"     ;; Assign '1' when going left
+            set-code wknot/right join wcode "0"     ;; Assign '0' when going right
+        ][  wknot/code:  wcode ]                    ;; Assign accumulated code when leaf is reached
+    ]
+
+    merge-2knots: func [
+        "Merge 2 knots into 1 new"
+        t [block!]
+    ][
+        nknot: make knot [
+            count: t/1/count + t/2/count            ;; Sum frequencies for merged knot
+            right: t/1
+            left:  t/2
+            depth: t/1/depth + 1                    ;; Increase depth
+        ]
+        remove/part t 2                             ;; Remove first two knots from table
+        insert t nknot                              ;; Insert new knot at head of table
+    ]
+]
+
+;; message to encode:
+message: "this is an example for huffman encoding" ;; Input text for encoding
+? message                                          ;; Print message
+encoded: encode 'huffman message                   ;; Huffman encode the message
+? encoded                                          ;; Print encoded result
+decoded: decode 'huffman encoded                   ;; Decode Huffman encoding back to string
+? decoded                                          ;; Print decoded result
+print "Used codes:"
+foreach [k v] codecs/huffman/knots [print [mold k mold v/code]]