blob: fcaff0be90b85ac44ed709a3ad71d0b0318edd02 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
#lang racket
(provide install-arithmetic-package
make-integer
test-integer
make-rat
test-rat
make-real
test-real
make-complex
test-complex
make-complex-rect
test-complex-rect
make-complex-polar
;test-complex-polar
term
dense-termlist
sparse-termlist
make-polynomial
; test-poly1
; test-poly2
; test-poly3
=zero?
equ?
add
sub
mul
div
sinme
cosme
atanme
sqrme
sqrtme
raiseme
dropme)
(require "./install-integer.rkt"
"./install-rational.rkt"
"./install-real.rkt"
"./install-complex.rkt"
"./polynomials.rkt"
"../../../shared/data-directed-programming.rkt")
(define pkg (make-dispatch-table))
(define get (getter pkg))
(define put (putter pkg))
(define print-tbl (printer pkg))
(define apply-fn (make-apply-with-raising-and-drop
get))
(install-integer put get)
(install-rational get put apply-fn)
(install-real put get)
(install-complex apply-fn get put)
(install-polynomial get put apply-fn)
(define (install-arithmetic-package)
(list get put apply-fn))
;; constructors
;; integer
(define (make-integer n)
((get 'make 'integer) n))
(define test-integer (make-integer 3))
;; rational
(define (make-rat n d)
((get 'make 'rational) n d))
(define test-rat (make-rat 5 2))
;; real
(define (make-real n)
((get 'make 'real) n))
(define test-real (make-real 1.5))
;; complex
(define (make-complex x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-rect x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-polar x y)
((get 'make-from-mag-ang 'complex) x y))
(define test-complex (make-complex 1 2))
(define test-complex-rect (make-complex-rect 1 2))
(display (apply-fn 'magnitude test-complex))
;; (define test-complex-polar (make-complex-polar (apply-fn 'magnitude test-complex) (apply-fn 'angle test-complex)))
;; polynomial
(define (term order coeff)
((get 'make-from-order-coeff 'term) order coeff))
(define (sparse-termlist . terms)
((get 'make-from-terms 'sparse-termlist) terms))
(define (dense-termlist . terms)
((get 'make-from-terms 'dense-termlist) terms))
(define (make-polynomial var terms)
((get 'make 'polynomial) var terms))
; (define test-poly1 (make-polynomial 'x (sparse-termlist
; (term 1 test-integer)))
; (define test-poly2 (make-polynomial 'x (sparse-termlist
; (term 100 test-complex)
; (term 2 test-real)
; (term 1 test-rat)
; (term 0 test-integer))))
; (define test-poly3 (make-polynomial 'x (sparse-termlist
; (term 50 test-rat)
; (term 0 2))))
;; generic methods
(define (equ? a1 a2)
(apply-fn 'equ? a2))
(define (=zero? datum)
(apply-fn '=zero? datum))
(define (add a1 a2)
(apply-fn 'add a1 a2))
(define (neg a)
(apply-fn 'neg a))
(define (sub a1 a2)
(apply-fn 'sub a1 a2))
(define (mul a1 a2)
(apply-fn 'mul a1 a2))
(define (div a1 a2)
(apply-fn 'div a1 a2))
(define (raiseme datum)
(apply-fn 'raise datum))
(define (dropme datum)
(apply-fn 'project datum))
(define (sqrme datum)
(apply-fn 'sqr datum))
(define (sqrtme datum)
(apply-fn 'sqrt datum))
(define (cosme datum)
(apply-fn 'cos datum))
(define (sinme datum)
(apply-fn 'sin datum))
(define (atanme a1 a2)
(apply-fn 'atan a2))
|
