sicp

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

commit b7fb111bb23060f6d76004efb26510e99f97d849
parent 7ed2f6a8664e9c71f8972da58af5b4e3878b0f4b
Author: rsiddharth <s@ricketyspace.net>
Date:   Sat, 18 Aug 2018 16:20:21 +0000

Add (net ricketyspace sicp two eleven).

* net/ricketyspace/sicp/two/eleven.scm: New file.

Diffstat:
net/ricketyspace/sicp/two/eleven.scm | 31+++++++++++++++++++++++++++++++
1 file changed, 31 insertions(+), 0 deletions(-)

diff --git a/net/ricketyspace/sicp/two/eleven.scm b/net/ricketyspace/sicp/two/eleven.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 two eleven) + #:use-module (net ricketyspace sicp two seven) + #:export (mul-interval-alt)) + +(define (mul-interval-alt x y) + (define lbx (lower-bound x)) + (define ubx (upper-bound x)) + (define lby (lower-bound y)) + (define uby (upper-bound y)) + (define (n a) (< a 0)) ; is negative + (define (p a) (>= a 0)) ; is positive + (define (signs slbx subx slby suby) + (and (slbx lbx) + (subx ubx) + (slby lby) + (suby uby))) + (cond ((signs n p p p) (make-interval (* lbx uby) (* ubx uby))) + ((signs p p n p) (make-interval (* ubx lby) (* ubx uby))) + ((signs p p p p) (make-interval (* lbx lby) (* ubx uby))) + ((signs n n n n) (make-interval (* lbx lby) (* ubx uby))) + ((signs n n p p) (make-interval (* ubx uby) (* lbx lby))) + ((signs p p n n) (make-interval (* ubx uby) (* lbx lby))) + ((signs n n n p) (make-interval (* ubx uby) (* ubx lby))) + ((signs n p n n) (make-interval (* ubx uby) (* lbx uby))) + ((signs n p n p) (make-interval (min (* lbx uby) (* ubx lby)) + (* ubx uby))) + (else (error "Intervals not supported"))))