commit 8aa798ee1b197160c1069642aaa45946ab410601
parent 003b86c2d451d4fff198dc983ea584bd2798ced9
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Tue, 28 Mar 2023 11:38:33 +0300
Add solution to exercise 2.70 and gitignore and makefile stuff.
Diffstat:
4 files changed, 99 insertions(+), 4 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -1,4 +1,6 @@
*.log
-*.scm~
-*\#*
*.scm.*
+*\#*
+*~
+moo.*
+poop.*
diff --git a/Makefile b/Makefile
@@ -1,3 +1,9 @@
+poop:
+ echo poop
+
+2.70:
+ guile -l sicp/utils.scm -l sicp/solutions/exercise-1.21.scm -l sicp/solutions/exercise-2.40.scm -l sicp/solutions/huffman-codes-stuff.scm sicp/tests/2.70.scm
+
tests: guile.scm
guile --no-auto-compile guile.scm
diff --git a/sicp/solutions/huffman-codes-stuff.scm b/sicp/solutions/huffman-codes-stuff.scm
@@ -5,11 +5,14 @@
(import (scheme cxr))
(import (only (sicp utils) accumulate))
(import (only (sicp solutions exercise-2.40) remove))
- (export make-code-tree
+ (export decode
+ encode
+ generate-huffman-tree
make-leaf
sample-message
sample-tree
- generate-huffman-tree)
+ weight
+ make-code-tree)
(begin
(define (make-leaf symbol weight)
diff --git a/sicp/tests/2.70.scm b/sicp/tests/2.70.scm
@@ -0,0 +1,84 @@
+(import (srfi :26))
+(import (srfi :64))
+(import (only (sicp utils) accumulate))
+(import (only (sicp solutions huffman-codes-stuff)
+ decode
+ encode
+ generate-huffman-tree
+ weight
+ make-leaf))
+
+(define (remove-empty-strings list-of-strings)
+ (filter (compose not
+ (cut equal?
+ ""
+ <>))
+ list-of-strings))
+
+(define code-text
+ "A 2 NA 16
+BOOM 1 SHA 3
+GET 2 YIP 9
+JOB 2 WAH 1")
+
+(define songs-huffman-tree
+ (let* ([split-code-text
+ (string-split code-text
+ (string->char-set "\n "))]
+ [only-tokens-code-text
+ (remove-empty-strings split-code-text)]
+ [list-of-pairs (let loop ([code-list only-tokens-code-text])
+ (cond
+ ((null? code-list) '())
+ ((null? (cdr code-list)) '())
+ (else (cons (list (string->symbol (car code-list))
+ (string->number (cadr code-list)))
+ (loop (cddr code-list))))))]
+ [ordered-pairs-by-weight (sort list-of-pairs
+ (lambda (x y)
+ (< (cadr x)
+ (cadr y))))])
+ (generate-huffman-tree ordered-pairs-by-weight)))
+
+(define song-text
+ "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")
+
+(define only-letters-song-message
+ (remove-empty-strings
+ (string-split (string-upcase song-text)
+ (string->char-set "\n "))))
+
+(define song-message
+ (map string->symbol only-letters-song-message))
+
+(define encoded-song-message
+ (encode song-message
+ songs-huffman-tree))
+
+(test-begin "2.70")
+(test-equal
+ 84
+ (length encoded-song-message))
+(test-equal
+ 992
+ (* 8 ;; Length of message in bits is a 8 bits per byte times length of message in characters.
+ (apply + ;; length of message in characters
+ (cons ;; is length of spaces
+ (- (length only-letters-song-message) ;; which is the length of message in symbols
+ 1) ;; minus one to get the number of spaces between symbols
+ (map string-length
+ only-letters-song-message))))) ;; plus the number of characters in each symbol.
+(test-end "2.70")
+
+;; We count consecutive whitespaces - newline and a spacey space - as a single
+;; space delimiting the symbols.
+;; We also disregard letter case and casing, which is unadvised for a
+;; reasonably safe journey in the land of languages.
