sicp

sicp sandbox.
git clone git://git.ricketyspace.net/sicp.git
Log | Files | Refs

commit 19ed602c1ba7dc2b933274f50085c9c4f0f1105c
parent 8d6bb0aee4679f874ddfb6f7edd8945852cb9c99
Author: rsiddharth <s@ricketyspace.net>
Date:   Sat, 14 Jan 2017 21:44:28 +0000

one -> net/ricketyspace/sicp

Diffstat:
net/ricketyspace/sicp/one/eight.scm | 38++++++++++++++++++++++++++++++++++++++
net/ricketyspace/sicp/one/eleven.scm | 41+++++++++++++++++++++++++++++++++++++++++
net/ricketyspace/sicp/one/fifteen.scm | 31+++++++++++++++++++++++++++++++
net/ricketyspace/sicp/one/five.scm | 13+++++++++++++
net/ricketyspace/sicp/one/fourteen.scm | 43+++++++++++++++++++++++++++++++++++++++++++
net/ricketyspace/sicp/one/seven.scm | 49+++++++++++++++++++++++++++++++++++++++++++++++++
net/ricketyspace/sicp/one/six.scm | 40++++++++++++++++++++++++++++++++++++++++
net/ricketyspace/sicp/one/three.scm | 36++++++++++++++++++++++++++++++++++++
net/ricketyspace/sicp/one/twelve.scm | 58++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
one/eight.scm | 38--------------------------------------
one/eleven.scm | 41-----------------------------------------
one/fifteen.scm | 31-------------------------------
one/five.scm | 13-------------
one/fourteen.scm | 43-------------------------------------------
one/seven.scm | 49-------------------------------------------------
one/six.scm | 40----------------------------------------
one/three.scm | 36------------------------------------
one/twelve.scm | 58----------------------------------------------------------
18 files changed, 349 insertions(+), 349 deletions(-)

diff --git a/net/ricketyspace/sicp/one/eight.scm b/net/ricketyspace/sicp/one/eight.scm @@ -0,0 +1,38 @@ +;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;; International. See +;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +(define-module (net ricketyspace sicp one eight) + #:export (cube double + div-three improve + good-enough? cbrt-iter + cbrt-sicp)) + +(use-modules (one six)) + +(define (cube x) + (* (square x) x)) + +(define (double x) + (* 2 x)) + +(define (div-three x) + (/ x 3.0)) + +(define (improve y x) + (div-three (+ (/ x (square y)) + (double y)))) + +(define (good-enough? y x) + (< (abs (- (cube y) x)) + 0.001)) + +(define (cbrt-iter y x) + (if (good-enough? y x) + y + (cbrt-iter (improve y x) + x))) + +(define (cbrt-sicp x) + (cbrt-iter 1.0 x)) + diff --git a/net/ricketyspace/sicp/one/eleven.scm b/net/ricketyspace/sicp/one/eleven.scm @@ -0,0 +1,41 @@ +;;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;;; International. See +;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +(define-module (net ricketyspace sicp one eleven) + #:export (recursive-fn + make-cache + alt-recursive-fn)) + +(define (recursive-fn n) + (cond ((<= n 3) n) + (else (+ (* 1 (recursive-fn (- n 1))) + (* 2 (recursive-fn (- n 2))) + (* 3 (recursive-fn (- n 3))))))) + +;;;; alternative version. faster but ugly. + +(define (make-cache) + (let ((cache (make-hash-table))) + (define (get key) + (hash-get-handle cache key)) + (define (set key value) + (hash-create-handle! cache key value) + ;; return value as a side effect. + value) + (lambda args + (apply (case (car args) + ((get) get) + ((set) set) + (else (error "Invalid method"))) + (cdr args))))) + +(define (alt-recursive-fn cache n) + (let ((v (cache 'get n))) + (cond (v (cdr v)) + ((<= n 3) + (cache 'set n n)) + (else (cache 'set n + (+ (* 1 (alt-recursive-fn cache (- n 1))) + (* 2 (alt-recursive-fn cache (- n 2))) + (* 3 (alt-recursive-fn cache (- n 3))))))))) diff --git a/net/ricketyspace/sicp/one/fifteen.scm b/net/ricketyspace/sicp/one/fifteen.scm @@ -0,0 +1,31 @@ +;;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;;; International. See +;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +(define-module (net ricketyspace sicp one fifteen) + #:use-module (ice-9 regex) + #:export (sine)) + +(define (sine angle) + (let ((out "")) + (define (log angle) + (set! out (string-append out " (p (sine " + (number->string (/ angle 3.0))))) + (define (close-parens s) + (string-trim (string-append + s (fold-matches "\\([p,s]" s "" + (lambda (match prev) + (string-append prev ")")))))) + (define (cube x) (* x x x)) + (define (p x) (- (* 3 x) (* 4 (cube x)))) + (define (s angle) + (if (not (> (abs angle) 0.1)) + angle + (begin + (log angle) + (p (s (/ angle 3.0)))))) + (s angle) + (close-parens out))) +;; +;; (sine 12.15) +;; $25 = "(p (sine 4.05 (p (sine 1.3499999999999999 (p (sine 0.44999999999999996 (p (sine 0.15 (p (sine 0.049999999999999996))))))))))" diff --git a/net/ricketyspace/sicp/one/five.scm b/net/ricketyspace/sicp/one/five.scm @@ -0,0 +1,13 @@ +;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;; International. See +;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +(define-module (net ricketyspace sicp one five) + #:export (p test)) + +(define (p) (p)) + +(define (test x y) + (if (= x 0) + 0 + y)) diff --git a/net/ricketyspace/sicp/one/fourteen.scm b/net/ricketyspace/sicp/one/fourteen.scm @@ -0,0 +1,43 @@ +;;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;;; International. See +;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +;;; adapted from section 1.2.2 +;;; intolerable scheme drivel; ignore it. + +(define-module (net ricketyspace sicp one fourteen) + #:export (get-cc + cc-range + cc-diff-list)) + +(define (get-cc) + (let ((no-of-steps 0)) + (define (cc amount kinds-of-coins) + (set! no-of-steps (1+ no-of-steps)) + (cond ((= amount 0) 1) + ((or (< amount 0) (= kinds-of-coins 0)) 0) + (else (+ (cc amount + (- kinds-of-coins 1)) + (cc (- amount + (first-denomination kinds-of-coins)) + kinds-of-coins))))) + (define (first-denomination kinds-of-coins) + (cond ((= kinds-of-coins 1) 1) + ((= kinds-of-coins 2) 5) + ((= kinds-of-coins 3) 10) + ((= kinds-of-coins 4) 25) + ((= kinds-of-coins 5) 50))) + (lambda (amount) + (cc amount 5) + no-of-steps))) + +(define (cc-range amount limit incr) + (cond ((> amount limit) '()) + ((<= amount limit) + (cons ((get-cc) amount) + (cc-range (+ amount incr) limit incr))))) + +(define (cc-diff-list l) + (cond ((= (length l) 1) '()) + ((> (length l) 1) (cons (+ (* -1 (car l)) (cadr l)) + (cc-diff-list (cdr l)))))) diff --git a/net/ricketyspace/sicp/one/seven.scm b/net/ricketyspace/sicp/one/seven.scm @@ -0,0 +1,49 @@ +;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;; International. See +;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +(define-module (net ricketyspace sicp one seven) + #:export (tolerances-and-sqrt + good-enough-alt? + sqrt-iter-alt + sqrt-sicp-alt)) + +(use-modules (one six)) + +;;;; start yak shaving +(define (gen-good-enough tolerance) + (lambda (guess x) + (< (abs (- (square guess) x)) tolerance))) + +(define (sqrt-iter-with-tolerance guess x tolerance) + (let ((good-enough? (gen-good-enough tolerance))) + (if (good-enough? guess x) + guess + (sqrt-iter-with-tolerance (improve guess x) + x tolerance)))) + +(define (sqrt-with-tolerance x tolerance) + (sqrt-iter-with-tolerance 1.0 x tolerance)) + +(define (tolerances-and-sqrt x tolerance) + (let* ((guile-sqrt (sqrt x)) + (custom-sqrt (sqrt-with-tolerance x tolerance))) + (if (eqv? guile-sqrt custom-sqrt) + (cons tolerance custom-sqrt) + (cons (cons tolerance custom-sqrt) + (tolerances-and-sqrt x (/ tolerance 10)))))) +;;;; end yak shaving + +;;; start excercise 1.1.7 +(define (good-enough-alt? guess prev-guess) + (< (abs (- guess prev-guess)) 0.001)) + +(define (sqrt-iter-alt guess prev-guess x) + (if (good-enough-alt? guess prev-guess) + guess + (sqrt-iter-alt (improve guess x) guess + x))) + +(define (sqrt-sicp-alt x) + (sqrt-iter-alt 1.0 2.0 x)) +;;;; end excercise 1.1.7 diff --git a/net/ricketyspace/sicp/one/six.scm b/net/ricketyspace/sicp/one/six.scm @@ -0,0 +1,40 @@ +;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;; International. See +;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +(define-module (net ricketyspace sicp one six) + #:export (sqrt-sicp sqrt-nif square good-enough? new-if improve)) + +(define (square x) + (* x x)) + +(define (good-enough? guess x) + (< (abs (- (square guess) x)) 0.001)) + +(define (average x y) + (/ (+ x y) 2)) + +(define (improve guess x) + (average guess (/ x guess))) + +(define (new-if predicate then-clause else-clause) + (cond (predicate then-clause) + (else else-clause))) + +(define (sqrt-iter guess x) + (if (good-enough? guess x) + guess + (sqrt-iter (improve guess x) + x))) + +(define (sqrt-iter-nif guess x) + (new-if (good-enough? guess x) + guess + (sqrt-iter-nif (improve guess x) + x))) + +(define (sqrt-sicp x) + (sqrt-iter 1.0 x)) + +(define (sqrt-nif x) + (sqrt-iter-nif 1.0 x)) diff --git a/net/ricketyspace/sicp/one/three.scm b/net/ricketyspace/sicp/one/three.scm @@ -0,0 +1,36 @@ +;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;; International. See +;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +(define-module (net ricketyspace sicp one three) + #:export (square sum-of-squares largest first-arg-2nd-largest-p + sum-of-squares-of-largest-two)) + +(define (square x) (* x x)) + +(define (sum-of-squares x y) + (+ (square x) (square y))) + +(define (largest x y z) + (cond ((and (>= x y) + (>= x z)) x) + ((and (>= y x) + (>= y z)) y) + ((and (>= z x) + (>= z y)) z))) + +(define (first-arg-2nd-largest-p x y z) + (or (and (>= x y) + (<= x z)) + (and (<= x y) + (>= x z)) + )) + +(define (sum-of-squares-of-largest-two x y z) + (sum-of-squares (largest x y z) + (cond ((first-arg-2nd-largest-p x y z) + x) + ((first-arg-2nd-largest-p y x z) + y) + ((first-arg-2nd-largest-p z x y) + z)))) diff --git a/net/ricketyspace/sicp/one/twelve.scm b/net/ricketyspace/sicp/one/twelve.scm @@ -0,0 +1,58 @@ +;;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;;; International. See +;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. + +;;; ____________________________ +;;; < pascal's fucking triangle. > +;;; ---------------------------- +;;; \ __ +;;; \ (--) +;;; \ ( ) +;;; \ /--\ +;;; __ / \ \ +;;; U--U\.'@@@@@@`.\ ) +;;; \__/(@@@@@@@@@@) / +;;; (@@@@@@@@)(( +;;; `YY~~~~YY' \\ +;;; || || >> +;;; + +(define-module (net ricketyspace sicp one twelve) + #:export (compute-triangle + compute-line + display-line + value-at + print-triangle + print-line)) + +(define (compute-triangle n) + (cond ((= n 1) (list (compute-line n 1))) + (else (cons (compute-line n 1) + (compute-triangle (- n 1)))))) + +(define (compute-line n pos) + (cond ((> pos n) '()) + (else + (cons (value-at n pos) + (compute-line n (+ pos 1)))))) + +(define (value-at line pos) + (cond ((= line 1) 1) + ((= pos 1) 1) + ((= line pos) 1) + (else (+ + (value-at (- line 1) (- pos 1)) + (value-at (- line 1) pos))))) + +;;;; printing + +(define (print-triangle tl level) + (cond ((= (length tl) 0) #t) + (else + (print-triangle (cdr tl) (+ 1 level)) + (print-line (car tl) level)))) + +(define (print-line l level) + (let* ((l (map number->string l)) + (line (string-join l))) + (format #t "~a\n" line))) diff --git a/one/eight.scm b/one/eight.scm @@ -1,38 +0,0 @@ -;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;; International. See -;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -(define-module (one eight) - #:export (cube double - div-three improve - good-enough? cbrt-iter - cbrt-sicp)) - -(use-modules (one six)) - -(define (cube x) - (* (square x) x)) - -(define (double x) - (* 2 x)) - -(define (div-three x) - (/ x 3.0)) - -(define (improve y x) - (div-three (+ (/ x (square y)) - (double y)))) - -(define (good-enough? y x) - (< (abs (- (cube y) x)) - 0.001)) - -(define (cbrt-iter y x) - (if (good-enough? y x) - y - (cbrt-iter (improve y x) - x))) - -(define (cbrt-sicp x) - (cbrt-iter 1.0 x)) - diff --git a/one/eleven.scm b/one/eleven.scm @@ -1,41 +0,0 @@ -;;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;;; International. See -;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -(define-module (one eleven) - #:export (recursive-fn - make-cache - alt-recursive-fn)) - -(define (recursive-fn n) - (cond ((<= n 3) n) - (else (+ (* 1 (recursive-fn (- n 1))) - (* 2 (recursive-fn (- n 2))) - (* 3 (recursive-fn (- n 3))))))) - -;;;; alternative version. faster but ugly. - -(define (make-cache) - (let ((cache (make-hash-table))) - (define (get key) - (hash-get-handle cache key)) - (define (set key value) - (hash-create-handle! cache key value) - ;; return value as a side effect. - value) - (lambda args - (apply (case (car args) - ((get) get) - ((set) set) - (else (error "Invalid method"))) - (cdr args))))) - -(define (alt-recursive-fn cache n) - (let ((v (cache 'get n))) - (cond (v (cdr v)) - ((<= n 3) - (cache 'set n n)) - (else (cache 'set n - (+ (* 1 (alt-recursive-fn cache (- n 1))) - (* 2 (alt-recursive-fn cache (- n 2))) - (* 3 (alt-recursive-fn cache (- n 3))))))))) diff --git a/one/fifteen.scm b/one/fifteen.scm @@ -1,31 +0,0 @@ -;;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;;; International. See -;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -(define-module (one fifteen) - #:use-module (ice-9 regex) - #:export (sine)) - -(define (sine angle) - (let ((out "")) - (define (log angle) - (set! out (string-append out " (p (sine " - (number->string (/ angle 3.0))))) - (define (close-parens s) - (string-trim (string-append - s (fold-matches "\\([p,s]" s "" - (lambda (match prev) - (string-append prev ")")))))) - (define (cube x) (* x x x)) - (define (p x) (- (* 3 x) (* 4 (cube x)))) - (define (s angle) - (if (not (> (abs angle) 0.1)) - angle - (begin - (log angle) - (p (s (/ angle 3.0)))))) - (s angle) - (close-parens out))) -;; -;; (sine 12.15) -;; $25 = "(p (sine 4.05 (p (sine 1.3499999999999999 (p (sine 0.44999999999999996 (p (sine 0.15 (p (sine 0.049999999999999996))))))))))" diff --git a/one/five.scm b/one/five.scm @@ -1,13 +0,0 @@ -;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;; International. See -;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -(define-module (one five) - #:export (p test)) - -(define (p) (p)) - -(define (test x y) - (if (= x 0) - 0 - y)) diff --git a/one/fourteen.scm b/one/fourteen.scm @@ -1,43 +0,0 @@ -;;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;;; International. See -;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -;;; adapted from section 1.2.2 -;;; intolerable scheme drivel; ignore it. - -(define-module (one fourteen) - #:export (get-cc - cc-range - cc-diff-list)) - -(define (get-cc) - (let ((no-of-steps 0)) - (define (cc amount kinds-of-coins) - (set! no-of-steps (1+ no-of-steps)) - (cond ((= amount 0) 1) - ((or (< amount 0) (= kinds-of-coins 0)) 0) - (else (+ (cc amount - (- kinds-of-coins 1)) - (cc (- amount - (first-denomination kinds-of-coins)) - kinds-of-coins))))) - (define (first-denomination kinds-of-coins) - (cond ((= kinds-of-coins 1) 1) - ((= kinds-of-coins 2) 5) - ((= kinds-of-coins 3) 10) - ((= kinds-of-coins 4) 25) - ((= kinds-of-coins 5) 50))) - (lambda (amount) - (cc amount 5) - no-of-steps))) - -(define (cc-range amount limit incr) - (cond ((> amount limit) '()) - ((<= amount limit) - (cons ((get-cc) amount) - (cc-range (+ amount incr) limit incr))))) - -(define (cc-diff-list l) - (cond ((= (length l) 1) '()) - ((> (length l) 1) (cons (+ (* -1 (car l)) (cadr l)) - (cc-diff-list (cdr l)))))) diff --git a/one/seven.scm b/one/seven.scm @@ -1,49 +0,0 @@ -;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;; International. See -;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -(define-module (one seven) - #:export (tolerances-and-sqrt - good-enough-alt? - sqrt-iter-alt - sqrt-sicp-alt)) - -(use-modules (one six)) - -;;;; start yak shaving -(define (gen-good-enough tolerance) - (lambda (guess x) - (< (abs (- (square guess) x)) tolerance))) - -(define (sqrt-iter-with-tolerance guess x tolerance) - (let ((good-enough? (gen-good-enough tolerance))) - (if (good-enough? guess x) - guess - (sqrt-iter-with-tolerance (improve guess x) - x tolerance)))) - -(define (sqrt-with-tolerance x tolerance) - (sqrt-iter-with-tolerance 1.0 x tolerance)) - -(define (tolerances-and-sqrt x tolerance) - (let* ((guile-sqrt (sqrt x)) - (custom-sqrt (sqrt-with-tolerance x tolerance))) - (if (eqv? guile-sqrt custom-sqrt) - (cons tolerance custom-sqrt) - (cons (cons tolerance custom-sqrt) - (tolerances-and-sqrt x (/ tolerance 10)))))) -;;;; end yak shaving - -;;; start excercise 1.1.7 -(define (good-enough-alt? guess prev-guess) - (< (abs (- guess prev-guess)) 0.001)) - -(define (sqrt-iter-alt guess prev-guess x) - (if (good-enough-alt? guess prev-guess) - guess - (sqrt-iter-alt (improve guess x) guess - x))) - -(define (sqrt-sicp-alt x) - (sqrt-iter-alt 1.0 2.0 x)) -;;;; end excercise 1.1.7 diff --git a/one/six.scm b/one/six.scm @@ -1,40 +0,0 @@ -;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;; International. See -;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -(define-module (one six) - #:export (sqrt-sicp sqrt-nif square good-enough? new-if improve)) - -(define (square x) - (* x x)) - -(define (good-enough? guess x) - (< (abs (- (square guess) x)) 0.001)) - -(define (average x y) - (/ (+ x y) 2)) - -(define (improve guess x) - (average guess (/ x guess))) - -(define (new-if predicate then-clause else-clause) - (cond (predicate then-clause) - (else else-clause))) - -(define (sqrt-iter guess x) - (if (good-enough? guess x) - guess - (sqrt-iter (improve guess x) - x))) - -(define (sqrt-iter-nif guess x) - (new-if (good-enough? guess x) - guess - (sqrt-iter-nif (improve guess x) - x))) - -(define (sqrt-sicp x) - (sqrt-iter 1.0 x)) - -(define (sqrt-nif x) - (sqrt-iter-nif 1.0 x)) diff --git a/one/three.scm b/one/three.scm @@ -1,36 +0,0 @@ -;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;; International. See -;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -(define-module (one three) - #:export (square sum-of-squares largest first-arg-2nd-largest-p - sum-of-squares-of-largest-two)) - -(define (square x) (* x x)) - -(define (sum-of-squares x y) - (+ (square x) (square y))) - -(define (largest x y z) - (cond ((and (>= x y) - (>= x z)) x) - ((and (>= y x) - (>= y z)) y) - ((and (>= z x) - (>= z y)) z))) - -(define (first-arg-2nd-largest-p x y z) - (or (and (>= x y) - (<= x z)) - (and (<= x y) - (>= x z)) - )) - -(define (sum-of-squares-of-largest-two x y z) - (sum-of-squares (largest x y z) - (cond ((first-arg-2nd-largest-p x y z) - x) - ((first-arg-2nd-largest-p y x z) - y) - ((first-arg-2nd-largest-p z x y) - z)))) diff --git a/one/twelve.scm b/one/twelve.scm @@ -1,58 +0,0 @@ -;;;; Under Creative Commons Attribution-ShareAlike 4.0 -;;;; International. See -;;;; <https://creativecommons.org/licenses/by-sa/4.0/>. - -;;; ____________________________ -;;; < pascal's fucking triangle. > -;;; ---------------------------- -;;; \ __ -;;; \ (--) -;;; \ ( ) -;;; \ /--\ -;;; __ / \ \ -;;; U--U\.'@@@@@@`.\ ) -;;; \__/(@@@@@@@@@@) / -;;; (@@@@@@@@)(( -;;; `YY~~~~YY' \\ -;;; || || >> -;;; - -(define-module (one twelve) - #:export (compute-triangle - compute-line - display-line - value-at - print-triangle - print-line)) - -(define (compute-triangle n) - (cond ((= n 1) (list (compute-line n 1))) - (else (cons (compute-line n 1) - (compute-triangle (- n 1)))))) - -(define (compute-line n pos) - (cond ((> pos n) '()) - (else - (cons (value-at n pos) - (compute-line n (+ pos 1)))))) - -(define (value-at line pos) - (cond ((= line 1) 1) - ((= pos 1) 1) - ((= line pos) 1) - (else (+ - (value-at (- line 1) (- pos 1)) - (value-at (- line 1) pos))))) - -;;;; printing - -(define (print-triangle tl level) - (cond ((= (length tl) 0) #t) - (else - (print-triangle (cdr tl) (+ 1 level)) - (print-line (car tl) level)))) - -(define (print-line l level) - (let* ((l (map number->string l)) - (line (string-join l))) - (format #t "~a\n" line)))