commit 2d18dbc20b1e1a9099397209c5c67daa6304b508
parent fb2fbcfe232da967776c979fba70148aa9f6302c
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sun, 2 Apr 2023 16:32:36 +0300
Add more solutions.
Diffstat:
6 files changed, 212 insertions(+), 0 deletions(-)
diff --git a/sicp/solutions/2_73.scm b/sicp/solutions/2_73.scm
@@ -0,0 +1,110 @@
+(define-library (sicp solutions 2_73)
+ (import (scheme base))
+ (import (scheme cxr))
+ (import (scheme write))
+ (import (srfi :26))
+ (import (srfi :111))
+ (import (sicp utils))
+ (import (only (sicp solutions 2_56)
+ =number?
+ make-exponentiation
+ make-product
+ make-sum
+ same-variable?
+ ))
+ (export deriv
+ get
+ put)
+
+ (begin
+ (define put-get-table '())
+
+ (define (put operator data-type proc)
+ (define new-key (cons operator data-type))
+ (define new-key-value-pair (cons new-key proc))
+ (set! put-get-table
+ (cons new-key-value-pair
+ (filter
+ (lambda (key-value-pair)
+ (not
+ (equal?
+ (car key-value-pair)
+ new-key)))
+ put-get-table))))
+
+ (define (get op data-type)
+ (define search-result
+ (filter (lambda (key-value-pair)
+ (equal?
+ (cons op data-type)
+ (car key-value-pair)))
+ put-get-table))
+ (if (null? search-result)
+ (error "Unknown expression type: " op data-type)
+ (cdar search-result)))
+
+ (define (operator exp)
+ (car exp))
+
+ (define (operands exp)
+ (cdr exp))
+
+ (define (variable? exp)
+ (symbol? exp))
+
+ (define (deriv exp var)
+ (cond
+ ((number? exp) 0)
+ ((variable? exp)
+ (if (same-variable? exp var)
+ 1
+ 0))
+ (else
+ ((get 'deriv (operator exp))
+ (operands exp)
+ var))))
+
+ (define (addend exp)
+ (car exp))
+
+ (define (augend exp)
+ (cadr exp))
+
+ (put 'deriv
+ '+
+ (lambda (exp var)
+ (display (list 'deriv '+ exp var))
+ (newline)
+ (make-sum
+ (deriv (addend exp) var)
+ (deriv (augend exp) var))))
+
+ (define (multiplier p)
+ (car p))
+
+ (define (multiplicand p)
+ (cadr p))
+
+ (put 'deriv
+ '*
+ (lambda (exp var)
+ (make-sum
+ (make-product (multiplier exp)
+ (deriv (multiplicand exp) var))
+ (make-product (deriv (multiplier exp) var)
+ (multiplicand exp)))))
+
+ (define (base e)
+ (car e))
+
+ (define (exponent e)
+ (cadr e))
+
+ (put 'deriv
+ '**
+ (lambda (exp var)
+ (display (list 'deriv '** exp var))
+ (newline)
+ (make-product (exponent exp)
+ (make-exponentiation (base exp)
+ (make-sum (exponent exp) -1)))))))
diff --git a/sicp/solutions/3_2.scm b/sicp/solutions/3_2.scm
@@ -0,0 +1,18 @@
+(define-library (sicp solutions 3_2)
+ (import (scheme base))
+ (export make-monitored)
+
+ (begin
+ (define (make-monitored proc)
+ (define number-of-calls 0)
+
+ (lambda (input)
+ (cond
+ ((eq? input 'how-many-calls?)
+ number-of-calls)
+ ((eq? input 'reset-count)
+ (set! number-of-calls 0))
+ (else
+ (set! number-of-calls
+ (+ 1 number-of-calls))
+ (proc input)))))))
diff --git a/sicp/solutions/3_3.scm b/sicp/solutions/3_3.scm
@@ -0,0 +1,27 @@
+(define-library (sicp solutions 3_3)
+ (import (scheme base))
+ (export make-account)
+
+ (begin
+ (define (make-account balance super-secret-symbol)
+ (define (withdraw amount)
+ (if (>= balance amount)
+ (begin
+ (set! balance
+ (- balance
+ amount))
+ balance)
+ "Insufficient funds"))
+
+ (define (deposit amount)
+ (set! balance (+ balance
+ amount))
+ balance)
+
+ (lambda (whisper m)
+ (if (eq? whisper super-secret-symbol)
+ (cond
+ ((eq? m 'withdraw) withdraw)
+ ((eq? m 'deposit) deposit)
+ (else (error "Uknown request: MAKE-ACCOUNT" m)))
+ (lambda x "Incorrect password"))))))
diff --git a/sicp/tests/2_73.scm b/sicp/tests/2_73.scm
@@ -0,0 +1,14 @@
+(import (srfi :64))
+(import (sicp solutions 2_73))
+
+(display (deriv '(+ x 1) 'x)) (newline)
+(display (deriv '(* (* x x) x) 'x)) (newline)
+(display (deriv '(** x 2) 'x)) (newline)
+
+;; (put 'a 'b map)
+
+;; (write ((get 'a 'b) 1+ '(1 2 3))) (newline)
+
+;; (test-begin "2.73")
+;; (test-equal 1 1)
+;; (test-end "2.73")
diff --git a/sicp/tests/3_2.scm b/sicp/tests/3_2.scm
@@ -0,0 +1,29 @@
+(import (srfi :64))
+(import (sicp solutions 3_2))
+
+(define s (make-monitored sqrt))
+
+(test-begin "3.2")
+(test-equal
+ 0
+ (s 'how-many-calls?))
+(test-equal
+ 10
+ (s 100))
+(test-equal
+ 1
+ (s 'how-many-calls?))
+(s 100)
+(s 100)
+(test-equal
+ 3
+ (s 'how-many-calls?))
+(s 'reset-count)
+(s 100)
+(s 100)
+(s 100)
+(s 100)
+(test-equal
+ 4
+ (s 'how-many-calls?))
+(test-end "3.2")
diff --git a/sicp/tests/3_3.scm b/sicp/tests/3_3.scm
@@ -0,0 +1,14 @@
+(import (srfi :64))
+(import (sicp solutions 3_3))
+
+(define acc
+ (make-account 100 'secret-password))
+
+(test-begin "3.3")
+(test-equal
+ 60
+ ((acc 'secret-password 'withdraw) 40))
+(test-equal
+ "Incorrect password"
+ ((acc 'some-other-password 'deposit) 50))
+(test-end "3.3")
