blob: 8eed3e86584bbdd00a5971787bb350b3ab76dc95 (
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
(.module:
[lux #*
data/text/format
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
{[0 #test]
[/
["$." equivalence]
["$." order]
["$." number]
["$." codec]]}]
[data
[number
["." frac ("#@." number)]]
[collection
["." list ("#@." functor)]]]
["." math
["r" random (#+ Random)]]]
{1
["." / (#+ Complex)]})
(def: margin-of-error Frac +1.0e-9)
(def: (within? margin standard value)
(-> Frac Complex Complex Bit)
(let [real-dist (frac@abs (f/- (get@ #/.real standard)
(get@ #/.real value)))
imgn-dist (frac@abs (f/- (get@ #/.imaginary standard)
(get@ #/.imaginary value)))]
(and (f/< margin real-dist)
(f/< margin imgn-dist))))
(def: dimension
(Random Frac)
(do r.monad
[factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))
measure (|> r.safe-frac (r.filter (f/> +0.0)))]
(wrap (f/* (|> factor .int int-to-frac)
measure))))
(def: #export complex
(Random Complex)
(do r.monad
[real ..dimension
imaginary ..dimension]
(wrap (/.complex real imaginary))))
(def: construction
Test
(do r.monad
[real ..dimension
imaginary ..dimension]
($_ _.and
(_.test "Can build and tear apart complex numbers"
(let [r+i (/.complex real imaginary)]
(and (f/= real (get@ #/.real r+i))
(f/= imaginary (get@ #/.imaginary r+i)))))
(_.test "If either the real part or the imaginary part is NaN, the composite is NaN."
(and (/.not-a-number? (/.complex frac.not-a-number imaginary))
(/.not-a-number? (/.complex real frac.not-a-number))))
)))
(def: absolute-value
Test
(do r.monad
[real ..dimension
imaginary ..dimension]
($_ _.and
(_.test "Absolute value of complex >= absolute value of any of the parts."
(let [r+i (/.complex real imaginary)
abs (get@ #/.real (/.abs r+i))]
(and (f/>= (frac@abs real) abs)
(f/>= (frac@abs imaginary) abs))))
(_.test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
(and (frac.not-a-number? (get@ #/.real (/.abs (/.complex frac.not-a-number imaginary))))
(frac.not-a-number? (get@ #/.real (/.abs (/.complex real frac.not-a-number))))))
(_.test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value."
(and (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.positive-infinity imaginary))))
(f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.positive-infinity))))
(f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.negative-infinity imaginary))))
(f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.negative-infinity))))))
)))
(def: number
Test
(do r.monad
[x ..complex
y ..complex
factor ..dimension]
($_ _.and
(_.test "Adding 2 complex numbers is the same as adding their parts."
(let [z (/.+ y x)]
(and (/.= z
(/.complex (f/+ (get@ #/.real y)
(get@ #/.real x))
(f/+ (get@ #/.imaginary y)
(get@ #/.imaginary x)))))))
(_.test "Subtracting 2 complex numbers is the same as adding their parts."
(let [z (/.- y x)]
(and (/.= z
(/.complex (f/- (get@ #/.real y)
(get@ #/.real x))
(f/- (get@ #/.imaginary y)
(get@ #/.imaginary x)))))))
(_.test "Subtraction is the inverse of addition."
(and (|> x (/.+ y) (/.- y) (within? margin-of-error x))
(|> x (/.- y) (/.+ y) (within? margin-of-error x))))
(_.test "Division is the inverse of multiplication."
(|> x (/.* y) (/./ y) (within? margin-of-error x)))
(_.test "Scalar division is the inverse of scalar multiplication."
(|> x (/.*' factor) (/./' factor) (within? margin-of-error x)))
(_.test "If you subtract the remainder, all divisions must be exact."
(let [rem (/.% y x)
quotient (|> x (/.- rem) (/./ y))
floored (|> quotient
(update@ #/.real math.floor)
(update@ #/.imaginary math.floor))]
(within? +0.000000000001
x
(|> quotient (/.* y) (/.+ rem)))))
)))
(def: conjugate&reciprocal&signum&negation
Test
(do r.monad
[x ..complex]
($_ _.and
(_.test "Conjugate has same real part as original, and opposite of imaginary part."
(let [cx (/.conjugate x)]
(and (f/= (get@ #/.real x)
(get@ #/.real cx))
(f/= (frac@negate (get@ #/.imaginary x))
(get@ #/.imaginary cx)))))
(_.test "The reciprocal functions is its own inverse."
(|> x /.reciprocal /.reciprocal (within? margin-of-error x)))
(_.test "x*(x^-1) = 1"
(|> x (/.* (/.reciprocal x)) (within? margin-of-error /.one)))
(_.test "Absolute value of signum is always root2(2), 1 or 0."
(let [signum-abs (|> x /.signum /.abs (get@ #/.real))]
(or (f/= +0.0 signum-abs)
(f/= +1.0 signum-abs)
(f/= (math.pow +0.5 +2.0) signum-abs))))
(_.test "Negation is its own inverse."
(let [there (/.negate x)
back-again (/.negate there)]
(and (not (/.= there x))
(/.= back-again x))))
(_.test "Negation doesn't change the absolute value."
(f/= (get@ #/.real (/.abs x))
(get@ #/.real (/.abs (/.negate x)))))
)))
(def: (trigonometric-symmetry forward backward angle)
(-> (-> Complex Complex) (-> Complex Complex) Complex Bit)
(let [normal (|> angle forward backward)]
(|> normal forward backward (within? margin-of-error normal))))
(def: trigonometry
Test
(do r.monad
[angle (|> ..complex (:: @ map (|>> (update@ #/.real (f/% +1.0))
(update@ #/.imaginary (f/% +1.0)))))]
($_ _.and
(_.test "Arc-sine is the inverse of sine."
(trigonometric-symmetry /.sin /.asin angle))
(_.test "Arc-cosine is the inverse of cosine."
(trigonometric-symmetry /.cos /.acos angle))
(_.test "Arc-tangent is the inverse of tangent."
(trigonometric-symmetry /.tan /.atan angle)))))
(def: exponentiation&logarithm
Test
(do r.monad
[x ..complex]
($_ _.and
(_.test "Root 2 is inverse of power 2."
(|> x (/.pow' +2.0) (/.pow' +0.5) (within? margin-of-error x)))
(_.test "Logarithm is inverse of exponentiation."
(|> x /.log /.exp (within? margin-of-error x)))
)))
(def: root
Test
(do r.monad
[sample ..complex
degree (|> r.nat (:: @ map (|>> (n/max 1) (n/% 5))))]
(_.test "Can calculate the N roots for any complex number."
(|> sample
(/.roots degree)
(list@map (/.pow' (|> degree .int int-to-frac)))
(list.every? (within? margin-of-error sample))))))
(def: #export test
Test
(<| (_.context (%name (name-of /._)))
($_ _.and
..construction
..absolute-value
..number
..conjugate&reciprocal&signum&negation
..trigonometry
..exponentiation&logarithm
..root
)))
|
