summaryrefslogtreecommitdiffstats
path: root/one
diff options
context:
space:
mode:
authorrsiddharth <s@ricketyspace.net>2017-01-14 21:44:28 +0000
committerrsiddharth <s@ricketyspace.net>2017-01-14 21:44:28 +0000
commit19ed602c1ba7dc2b933274f50085c9c4f0f1105c (patch)
tree5f4ddb70cb61cf509d6a74bbfa4ccde0c9227fc5 /one
parent8d6bb0aee4679f874ddfb6f7edd8945852cb9c99 (diff)
one -> net/ricketyspace/sicp
Diffstat (limited to 'one')
-rw-r--r--one/eight.scm38
-rw-r--r--one/eleven.scm41
-rw-r--r--one/fifteen.scm31
-rw-r--r--one/five.scm13
-rw-r--r--one/fourteen.scm43
-rw-r--r--one/seven.scm49
-rw-r--r--one/six.scm40
-rw-r--r--one/three.scm36
-rw-r--r--one/twelve.scm58
9 files changed, 0 insertions, 349 deletions
diff --git a/one/eight.scm b/one/eight.scm
deleted file mode 100644
index fb944e7..0000000
--- a/one/eight.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index a95b7ab..0000000
--- a/one/eleven.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index 0698bb8..0000000
--- a/one/fifteen.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index fe7a463..0000000
--- a/one/five.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index 4186238..0000000
--- a/one/fourteen.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index 0c78ab8..0000000
--- a/one/seven.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index e60d1ee..0000000
--- a/one/six.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index 8b4c622..0000000
--- a/one/three.scm
+++ /dev/null
@@ -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
deleted file mode 100644
index 165a66b..0000000
--- a/one/twelve.scm
+++ /dev/null
@@ -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)))