-
Notifications
You must be signed in to change notification settings - Fork 0
/
complex-grapher-test.rkt
380 lines (329 loc) · 14.5 KB
/
complex-grapher-test.rkt
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
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
#lang racket
;;File:
;; complex-grapher-test.rkt
;;Summary:
;; A file to test out the complex-grapher.rkt module
;;Author:
;; Cassandra Rudig
;;Created: 2/26/22
;;Last Updated: 4/12/22
;;--------------------------------------------------------------------
;; Requirements §1
;;--------------------------------------------------------------------
(require "complex-grapher.rkt")
(require racket/gui/base)
;;--------------------------------------------------------------------
;;Provisions §2
;;--------------------------------------------------------------------
;TODO: Review provisions and add contracts
(provide (all-defined-out))
;;--------------------------------------------------------------------
;; Miscellaneous Procedures §3
;;--------------------------------------------------------------------
;A convenient alias
;See make-rectangular in the official docs for details
{define complex make-rectangular}
;Randomly generates a complex number in the given rectangular range
;(random-complex [rmin -1] [rmax 1] [imin -1] [imax 1])
; → (and/c complex? {lambda (z) (<= rmin (real-part z) rmax)}
; {lambda (z) (<= imin (imag-part z) imax)})
; rmin: real?
; rmax: (and/c real? (>=/c rmin))
; imin: real?
; imax: (and/c real? (>=/c imin))
{define random-complex
{lambda ([rmin -1] [rmax 1] [imin -1] [imax 1])
(complex (+ rmin (* (- rmax rmin) (random)))
(+ imin (* (- imax imin) (random))))}}
;Creates a polynomial procedure in which each supplied argument is a zero of the function
;(zeroes . zrs) → {-> complex? complex?}
; zrs: (listof complex?)
{define zeroes
{lambda zrs
{lambda (x)
(apply * (map {lambda (zr) (- x zr)} zrs))}}}
;Defines a function with the specified number of zeroes and poles,
; where item is a procedure that accepts any number of arguments and always returns a complex number
; Bands can be marked with the #:bands and #:alt-bands keyword arguments:
; data1 and data2 are pairs of nonnegative integers, in which
; the car of the pair is the number of bands to draw around a zero or pole, and
; the cdr of the pair is the precision for drawing the bands (bigger numbers = thinner bands)
;(zero-pole zrs poles [item '(random-complex)] [#:bands [data1 #f] #:alt-bands [data2 #f]])
; → {-> complex? complex?}
; zrs: nonnegative-integer?
; poles: nonnegative-integer?
; item: {->* () #:rest any/c complex?}
; data1: (or/c #f (cons/c nonnegative-integer? nonnegative-integer?))
; data2: (or/c #f (cons/c nonnegative-integer? nonnegative-integer?))
{define zero-pole
{lambda (zrs poles [item (thunk* (random-complex))] #:bands [data1 #f] #:alt-bands [data2 #f])
{define func (combine /
(apply zeroes (build-list zrs item))
(apply zeroes (build-list poles item)))}
{cond [(nor data1 data2) func]
[(and data1 (not data2))
{define freq1 (car data1)} {define tol1 (cdr data1)}
{lambda (z)
{define res (func z)}
{if (near-multiple? (angle res) (/ (* 2 pi) freq1) (expt 2 (- tol1)))
0 res}}]
[(and data1 data2)
{define freq1 (car data1)} {define freq2 (car data2)}
{define tol1 (cdr data1)} {define tol2 (cdr data2)}
{lambda (z)
{define res (func z)} {define angle-res (angle res)}
{cond [(near-multiple? angle-res (/ (* 2 pi) freq1) (expt 2 (- tol1))) 0]
[(near-multiple? angle-res (/ (* 2 pi) freq2) (expt 2 (- tol2))) +inf.0]
[else res]}}]
[else (error "#:alt-bands keyword requires #:bands keyword")]
}}}
;If no procedures are supplied, draws the mandelbrot set to complex-canvas with preset window settings
; If another canvas is supplied, produces the mandelbrot procedure for use in a method call
;(mandelbrot canvas) → {-> complex? complex?}
; canvas: (is-a?/c canvas%)
;(mandelbrot) → void?
{define mandelbrot
{case-lambda [(canvas)
{lambda (x)
{define factor (send canvas get-scale-factor)}
{define dist (dist-est x (* 2 (round (/ (- 52 (log (/ factor 2) 2)) 2))))}
{if (zero? dist) 0 (/ (* 2 (expt dist 1/4+1/4i)) (expt factor 1/4))}}]
[() (send complex-canvas on-paint (mandelbrot complex-canvas) (/ 2.47 768) -0.765 0)]}}
;Creates a procedure that acts as a polynomial function with the arguments used as the coefficients
; The right most argument always represents the coefficient of the term with degree 0
; Each argument is the coefficient of the term 1 degree greater than the argument to its right
;(polynomial . coefficients) → {-> complex? complex?}
; coefficients: (listof complex?)
{define polynomial
{lambda coefficients
(apply combine (cons + (map {lambda (c d)
{cond [(zero? c) {lambda (x) 0}]
[(zero? d) {lambda (x) c}]
[{and (= 1 d) (= 1 c)} identity]
[(= 1 d) {lambda (x) (* c x)}]
[(= 1 c) {lambda (x) (expt x d)}]
[else {lambda (x) (* c (expt x d))}]}}
coefficients
(range (sub1 (length coefficients)) -1 -1))))}}
;Creates a procedure that calculates the derivative of the polynomial function
; with the arguments used as coefficients
;(polyprime . coefficients) → {-> complex? complex?}
; coefficients: (listof complex?)
{define polyprime
{lambda coefficients
(apply polynomial (reverse (cdr (map * (reverse coefficients) (range (length coefficients))))))}}
;Creates a procedure that executes a single step of newton's method for finding zeroes of a function
; The coefficients determine the polynomial to search for zeroes. See the polynomial procedure
;(newton-step . coefficients) → {-> complex? complex?}
; coefficients: (listof complex?)
{define newton-step
{lambda coefficients
{define polynom (apply polynomial coefficients)}
{define polyprim (apply polyprime coefficients)}
{lambda (x) (- x (/ (polynom x) (polyprim x)))}}}
;Estimates the integral of proc using left-endpoint approximation to the specified precision
; The bounds of the integral are low and high
;(integrate low high proc [precision 32]) → complex?
; low: real?
; high: (and/c real? (>=/c low))
; proc: {-> complex? complex?}
; precision: positive-integer?
{define integrate
{lambda (low high proc [precision 32])
{define increment (/ (- high low) precision)}
{define mag (magnitude increment)}
{let kernel ([i low] [sum 0])
{if (> (magnitude (- high i)) mag)
(kernel (+ i increment) (+ sum (* (proc i) increment))) sum}}}}
;Same as erf, but can take complex inputs, and has relatively limited precision
; The precision argument is used for the integral approximation
;(erfz z [precision 32]) → complex?
; z: complex?
; precision: positive-integer?
{define erfz
{lambda (z [precision 32])
(* (/ 2 (sqrt pi)) (integrate 0 z {lambda (z) (exp (- (sqr z)))} precision))}}
;Defines a procedure using a formula-style format
; The arguments of the procedure are placed between the f: and the ~,
; as an unparenthesized sequence of identifiers
; The body is placed after the ~, without enclosing parentheses
;(f: args ~ form)
; args = id ...+
; | id
;
; form = expr ...
;
; expr = id
; | body
{define-syntax f:
{syntax-rules (~)
[(_ arg ...+ ~ . stuff)
{lambda (arg ...+) stuff}]
[(_ arg ~ . stuff)
{lambda (arg) stuff}]}}
;See the following examples:
;(f: x ~ sqr x) → #<procedure>
;((f: x ~ sqr x) 5) → 25
;((f: x ~ lambda (y) (+ y x)) 3) → #<procedure>
;(((f: x ~ lambda (y) (+ y x)) 3) 4) → 7
;Returns the result of processing arg with each of the procedures in procs from left to right
; The output of one procedure is used for the next
; This is inspired by the %>% (pipeline) operator in R
;(>> arg . procs) → any/c
; arg: any/c
; procs: (cons/c (procedure-arity-includes 1) (listof procedure?))
{define >>
{lambda (arg . procs)
{let kernel ([res arg] [rest procs])
{if (null? rest) res
(kernel ((car rest) res) (cdr rest))}}}}
;Calls the on-paint method for complex-canvas with the given arguments, for convenience
; Also adjusts scale so that dividing by frame width is unnecessary
;(graph eq) → void?
;(graph eq scale) → void?
;(graph eq scale x y) → void?
; eq: (-> complex? complex?)
; scale: complex?
; x: real?
; y: real?
{define graph
{case-lambda [(eq)
{send complex-canvas on-paint eq}]
[(eq scale)
{send complex-canvas on-paint eq (/ scale {send complex-frame get-width})}]
[(eq scale x y)
{send complex-canvas on-paint eq (/ scale {send complex-frame get-width}) x y}]}}
;Calls the set-resolution method for complex frame with the given resolution
;(set-res [res 6]) → void?
; res: (and/c dimension-integer? positive?)
{define set-res
{lambda ([res 6])
{send complex-frame set-resolution res}}}
;Shows the window and canvas
;(show) → void?
{define show
{lambda ()
{send complex-frame show #t}}}
;Hides the window and canvas
;(hide) → void?
{define hide
{lambda ()
{send complex-frame show #f}}}
;Resets the canvas to the default equation and window settings
;(reset) → void?
{define reset
{lambda ()
{send complex-canvas on-paint identity (/ 4 768) 0 0}}}
;Determine if x is within tolerance distance of any multiple mult
;(near-multiple? x [mult (/ (* 2 pi) 3)] [tolerance 0.015625]) → boolean?
; x: real?
; mult: real?
; tolerance: real?
{define near-multiple?
{lambda (x [mult (/ (* 2 pi) 3)] [tolerance 0.015625])
(or (< (mod-extended x mult) tolerance)
(< (mod-extended (- x) mult) tolerance))}}
;Get the counter from the current timer, for use in automatically-updating equations
;(counter) → nonnegative-integer?
{define counter
{lambda ()
{send complex-timer get-counter}}}
;Sets the timer's redraw, determining whether the canvas will automatically update every interval
;(redraw [bool #t]) → void?
; bool: boolean?
{define redraw
{lambda ([bool #t])
{send complex-timer set-redraw bool}}}
{define help
{lambda ()
(display "
(help) : show this dialogue
(graph eq) : graph the complex-valued procedure eq
(graph eq scale) : graph with scale being the horizontal span of the window in units
(graph eq scale x y): graph with x and y being the real and imaginary offsets from the origin
(set-res res) : set the resolution to the given number of pixels (lower values draw more points)
(show) : show the window and canvas
(hide) : hide the window and canvas
(reset) : reset the canvas to default
(mandelbrot) : draw the mandelbrot set
(polynomial . coefficients) : create a polynomial procedure
(zero-pole m n) : create a function with m zeroes and n poles
(complex x y) : create the complex number x+yi
(random-complex) : create a random complex number in the unit square
(f: args ~ form) : define a formula
(>> arg . procs) : pipeline arg through procs left to right")}}
;;--------------------------------------------------------------------
;; Object Definitions §4
;;--------------------------------------------------------------------
{define complex-frame (new complex-frame%
[label "Complex Equation Grapher"]
[width 768] [height 768]
[style '(float)]
[x 200] [y 70])}
{define complex-canvas (new complex-canvas% [parent complex-frame])}
{define complex-dc (send complex-canvas get-dc)}
;Use if you want the canvas to automatically update every interval
;(counter) gets the current counter, which can be used in equations
{define complex-timer (new complex-timer%
[notify-callback {lambda ()
{define redraw (send complex-timer get-redraw)}
(send complex-timer increment-counter)
{if (> (send complex-canvas get-draws)
{if redraw +nan.0 0})
(void)
(send complex-canvas refresh)}}]
;Making this value too small will break things!
; interval is in ms
[interval 1000])}
;;--------------------------------------------------------------------
;; Drawing Calls 5
;;--------------------------------------------------------------------
{define initialize
{lambda ()
(send complex-dc set-pen (make-color 255 255 255) 0 'transparent)
(send complex-dc set-font (make-font #:size 12 #:face "Courier"))
(send complex-frame show #t)}}
(initialize)
;;--------------------------------------------------------------------
;; Extra Notes and Temporary Stuff 6
;;--------------------------------------------------------------------
#|
Change the resolution:
(send complex-frame set-resolution `res`)
Higher values of res = more detail but slower
Default res is 6
Graph the complex-valued function proc:
(graph proc)
Graph proc and manually change the window settings:
(graph proc scale x-offset y-offset)
The scale is the horizontal distance in units across the window
An x-offset of 3 and a y offset of -4 will put the center of the graph at 3-4i
Many ways to express the same function:
(graph {lambda (x) (sinh (cos x))})
(graph (f: x ~ >> x cos sinh))
(graph (compose sinh cos))
(graph (f: x ~ sinh (cos x))
(graph {lambda (x) (>> x cos sinh)})
Graph a function with a zero and a pole, each at random locations
(graph (zero-pole 1 1))
Zero-pole function with bands:
(graph (zero-pole 1 1 #:bands '(3 . 5) #:alt-bands '(6 . 5)))
Complex step-like function:
(graph {lambda (x)
{define mag (magnitude x)}
(* (/ x mag) (- mag (expt 2 (floor (log mag 2)))))} 8 0 0)
Iris function:
(graph {f: x ~ * x (expt (magnitude x) 16)})
Error function:
(graph (f: z ~ erfz z 32))
Logarithmic cosine:
{define zlog {lambda (z) (* (log (magnitude z)) (/ z (magnitude z)))}}
(graph (f: x ~ zlog (cos x)))
Target:
(graph {lambda (x) (* (/ x (magnitude x)) (sin (* 10 (magnitude x))))})
Split Rainbow:
(graph (f: x ~ make-polar (real-part x) (imag-part x)))
Checkerboard:
(graph (f: x ~ * (* +i (sub1 (* 2 (mod-extended (imag-part x) 1)))
(sub1 (* 2(mod-extended (real-part x) 1))))))
|#