1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "htdp-advanced-reader.ss" "lang")((modname |33.1|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 (define-struct inex (mantissa sign exponent))
5 
6 ;An inexact number (inex) is a structure
7 ;(make-inex m s e)
8 ;where m, e are N in the interval [0,99] and s is either +1 or -1.
9 ;
10 ;create-inex : N N N -> inex
11 ;Creates an inex from mantissa, sign, and exponent.
12 
13 (define (create-inex mantissa sign exponent)
14   (cond
15     [(and (<= 0 mantissa 99)
16           (<= 0 exponent 99)
17           (= (abs sign) 1)) (make-inex mantissa sign exponent)]
18     [else (error 'create-inex "(<= 0 m 99), +1 or -1, (<= 0 e 99) expected")]))
19 
20 ;inex->number : inex -> number
21 ;Given an-inex, convert it to an exact number.
22 
23 (define (inex->number an-inex)
24   (* (inex-mantissa an-inex)
25      (expt 10 (* (inex-sign an-inex) (inex-exponent an-inex)))))
26 
27 ;;Test
28 ;(equal? (inex->number (create-inex 55 -1 3)) 0.055)
29 
30 #|
31 
32 ;inex+ : inex inex -> inex
33 ;Adds inex1 to inex2 if the two exponents equal.  Automatically changes the mantissa and exponent if the sum causes the mantissa to go out of bounds, and signals an error if the resulting inex is out of bounds.
34 
35 (define (inex+ inex1 inex2)
36   (cond
37     [(and (inex? inex1)
38           (inex? inex2)
39           (= (inex-sign inex1) (inex-sign inex2))
40           (= (inex-exponent inex1) (inex-exponent inex2)))
41      (create-adjusted-inex (+ (inex-mantissa inex1) (inex-mantissa inex2))
42                            (inex-sign inex1)
43                            (inex-exponent inex1))]
44     [else (error 'inex+ "addition failed")]))
45 
46 |#
47 
48 ;inex+ : inex inex -> inex
49 ;Adds inex1 to inex2 if the two exponents are equal or differ only by one.  Automatically changes the mantissa and exponent if the sum causes the mantissa to go out of bounds, and signals an error if the resulting inex is out of bounds.
50 
51 (define (inex+ inex1 inex2)
52   (cond
53     [(and (inex? inex1)
54           (inex? inex2))
55      (local ((define expdiff (- (* (inex-sign inex1) (inex-exponent inex1))
56                                 (* (inex-sign inex2) (inex-exponent inex2)))))
57        (cond
58          [(= expdiff 0)        
59           (create-adjusted-inex (+ (inex-mantissa inex1) (inex-mantissa inex2))
60                                 (inex-sign inex1)
61                                 (inex-exponent inex1))]
62          [(= expdiff 1)
63           (create-adjusted-inex (+ (* (inex-mantissa inex1) 10) (inex-mantissa inex2))
64                                 (inex-sign inex2)
65                                 (inex-exponent inex2))]
66          [(= expdiff -1)
67           (create-adjusted-inex (+ (inex-mantissa inex1) (* (inex-mantissa inex2) 10))
68                                 (inex-sign inex1)
69                                 (inex-exponent inex1))]
70          [else (error 'inex+ "addition failed")]))]
71     [else (error 'inex+ "addition failed")]))
72 
73 ;create-adjusted-inex : N N N -> inex
74 ;Given mantissa, sign, and exponent, create an inex such that both the mantissa and exponent are in the interval [0,99]
75 #|
76 (define (create-adjusted-inex mantissa sign exponent)
77   (cond
78     [(and (<= 0 mantissa 99)
79           (= (abs sign) 1)
80           (<= 1 exponent 99))
81      (make-inex (round mantissa)
82                 (round sign)
83                 (round exponent))]
84     [(and (<= 0 mantissa 99)
85           (= (abs sign) 1)
86           (= 0 exponent))
87      (make-inex (round mantissa)
88                 +1
89                 (round exponent))]
90     [(and (<= 100 mantissa)
91           (= sign 1)
92           (<= 0 exponent 99))
93      (create-adjusted-inex (/ mantissa 10) sign (+ exponent 1))]    
94     [(and (<= 100 mantissa)
95           (= sign -1)
96           (<= 2 exponent 99))
97      (create-adjusted-inex (/ mantissa 10) sign (- exponent 1))]
98     [(and (<= 100 mantissa)
99           (= sign -1)
100           (= 1 exponent)) 
101      (create-adjusted-inex (/ mantissa 10) +1 (- exponent 1))]
102     [(and (<= 100 mantissa)
103           (= sign -1)
104           (= 0 exponent))
105      (create-adjusted-inex (/ mantissa 10) +1 (+ exponent 1))]
106     [else (error 'create-adjusted-inex "out-of-bounds")]))
107 |#
108 (define (create-adjusted-inex mantissa sign exponent)
109   (cond
110     [(and (<= 0 mantissa 99)
111           (= (abs sign) 1)
112           (<= 0 exponent 99))
113      (make-inex (round mantissa)
114                 (signof (* sign exponent))
115                 (round (abs exponent)))]
116     [(and (<= 100 mantissa)
117           (>= (* sign exponent) 0))
118      (create-adjusted-inex (/ mantissa 10) (signof (* sign exponent)) (+ exponent 1))]    
119     [(and (<= 100 mantissa)
120           (< (* sign exponent) 0))
121      (create-adjusted-inex (/ mantissa 10) (signof (* sign (- exponent 1))) (- exponent 1))]
122     [else (error 'create-adjusted-inex "out-of-bounds")]))
123 
124 (define (signof n)
125   (cond
126     [(>= n 0) +1]
127     [else -1]))
128 
129 
130 ;signals an error
131 ;(inex+ (make-inex 1923 1 99) (make-inex 2422 1 99))
132 
133 ;inex* : inex inex -> inex
134 ;Multiplies inex1 by inex2.
135 
136 (define (inex* inex1 inex2)
137   (local ((define newexp (+ (* (inex-sign inex1) (inex-exponent inex1)) 
138                             (* (inex-sign inex2) (inex-exponent inex2)))))
139     (create-adjusted-inex (* (inex-mantissa inex1) (inex-mantissa inex2))
140                           (signof newexp)
141                           (abs newexp))))
142 
143 (and (equal? (inex+ (make-inex 55 -1 1) (make-inex 55 -1 1)) (make-inex 11 1 0))
144      (equal? (inex+ (make-inex 20 -1 1) (make-inex 80 -1 1)) (make-inex 10 1 0))
145      (equal? (inex+ (make-inex 16 -1 0) (make-inex 84 -1 0)) (make-inex 10 1 1))
146      (equal? (inex+ (make-inex 55 1 0) (make-inex 55 1 0)) (make-inex 11 1 1))
147      (equal? (inex+ (make-inex 55 -1 1) (make-inex 55 -1 1)) (make-inex 11 1 0))
148      (equal? (inex+ (make-inex 955 -1 0) (make-inex 405 -1 0)) (make-inex 14 1 2))
149      (equal? (inex+ (make-inex 9655 1 1) (make-inex 5565 1 1)) (make-inex 15 1 4))
150      (equal? (inex+ (make-inex 9855 -1 1) (make-inex 9955 -1 1)) (make-inex 20 1 2))
151      (equal? (inex+ (make-inex 23 -1 50) (make-inex 22 -1 50)) (make-inex 45 -1 50))
152      (equal? (inex+ (make-inex 5423 -1 50) (make-inex 9622 -1 50)) (make-inex 15 -1 47))
153      (equal? (inex+ (make-inex 1923 -1 99) (make-inex 2422 -1 99)) (make-inex 43 -1 97))
154      (equal? (inex+ (make-inex 1 -1 99) (make-inex 1 -1 99)) (make-inex 2 -1 99))
155      (equal? (inex+ (make-inex 5 -1 3) (make-inex 5 -1 4)) (make-inex 55 -1 4))
156      (equal? (inex+ (make-inex 5 -1 3) (make-inex 5 -1 2)) (make-inex 55 -1 3))
157      (equal? (inex+ (make-inex 5 1 99) (make-inex 45 1 98)) (make-inex 95 1 98))
158      (equal? (inex* (make-inex 55 -1 1) (make-inex 55 -1 1)) (make-inex 30 1 0)))