From 5254a0befde355fca2711033f77047cf0bb5c08f Mon Sep 17 00:00:00 2001
From: Mike Vink <mike1994vink@gmail.com>
Date: Mon, 27 Mar 2023 21:58:09 +0200
Subject: moar

---
 coding-exercises/2/67.rkt | 105 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 105 insertions(+)
 create mode 100644 coding-exercises/2/67.rkt

(limited to 'coding-exercises/2/67.rkt')

diff --git a/coding-exercises/2/67.rkt b/coding-exercises/2/67.rkt
new file mode 100644
index 0000000..d6021b1
--- /dev/null
+++ b/coding-exercises/2/67.rkt
@@ -0,0 +1,105 @@
+#lang racket
+(require "../../shared/lists.rkt")
+(define (make-leaf symbol weight)
+  (list 'leaf symbol weight))
+
+(define (leaf? object)
+  (eq? (car object) 'leaf))
+
+(define (symbol-leaf x)
+  (cadr x))
+
+(define (weight-leaf x)
+  (caddr x))
+
+(define (make-code-tree left right)
+  (list
+    left
+    right
+    (append (symbol-set left)
+            (symbol-set right))
+    (+ (weight left)
+       (weight right))))
+
+(define (left-branch tree)
+  (car tree))
+
+(define (right-branch tree)
+  (cadr tree))
+
+(define (symbol-set tree)
+  (if (leaf? tree)
+    (list (symbol-leaf tree))
+    (caddr tree)))
+
+(define (weight tree)
+  (if (leaf? tree)
+    (weight-leaf tree)
+    (cadddr tree)))
+
+(define (decode bits tree)
+  (define (decode-1 bits current-branch)
+    (if (null? bits)
+      '()
+      (let ((next-branch
+              (choose-branch (car bits) current-branch)))
+        (if (leaf? next-branch)
+          (cons (symbol-leaf next-branch)
+                (decode-1 (cdr bits) tree))
+          (decode-1 (cdr bits) next-branch)))))
+  (decode-1 bits tree))
+
+(define (choose-branch bit branch)
+  (cond ((= bit 0) (left-branch branch))
+        ((= bit 1) (right-branch branch))
+        (else (error "bad bit -- CHOOSE-BRANCH" bit))))
+
+(define (adjoin-set x mset)
+  (cond ((null? mset) (list x))
+        ((< (weight x) (weight (car mset))
+            (cons x mset)))
+        (else (cons (car mset)
+                    (adjoin-set x (cdr mset))))))
+
+(define (make-leaf-set pairs)
+  (if (null? pairs)
+    '()
+    (let ((pair (car pairs)))
+      (adjoin-set (make-leaf (car pair)
+                             (cadr pair))
+                  (make-leaf-set (cdr pairs))))))
+
+;; 67
+(define sample-tree
+  (make-code-tree (make-leaf 'A 4)
+                  (make-code-tree
+                    (make-leaf 'B 2)
+                    (make-code-tree
+                      (make-leaf 'D 1)
+                      (make-leaf 'C 1)))))
+(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
+(decode sample-message sample-tree)
+;; '(A D A B B C A)
+
+;; 68
+(define (encode message tree)
+  (if (null? message)
+    '()
+    (append (encode-symbol (car message) tree)
+            (encode (cdr message) tree))))
+
+(define (encode-symbol s tree)
+  (define (bits result subtree)
+    (cond ((and (leaf? subtree) 
+                (equal? s (car (symbol-set subtree))))
+           result)
+      ((leaf? subtree) '())
+      (else
+        (let ((left (bits 
+                      (cons 0 result) 
+                      (left-branch subtree))))
+          (if (null? left)
+            (bits (cons 1 result) (right-branch subtree))
+            left)))))
+  (reverse (bits '() tree)))
+(encode (decode sample-message sample-tree) sample-tree)
-- 
cgit v1.2.3