Data update

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]]