summaryrefslogtreecommitdiffstats
path: root/net/ricketyspace
diff options
context:
space:
mode:
Diffstat (limited to 'net/ricketyspace')
-rw-r--r--net/ricketyspace/sicp/one/eight.scm38
-rw-r--r--net/ricketyspace/sicp/one/eleven.scm41
-rw-r--r--net/ricketyspace/sicp/one/fifteen.scm31
-rw-r--r--net/ricketyspace/sicp/one/five.scm13
-rw-r--r--net/ricketyspace/sicp/one/fourteen.scm43
-rw-r--r--net/ricketyspace/sicp/one/seven.scm49
-rw-r--r--net/ricketyspace/sicp/one/six.scm40
-rw-r--r--net/ricketyspace/sicp/one/three.scm36
-rw-r--r--net/ricketyspace/sicp/one/twelve.scm58
9 files changed, 349 insertions, 0 deletions
diff --git a/net/ricketyspace/sicp/one/eight.scm b/net/ricketyspace/sicp/one/eight.scm
new file mode 100644
index 0000000..8157c23
--- /dev/null
+++ 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
new file mode 100644
index 0000000..baa129b
--- /dev/null
+++ 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
new file mode 100644
index 0000000..a61fa8f
--- /dev/null
+++ 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
new file mode 100644
index 0000000..f387919
--- /dev/null
+++ 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
new file mode 100644
index 0000000..923c088
--- /dev/null
+++ 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
new file mode 100644
index 0000000..9bda339
--- /dev/null
+++ 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
new file mode 100644
index 0000000..c1125ec
--- /dev/null
+++ 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
new file mode 100644
index 0000000..3546fc9
--- /dev/null
+++ 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
new file mode 100644
index 0000000..7d31561
--- /dev/null
+++ 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)))