From b7fb111bb23060f6d76004efb26510e99f97d849 Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Sat, 18 Aug 2018 16:20:21 +0000 Subject: Add (net ricketyspace sicp two eleven). * net/ricketyspace/sicp/two/eleven.scm: New file. --- net/ricketyspace/sicp/two/eleven.scm | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 net/ricketyspace/sicp/two/eleven.scm diff --git a/net/ricketyspace/sicp/two/eleven.scm b/net/ricketyspace/sicp/two/eleven.scm new file mode 100644 index 0000000..11d9dae --- /dev/null +++ b/net/ricketyspace/sicp/two/eleven.scm @@ -0,0 +1,31 @@ +;;;; Under Creative Commons Attribution-ShareAlike 4.0 +;;;; International. See +;;;; . + +(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")))) -- cgit v1.2.3