1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #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 12687dd9 2023-08-04 jrmu (define-struct inex (mantissa sign exponent))
6 12687dd9 2023-08-04 jrmu ;An inexact number (inex) is a structure
7 12687dd9 2023-08-04 jrmu ;(make-inex m s e)
8 12687dd9 2023-08-04 jrmu ;where m, e are N in the interval [0,99] and s is either +1 or -1.
10 12687dd9 2023-08-04 jrmu ;create-inex : N N N -> inex
11 12687dd9 2023-08-04 jrmu ;Creates an inex from mantissa, sign, and exponent.
13 12687dd9 2023-08-04 jrmu (define (create-inex mantissa sign exponent)
15 12687dd9 2023-08-04 jrmu [(and (<= 0 mantissa 99)
16 12687dd9 2023-08-04 jrmu (<= 0 exponent 99)
17 12687dd9 2023-08-04 jrmu (= (abs sign) 1)) (make-inex mantissa sign exponent)]
18 12687dd9 2023-08-04 jrmu [else (error 'create-inex "(<= 0 m 99), +1 or -1, (<= 0 e 99) expected")]))
20 12687dd9 2023-08-04 jrmu ;inex->number : inex -> number
21 12687dd9 2023-08-04 jrmu ;Given an-inex, convert it to an exact number.
23 12687dd9 2023-08-04 jrmu (define (inex->number an-inex)
24 12687dd9 2023-08-04 jrmu (* (inex-mantissa an-inex)
25 12687dd9 2023-08-04 jrmu (expt 10 (* (inex-sign an-inex) (inex-exponent an-inex)))))
28 12687dd9 2023-08-04 jrmu ;(equal? (inex->number (create-inex 55 -1 3)) 0.055)
32 12687dd9 2023-08-04 jrmu ;inex+ : inex inex -> inex
33 12687dd9 2023-08-04 jrmu ;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.
35 12687dd9 2023-08-04 jrmu (define (inex+ inex1 inex2)
37 12687dd9 2023-08-04 jrmu [(and (inex? inex1)
38 12687dd9 2023-08-04 jrmu (inex? inex2)
39 12687dd9 2023-08-04 jrmu (= (inex-sign inex1) (inex-sign inex2))
40 12687dd9 2023-08-04 jrmu (= (inex-exponent inex1) (inex-exponent inex2)))
41 12687dd9 2023-08-04 jrmu (create-adjusted-inex (+ (inex-mantissa inex1) (inex-mantissa inex2))
42 12687dd9 2023-08-04 jrmu (inex-sign inex1)
43 12687dd9 2023-08-04 jrmu (inex-exponent inex1))]
44 12687dd9 2023-08-04 jrmu [else (error 'inex+ "addition failed")]))
48 12687dd9 2023-08-04 jrmu ;inex+ : inex inex -> inex
49 12687dd9 2023-08-04 jrmu ;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.
51 12687dd9 2023-08-04 jrmu (define (inex+ inex1 inex2)
53 12687dd9 2023-08-04 jrmu [(and (inex? inex1)
54 12687dd9 2023-08-04 jrmu (inex? inex2))
55 12687dd9 2023-08-04 jrmu (local ((define expdiff (- (* (inex-sign inex1) (inex-exponent inex1))
56 12687dd9 2023-08-04 jrmu (* (inex-sign inex2) (inex-exponent inex2)))))
58 12687dd9 2023-08-04 jrmu [(= expdiff 0)
59 12687dd9 2023-08-04 jrmu (create-adjusted-inex (+ (inex-mantissa inex1) (inex-mantissa inex2))
60 12687dd9 2023-08-04 jrmu (inex-sign inex1)
61 12687dd9 2023-08-04 jrmu (inex-exponent inex1))]
62 12687dd9 2023-08-04 jrmu [(= expdiff 1)
63 12687dd9 2023-08-04 jrmu (create-adjusted-inex (+ (* (inex-mantissa inex1) 10) (inex-mantissa inex2))
64 12687dd9 2023-08-04 jrmu (inex-sign inex2)
65 12687dd9 2023-08-04 jrmu (inex-exponent inex2))]
66 12687dd9 2023-08-04 jrmu [(= expdiff -1)
67 12687dd9 2023-08-04 jrmu (create-adjusted-inex (+ (inex-mantissa inex1) (* (inex-mantissa inex2) 10))
68 12687dd9 2023-08-04 jrmu (inex-sign inex1)
69 12687dd9 2023-08-04 jrmu (inex-exponent inex1))]
70 12687dd9 2023-08-04 jrmu [else (error 'inex+ "addition failed")]))]
71 12687dd9 2023-08-04 jrmu [else (error 'inex+ "addition failed")]))
73 12687dd9 2023-08-04 jrmu ;create-adjusted-inex : N N N -> inex
74 12687dd9 2023-08-04 jrmu ;Given mantissa, sign, and exponent, create an inex such that both the mantissa and exponent are in the interval [0,99]
76 12687dd9 2023-08-04 jrmu (define (create-adjusted-inex mantissa sign exponent)
78 12687dd9 2023-08-04 jrmu [(and (<= 0 mantissa 99)
79 12687dd9 2023-08-04 jrmu (= (abs sign) 1)
80 12687dd9 2023-08-04 jrmu (<= 1 exponent 99))
81 12687dd9 2023-08-04 jrmu (make-inex (round mantissa)
82 12687dd9 2023-08-04 jrmu (round sign)
83 12687dd9 2023-08-04 jrmu (round exponent))]
84 12687dd9 2023-08-04 jrmu [(and (<= 0 mantissa 99)
85 12687dd9 2023-08-04 jrmu (= (abs sign) 1)
86 12687dd9 2023-08-04 jrmu (= 0 exponent))
87 12687dd9 2023-08-04 jrmu (make-inex (round mantissa)
89 12687dd9 2023-08-04 jrmu (round exponent))]
90 12687dd9 2023-08-04 jrmu [(and (<= 100 mantissa)
92 12687dd9 2023-08-04 jrmu (<= 0 exponent 99))
93 12687dd9 2023-08-04 jrmu (create-adjusted-inex (/ mantissa 10) sign (+ exponent 1))]
94 12687dd9 2023-08-04 jrmu [(and (<= 100 mantissa)
96 12687dd9 2023-08-04 jrmu (<= 2 exponent 99))
97 12687dd9 2023-08-04 jrmu (create-adjusted-inex (/ mantissa 10) sign (- exponent 1))]
98 12687dd9 2023-08-04 jrmu [(and (<= 100 mantissa)
100 12687dd9 2023-08-04 jrmu (= 1 exponent))
101 12687dd9 2023-08-04 jrmu (create-adjusted-inex (/ mantissa 10) +1 (- exponent 1))]
102 12687dd9 2023-08-04 jrmu [(and (<= 100 mantissa)
103 12687dd9 2023-08-04 jrmu (= sign -1)
104 12687dd9 2023-08-04 jrmu (= 0 exponent))
105 12687dd9 2023-08-04 jrmu (create-adjusted-inex (/ mantissa 10) +1 (+ exponent 1))]
106 12687dd9 2023-08-04 jrmu [else (error 'create-adjusted-inex "out-of-bounds")]))
108 12687dd9 2023-08-04 jrmu (define (create-adjusted-inex mantissa sign exponent)
110 12687dd9 2023-08-04 jrmu [(and (<= 0 mantissa 99)
111 12687dd9 2023-08-04 jrmu (= (abs sign) 1)
112 12687dd9 2023-08-04 jrmu (<= 0 exponent 99))
113 12687dd9 2023-08-04 jrmu (make-inex (round mantissa)
114 12687dd9 2023-08-04 jrmu (signof (* sign exponent))
115 12687dd9 2023-08-04 jrmu (round (abs exponent)))]
116 12687dd9 2023-08-04 jrmu [(and (<= 100 mantissa)
117 12687dd9 2023-08-04 jrmu (>= (* sign exponent) 0))
118 12687dd9 2023-08-04 jrmu (create-adjusted-inex (/ mantissa 10) (signof (* sign exponent)) (+ exponent 1))]
119 12687dd9 2023-08-04 jrmu [(and (<= 100 mantissa)
120 12687dd9 2023-08-04 jrmu (< (* sign exponent) 0))
121 12687dd9 2023-08-04 jrmu (create-adjusted-inex (/ mantissa 10) (signof (* sign (- exponent 1))) (- exponent 1))]
122 12687dd9 2023-08-04 jrmu [else (error 'create-adjusted-inex "out-of-bounds")]))
124 12687dd9 2023-08-04 jrmu (define (signof n)
126 12687dd9 2023-08-04 jrmu [(>= n 0) +1]
127 12687dd9 2023-08-04 jrmu [else -1]))
130 12687dd9 2023-08-04 jrmu ;signals an error
131 12687dd9 2023-08-04 jrmu ;(inex+ (make-inex 1923 1 99) (make-inex 2422 1 99))
133 12687dd9 2023-08-04 jrmu ;inex* : inex inex -> inex
134 12687dd9 2023-08-04 jrmu ;Multiplies inex1 by inex2.
136 12687dd9 2023-08-04 jrmu (define (inex* inex1 inex2)
137 12687dd9 2023-08-04 jrmu (local ((define newexp (+ (* (inex-sign inex1) (inex-exponent inex1))
138 12687dd9 2023-08-04 jrmu (* (inex-sign inex2) (inex-exponent inex2)))))
139 12687dd9 2023-08-04 jrmu (create-adjusted-inex (* (inex-mantissa inex1) (inex-mantissa inex2))
140 12687dd9 2023-08-04 jrmu (signof newexp)
141 12687dd9 2023-08-04 jrmu (abs newexp))))
143 12687dd9 2023-08-04 jrmu (and (equal? (inex+ (make-inex 55 -1 1) (make-inex 55 -1 1)) (make-inex 11 1 0))
144 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 20 -1 1) (make-inex 80 -1 1)) (make-inex 10 1 0))
145 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 16 -1 0) (make-inex 84 -1 0)) (make-inex 10 1 1))
146 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 55 1 0) (make-inex 55 1 0)) (make-inex 11 1 1))
147 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 55 -1 1) (make-inex 55 -1 1)) (make-inex 11 1 0))
148 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 955 -1 0) (make-inex 405 -1 0)) (make-inex 14 1 2))
149 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 9655 1 1) (make-inex 5565 1 1)) (make-inex 15 1 4))
150 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 9855 -1 1) (make-inex 9955 -1 1)) (make-inex 20 1 2))
151 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 23 -1 50) (make-inex 22 -1 50)) (make-inex 45 -1 50))
152 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 5423 -1 50) (make-inex 9622 -1 50)) (make-inex 15 -1 47))
153 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 1923 -1 99) (make-inex 2422 -1 99)) (make-inex 43 -1 97))
154 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 1 -1 99) (make-inex 1 -1 99)) (make-inex 2 -1 99))
155 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 5 -1 3) (make-inex 5 -1 4)) (make-inex 55 -1 4))
156 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 5 -1 3) (make-inex 5 -1 2)) (make-inex 55 -1 3))
157 12687dd9 2023-08-04 jrmu (equal? (inex+ (make-inex 5 1 99) (make-inex 45 1 98)) (make-inex 95 1 98))
158 12687dd9 2023-08-04 jrmu (equal? (inex* (make-inex 55 -1 1) (make-inex 55 -1 1)) (make-inex 30 1 0)))
