commit 8b3563174af7e102fd063551c842e9cf0ac2edf2
parent 88d130a96008956c4f49c513eccb86b9788a4d1a
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Wed, 12 Apr 2023 17:24:23 +0300
Add a few solutions and stuff.
Diffstat:
9 files changed, 254 insertions(+), 74 deletions(-)
diff --git a/Makefile b/Makefile
@@ -4,6 +4,9 @@ poop:
statistics:
guile -L . sicp/statistics.scm
+3.7:
+ guile -L . sicp/tests/3_7.scm
+
3.6:
guile -L . sicp/tests/3_6.scm
diff --git a/sicp/solutions/1_34.scm b/sicp/solutions/1_34.scm
@@ -0,0 +1,30 @@
+(define-library (sicp solutions 1_34)
+ (import (scheme base))
+
+ (begin
+ (define (f g)
+ (g 2))
+
+ '(f f)
+
+ '((lambda (f g) (g 2))
+ (lambda (f g) (g 2)))
+
+ '((lambda (f g) (g 2)) 2)
+
+ '(2 2)
+
+ '2-is-not-a-procedure
+
+ '(f f)
+
+ "Outout in Geiser's C-x C-e *Geiser Debug* buffer:
+```
+(f f)
+
+ice-9/boot-9.scm:1685:16: In procedure raise-exception:
+Wrong type to apply: 2
+
+
+[Debugging level: 2]
+```"))
diff --git a/sicp/solutions/1_42.scm b/sicp/solutions/1_42.scm
@@ -0,0 +1,7 @@
+(define-library (sicp solutions 1_42)
+ (import (scheme base))
+
+ (begin
+ (define (compose f g)
+ (lambda (x)
+ (f (g x))))))
diff --git a/sicp/solutions/2_7.scm b/sicp/solutions/2_7.scm
@@ -1,68 +1,45 @@
-
-(define (exercise-2.7)
- (define (make-interval lower higher)
- (cons lower higher))
- (define (lower-bound interval)
- (car interval))
- (define (upper-bound interval)
- (cdr interval))
-
- (define (add-interval x y)
- (make-interval (+ (lower-bound x)
- (lower-bound y))
- (+ (upper-bound x)
- (upper-bound y))))
-
- (define (mul-interval x y)
- (let* ((bound-getters (list lower-bound higher-bound))
- (ps (list-ec (: x-bound bound-getters)
- (: y-bound bound-getters)
- (* (x-bound x)
- (y-bound y)))))
- (make-interval (min ps)
- (max ps))))
-
- (define (div-interval x y)
- (mul-interval x (make-interval (/ 1.0 (upper-bound y))
- (/ 1.0 (lower-bound y)))))
-
- (define (sub-interval x y)
- (make-interval (- (lower-bound x)
- (lower-bound y))
- (- (upper-bound x)
- (upper-bound y))))
-
- (define (width-interval x)
- (/ (- (upper-bound x)
- (lower-bound x))
- 2))
-
- (width-interval (add-interval x y))
- (width-interval (make-interval (+ (lower-bound x)
- (lower-bound y))
- (+ (upper-bound x)
- (upper-bound y))))
- (/ (- (upper-bound (make-interval (+ (lower-bound x)
- (lower-bound y))
- (+ (upper-bound x)
- (upper-bound y))))
- (lower-bound (make-interval (+ (lower-bound x)
- (lower-bound y))
- (+ (upper-bound x)
- (upper-bound y)))))
- 2)
- (/ (- (+ (upper-bound x)
- (upper-bound y))
- (+ (lower-bound x)
- (lower-bound y)))
- 2)
-
- (add-interval (width-interval x)
- (width-interval y))
- (add-interval (/ (- (upper-bound x) (lower-bound x)) 2)
- (/ (- (upper-bound y) (lower-bound y)) 2))
- (make-interval ((/ (- (upper-bound x) (lower-bound x)) 2))
- (/ (- (upper-bound y) (lower-bound y)) 2))
- )
-
-;;;(exercise-2.7)
+(define-library (sicp solutions 2_7)
+ (import (scheme base))
+ (export
+ lower-bound
+ make-interval
+ upper-bound
+ )
+
+ (begin
+ (define (make-interval lower higher)
+ (cons lower higher))
+ (define (lower-bound interval)
+ (car interval))
+ (define (upper-bound interval)
+ (cdr interval))
+
+ (define (add-interval x y)
+ (make-interval (+ (lower-bound x)
+ (lower-bound y))
+ (+ (upper-bound x)
+ (upper-bound y))))
+
+ (define (mul-interval x y)
+ (let* ((bound-getters (list lower-bound higher-bound))
+ (ps (list-ec (: x-bound bound-getters)
+ (: y-bound bound-getters)
+ (* (x-bound x)
+ (y-bound y)))))
+ (make-interval (min ps)
+ (max ps))))
+
+ (define (div-interval x y)
+ (mul-interval x (make-interval (/ 1.0 (upper-bound y))
+ (/ 1.0 (lower-bound y)))))
+
+ (define (sub-interval x y)
+ (make-interval (- (lower-bound x)
+ (lower-bound y))
+ (- (upper-bound x)
+ (upper-bound y))))
+
+ (define (width-interval x)
+ (/ (- (upper-bound x)
+ (lower-bound x))
+ 2))))
diff --git a/sicp/solutions/3_5.scm b/sicp/solutions/3_5.scm
@@ -0,0 +1,76 @@
+(define-library (sicp solutions 3_5)
+ (import (scheme base))
+ (import (srfi :64
+
+ (begin
+
+ '(
+ A qed calculation:
+ a = number of heads
+ b = number of tails
+ n = number of heads and tails
+
+ a+b=n
+
+ C_i = +(1/(2^i)) if coin toss is heads else -(1/(2^i))
+
+ (a - b) / 2^n = (sum i=1 to n C_i)
+
+ After n times, we get:
+
+ (a - b) / 2^n
+ )
+
+ (define (random-plus-or-minus)
+ (- (* 2
+ (random 2))
+ 1))
+
+ (define (random-unit-fraction deepness)
+ (define (iter current-deepness total)
+ (cond
+ ((<= current-deepness 0)
+ total)
+ (else
+ (iter (- current-deepness 1)
+ (+ total
+ (* (random-plus-or-minus)
+ (/ 1
+ (expt 2
+ current-deepness))))))))
+ (iter deepness 0))
+
+ (define (random-squared-confining-a-unit-circle deepness)
+ (cons (random-unit-fraction deepness)
+ (random-unit-fraction deepness)))
+
+ (define (in-unit-circle? x y)
+ (>= 1 (sqrt (+ (* x x)
+ (* y y)))))
+
+ (let ([random random:uniform])
+ (define (random-in-range low high)
+ (let ([range (- high low)])
+ (+ low (random range)))))
+
+ (define (monte-carlo trials experiment)
+ (define (iter trials-remaining trials-passed)
+ (cond ((= trials-remaining 0)
+ (/ trials-passed trials))
+ ((experiment)
+ (iter (- trials-remaining 1)
+ (+ trials-passed 1)))
+ (else
+ (iter (- trials-remaining 1)
+ trials-passed))))
+ (iter trials 0))
+
+ 8 * inside / total = tau
+
+ (= (/ area-of-circle
+ area-of-square)
+ (/ (* (/ tau 2))
+ 2))
+
+ (define (estimate-integral p x1 x2 y1 y2 number-of-trials)
+ (monte-carlo number-of-trials ))))
diff --git a/sicp/solutions/3_7.scm b/sicp/solutions/3_7.scm
@@ -0,0 +1,15 @@
+(define-library (sicp solutions 3_7)
+ (import (scheme base))
+ (export
+ make-joint
+ )
+
+ (begin
+ (define (make-joint password-protected-account password-protected-account-password new-password)
+ (lambda (whisper m)
+ (if (eq? whisper new-password)
+ (begin
+ (password-protected-account
+ password-protected-account-password
+ m))
+ (lambda x "Incorrect password"))))))
diff --git a/sicp/statistics.scm b/sicp/statistics.scm
@@ -50,8 +50,6 @@
(filter identity
(get-solution-files-numbers (file-system-tree "sicp/solutions/"))))
-'(display solution-files-numbers)
-
(sort
(lset-difference equal?
exercise-numbers
@@ -77,13 +75,24 @@
exercise-numbers
solution-files-numbers)))
+(define (split-into-lines s)
+ (string-split s #\newline))
+
+(define (match-and-filter-XXX-lines lines)
+ (map (cut vector-ref <> 0)
+ (filter identity
+ (map (cut string-match "XXX" <>)
+ lines))))
+
(define (filename-got-XXX? filename)
(if (file-exists? filename)
(with-input-from-file filename
- (lambda () (if (string-match "XXX"
- (get-string-all (current-input-port)))
- filename
- #f)))
+ (lambda () (let ([matches ((compose match-and-filter-XXX-lines
+ split-into-lines)
+ (get-string-all (current-input-port)))])
+ (if (null? matches)
+ #f
+ (list filename matches)))))
#f))
(for-each (lambda (x) (format #t "Solution file has an XXX: ~a\n" x))
diff --git a/sicp/tests/2_7.scm b/sicp/tests/2_7.scm
@@ -0,0 +1,36 @@
+(define-library (sicp tests 2_7)
+ (import (scheme base))
+ (import (srfi :64))
+
+ (begin
+ ; XXX Break these down to specific solutions and tests.
+
+ (test-begin "2.7")
+
+ (width-interval (add-interval x y))
+ (width-interval (make-interval (+ (lower-bound x)
+ (lower-bound y))
+ (+ (upper-bound x)
+ (upper-bound y))))
+ (/ (- (upper-bound (make-interval (+ (lower-bound x)
+ (lower-bound y))
+ (+ (upper-bound x)
+ (upper-bound y))))
+ (lower-bound (make-interval (+ (lower-bound x)
+ (lower-bound y))
+ (+ (upper-bound x)
+ (upper-bound y)))))
+ 2)
+ (/ (- (+ (upper-bound x)
+ (upper-bound y))
+ (+ (lower-bound x)
+ (lower-bound y)))
+ 2)
+
+ (add-interval (width-interval x)
+ (width-interval y))
+ (add-interval (/ (- (upper-bound x) (lower-bound x)) 2)
+ (/ (- (upper-bound y) (lower-bound y)) 2))
+ (make-interval ((/ (- (upper-bound x) (lower-bound x)) 2))
+ (/ (- (upper-bound y) (lower-bound y)) 2))
+ (test-end "2.7")))
diff --git a/sicp/tests/3_7.scm b/sicp/tests/3_7.scm
@@ -0,0 +1,27 @@
+(define-library (sicp tests 3_7)
+ (import (scheme base))
+ (import (scheme write))
+ (import (srfi :64))
+ (import (only (sicp solutions 3_3) make-account))
+ (import (sicp solutions 3_7))
+
+ (begin
+ (define acc
+ (make-account 100
+ 'secret-password))
+
+ (define joint-acc (make-joint acc
+ 'secret-password
+ 'another-secret-password))
+
+ (test-begin "3.7")
+ (test-equal
+ 60
+ ((acc 'secret-password 'withdraw) 40))
+ (test-equal
+ "Incorrect password"
+ ((acc 'incorrect-password 'deposit) 50))
+ (test-equal
+ 110
+ ((joint-acc 'another-secret-password 'deposit) 50))
+ (test-end "3.7")))
