From: Ramakrishnan Muthukrishnan Date: Sun, 17 Jun 2012 12:43:15 +0000 (+0530) Subject: solutions to 4.35, 4.36 and 4.37 X-Git-Url: https://git.rkrishnan.org/?p=sicp.git;a=commitdiff_plain;h=16ffd75b36a5dbfbda3da703c2732f8f49208c11 solutions to 4.35, 4.36 and 4.37 --- diff --git a/src/sicp/amb-eli.rkt b/src/sicp/amb-eli.rkt new file mode 100644 index 0000000..737fd82 --- /dev/null +++ b/src/sicp/amb-eli.rkt @@ -0,0 +1,42 @@ +#lang racket +(provide amb assert) + +(define failures null) + +(define (fail) + (if (pair? failures) + ((first failures)) + (error "no more choices!"))) + +(define (amb/thunks choices) + (let/cc k (set! failures (cons k failures))) + (if (pair? choices) + (let ([choice (first choices)]) + (set! choices (rest choices)) + (choice)) + (begin (set! failures (rest failures)) + (fail)))) + +(define-syntax-rule (amb E ...) + (amb/thunks (list (lambda () E) ...))) + +(define (assert condition) + (unless condition (fail))) + +(define (collect/thunk n thunk) + (define results null) + (let/cc too-few + (set! failures (list too-few)) + (define result (thunk)) + (set! results (cons result results)) + (set! n (sub1 n)) + (unless (zero? n) (fail))) + (set! failures null) + (reverse results)) + +(define-syntax collect + (syntax-rules () + ;; collect N results + [(_ N E) (collect/thunk N (lambda () E))] + ;; collect all results + [(_ E) (collect/thunk -1 (lambda () E))])) diff --git a/src/sicp/ex4_35.scm b/src/sicp/ex4_35.scm new file mode 100644 index 0000000..f1b57da --- /dev/null +++ b/src/sicp/ex4_35.scm @@ -0,0 +1,33 @@ +;; done in Chicken scheme which has a builtin amb operator +;; - can be installed with +;; $ chicken-install amb + +(use amb) +(use srfi-1) + +(define (require p) + (if (not p) (amb))) + +(define (an-element-of items) + (require (not (null? items))) + (amb (car items) (an-element-of (cdr items)))) + +(define (an-integer-between low high) + (let [(count (- high low))] + (let [(items (iota count low))] + (an-element-of items)))) + +(define (a-pythagorean-triple-between low high) + (let ((i (an-integer-between low high))) + (let ((j (an-integer-between i high))) + (let ((k (an-integer-between j high))) + (require (= (+ (* i i) (* j j)) (* k k))) + (list i j k))))) + +;; another implementation +(define (an-integer-between-2 low high) + (require (< low high)) + (amb low (an-integer-between-2 (+ low 1) high))) + +;; play with it +(a-pythagorean-triple-between 1 20) diff --git a/src/sicp/ex4_36.rkt b/src/sicp/ex4_36.rkt new file mode 100644 index 0000000..5c9ec2d --- /dev/null +++ b/src/sicp/ex4_36.rkt @@ -0,0 +1,28 @@ +#lang racket + +(require "amb-eli.rkt") + +(define (an-integer-starting-from n) + (amb n (an-integer-starting-from (+ n 1)))) + +(define (an-integer-between low high) + (assert (< low high)) + (amb low (an-integer-between (+ low 1) high))) + +#| + +If we replace an-integer-between with an-integer-starting-from, then +the k grows too high to invalid ranges and never stops. The way to accomplish +correct values is to restrict i, j and k to valid ranges. + +|# + +;; using euclid's formula +;; http://en.wikipedia.org/wiki/Pythagorean_triple#Generating_a_triple +(define (pythagorean-triples) + (let [(n (an-integer-starting-from 1))] + (let [(m (an-integer-starting-from n))] + (assert (> m n)) + (list (- (sqr m) (sqr n)) + (* 2 m n) + (+ (sqr m) (sqr n)))))) \ No newline at end of file diff --git a/src/sicp/ex4_37.rkt b/src/sicp/ex4_37.rkt new file mode 100644 index 0000000..a4528a0 --- /dev/null +++ b/src/sicp/ex4_37.rkt @@ -0,0 +1,25 @@ +#lang racket + +(require "amb-eli.rkt") + +(define (a-pythagorean-triple-between low high) + (let ((i (an-integer-between low high)) + (hsq (* high high))) + (let ((j (an-integer-between i high))) + (let ((ksq (+ (* i i) (* j j)))) + (assert (>= hsq ksq)) + (let ((k (sqrt ksq))) + (assert (integer? k)) + (list i j k)))))) + +#| + +Yes, Ben is correct. The above program prunes the search space by restricting the +possible values of k. + +k^2 <= high^2 + +and sqrt (i^2 + j^2) is an integer. This eliminates a large number of (i, j, k) triples +and hence the search space is a lot less than the naive implementation in the text. + +|#