From f318ae0a700b1cb93e4189237bf308f9bd9f7279 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petar=20Kapri=C5=A1?= Date: Wed, 10 Sep 2025 21:59:36 +0100 Subject: [PATCH] Add exercises from section 2.3.4 --- chapter-2/ex-2.67.scm | 67 ++++++++++++++++++++++++++ chapter-2/ex-2.68.scm | 99 ++++++++++++++++++++++++++++++++++++++ chapter-2/ex-2.69.scm | 66 +++++++++++++++++++++++++ chapter-2/ex-2.70.scm | 109 ++++++++++++++++++++++++++++++++++++++++++ chapter-2/ex-2.71.txt | 36 ++++++++++++++ chapter-2/ex-2.72.txt | 12 +++++ 6 files changed, 389 insertions(+) create mode 100644 chapter-2/ex-2.67.scm create mode 100644 chapter-2/ex-2.68.scm create mode 100644 chapter-2/ex-2.69.scm create mode 100644 chapter-2/ex-2.70.scm create mode 100644 chapter-2/ex-2.71.txt create mode 100644 chapter-2/ex-2.72.txt diff --git a/chapter-2/ex-2.67.scm b/chapter-2/ex-2.67.scm new file mode 100644 index 0000000..2c1d926 --- /dev/null +++ b/chapter-2/ex-2.67.scm @@ -0,0 +1,67 @@ +#lang sicp + +(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 (symbols left) (symbols right)) + (+ (weight left) (weight right)))) + +(define (left-branch tree) (car tree)) +(define (right-branch tree) (cadr tree)) +(define (symbols 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 set) + (cond ((null? set) (list x)) + ((< (weight x) (weight (car set))) (cons x set)) + (else (cons (car set) + (adjoin-set x (cdr set)))))) + +(define (make-leaf-set pairs) + (if (null? pairs) + '() + (let ((pair (car pairs))) + (adjoin-set (make-leaf (car pair) ; symbol + (cadr pair)) ; frequency + (make-leaf-set (cdr pairs)))))) + +(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) \ No newline at end of file diff --git a/chapter-2/ex-2.68.scm b/chapter-2/ex-2.68.scm new file mode 100644 index 0000000..e654cc8 --- /dev/null +++ b/chapter-2/ex-2.68.scm @@ -0,0 +1,99 @@ +#lang sicp + +(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 (symbols left) (symbols right)) + (+ (weight left) (weight right)))) + +(define (left-branch tree) (car tree)) +(define (right-branch tree) (cadr tree)) +(define (symbols 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 set) + (cond ((null? set) (list x)) + ((< (weight x) (weight (car set))) (cons x set)) + (else (cons (car set) + (adjoin-set x (cdr set)))))) + +(define (make-leaf-set pairs) + (if (null? pairs) + '() + (let ((pair (car pairs))) + (adjoin-set (make-leaf (car pair) ; symbol + (cadr pair)) ; frequency + (make-leaf-set (cdr pairs)))))) + +(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) + +; until now previous exercise + +; setup for the current one +(define (encode message tree) + (if (null? message) + '() + (append (encode-symbol (car message) tree) + (encode (cdr message) tree)))) + +; my procedure +; assumes that a tree is well formed, ie. that if a symbol appears in a +; parent node's list it must be in one of the child branches +; not the most efficient since it checks symbol lists at almost every level +; twice +(define (encode-symbol symbol tree) + (cond ((not (member-set symbol (symbols tree))) + (error "encode-symbol: no seq for the symbol in tree" symbol tree)) + ((leaf? tree) + '()) + ((member-set symbol (symbols (left-branch tree))) + (cons 0 (encode-symbol symbol (left-branch tree)))) + ((member-set symbol (symbols (right-branch tree))) + (cons 1 (encode-symbol symbol (right-branch tree)))))) + +(define member-set member) +; since a set is represented as a list, we can simply use the member procedure + +;test: +; input: (A D A B B C A) +; output:(0 1 1 0 0 1 0 1 0 1 1 1 0) +; it works! \ No newline at end of file diff --git a/chapter-2/ex-2.69.scm b/chapter-2/ex-2.69.scm new file mode 100644 index 0000000..bb75529 --- /dev/null +++ b/chapter-2/ex-2.69.scm @@ -0,0 +1,66 @@ +#lang sicp + +(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 (symbols left) (symbols right)) + (+ (weight left) (weight right)))) + +(define (left-branch tree) (car tree)) +(define (right-branch tree) (cadr tree)) +(define (symbols 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 set) + (cond ((null? set) (list x)) + ((< (weight x) (weight (car set))) (cons x set)) + (else (cons (car set) + (adjoin-set x (cdr set)))))) + +(define (make-leaf-set pairs) + (if (null? pairs) + '() + (let ((pair (car pairs))) + (adjoin-set (make-leaf (car pair) ; symbol + (cadr pair)) ; frequency + (make-leaf-set (cdr pairs)))))) + +; actual exercise +(define (generate-huffman-tree pairs) + (successive-merge (make-leaf-set pairs))) + +(define (successive-merge tree-set) + (if (null? (cdr tree-set)) ; (= (length tree-list) 1) + (car tree-set) + (let ((tree1 (car tree-set)) + (tree2 (cadr tree-set))) + (successive-merge (adjoin-set (make-code-tree tree1 tree2) + (cddr tree-set)))))) \ No newline at end of file diff --git a/chapter-2/ex-2.70.scm b/chapter-2/ex-2.70.scm new file mode 100644 index 0000000..bc29286 --- /dev/null +++ b/chapter-2/ex-2.70.scm @@ -0,0 +1,109 @@ +#lang sicp + +(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 (symbols left) (symbols right)) + (+ (weight left) (weight right)))) + +(define (left-branch tree) (car tree)) +(define (right-branch tree) (cadr tree)) +(define (symbols 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 set) + (cond ((null? set) (list x)) + ((< (weight x) (weight (car set))) (cons x set)) + (else (cons (car set) + (adjoin-set x (cdr set)))))) + +(define (make-leaf-set pairs) + (if (null? pairs) + '() + (let ((pair (car pairs))) + (adjoin-set (make-leaf (car pair) ; symbol + (cadr pair)) ; frequency + (make-leaf-set (cdr pairs)))))) + +(define (generate-huffman-tree pairs) + (successive-merge (make-leaf-set pairs))) + +(define (successive-merge tree-set) + (if (null? (cdr tree-set)) ; (= (length tree-list) 1) + (car tree-set) + (let ((tree1 (car tree-set)) + (tree2 (cadr tree-set))) + (successive-merge (adjoin-set (make-code-tree tree1 tree2) + (cddr tree-set)))))) + +; the encode functionality from 2.68 +(define (encode message tree) + (if (null? message) + '() + (append (encode-symbol (car message) tree) + (encode (cdr message) tree)))) + +(define (encode-symbol symbol tree) + (cond ((not (member-set symbol (symbols tree))) + (error "encode-symbol: no seq for the symbol in tree" symbol tree)) + ((leaf? tree) + '()) + ((member-set symbol (symbols (left-branch tree))) + (cons 0 (encode-symbol symbol (left-branch tree)))) + ((member-set symbol (symbols (right-branch tree))) + (cons 1 (encode-symbol symbol (right-branch tree)))))) + +(define member-set member) +; since a set is represented as a list, we can simply use the member procedure + +; actual exercise 2.70 + +(define sample-tree + (generate-huffman-tree '((a 2) + (get 2) + (sha 3) + (wah 1) + (boom 1) + (job 2) + (na 16) + (yip 9)))) + +(define sample-message + '(get a job + sha na na na na na na na na + get a job + sha na na na na na na na na + wah yip yip yip yip yip yip yip yip yip + sha boom)) + +; (length (encode sample-message sample-tree)) -> 84 +; if we used a fixed length code, it would have to have length of >=3 +; since there are 36 words here, the answer would be 108 diff --git a/chapter-2/ex-2.71.txt b/chapter-2/ex-2.71.txt new file mode 100644 index 0000000..43ebebd --- /dev/null +++ b/chapter-2/ex-2.71.txt @@ -0,0 +1,36 @@ +(A 1), (B 2), (C 4), ... +Tree sketch (n=5): + + * + / \ +(E 16) * + / \ + (D 8) * + / \ + (C 4) * + / \ + (B 2) (A 1) + +tree sketch (n=10): + * + / \ +(J 512) * + / \ + (I 256) * + / \ + (H 128) * + / \ + (G 64) * + / \ + (F 32) * + / \ + (E 16) * + / \ + (D 8) * + / \ + (C 4) * + / \ + (B 2) (A 1) + +The most frequent symbol always requires exactly 1 bit. +The two least frequent symbols will always require exactly n-1 bits. diff --git a/chapter-2/ex-2.72.txt b/chapter-2/ex-2.72.txt new file mode 100644 index 0000000..d7482ed --- /dev/null +++ b/chapter-2/ex-2.72.txt @@ -0,0 +1,12 @@ +Searching a single node requires on the order of k operations, where +k is the number of symbols given at that node. +If the tree is roughly balanced, then the number of symbols listed in +each node on the way down should decrease exponentially, and the number +of these searches would be on the order of O(log(n)), where n is the +number of symbols generally available for encoding. + +If this is true, than each encoding of a symbol would take on the order +of O(n*log(n)) operations, however if the tree is very unbalanced, +which is the case in exercise 2.71, the order of growth is roughly +O(n^2), for the least frequent symbols, and O(n), for the most common +symbol.