0. #lang typed/racket
1.  
2. ; Apologies that this one's kind of messy.
3. ; I enjoyed how straightforward it was to port my previous implementation of Conway's Game
4. ; to my implementation of the Quadtree data structure.
5.  
6. ; Here's a couple of examples of what the output looks like:
7. ; https://i.imgur.com/2QYR0P5.gif
8. ; https://i.imgur.com/Zo2sxT2.gif
9. ; https://i.imgur.com/KcIJEIc.gif
10.  
11. (require "qtree.rkt")
12. (require typed/racket/draw)
13. (require typed/mrlib/gif)
14.  
15. ; constants. never enough constants
16. (define cell-scale 5)
17. (define canvas-size 500)
18. (define frames-to-animate 50)
19. (define output-file-name "your_filename_here")
20.  
21. (define living-cells
22.   (quadtree-fold null (map (lambda ([y : Integer]) (coordinate y 50)) (range 10 90))))
23.  
24. (define moment-zero (list living-cells))
25.  
26. (define-type History (Listof Quadtree))
27.  
28. ; Given a coordinate and a Quadtree, determine if it survives.
29. (: determine-cell-state (-> Quadtree coordinate Boolean))
30. (define (determine-cell-state population cell)
31.   (let ([living-neighbors (length (quadtree-neighbors population cell))]
32.         [orig-state (quadtree-member? population cell)])
33.     (if (< living-neighbors 2) #f                          ; if the cell has fewer than 2 neighbors, it dies.
34.         (if (equal? living-neighbors 3) #t                 ; if the cell has exactly 3 neighbors, it comes to life.
35.             (if (> living-neighbors 3) #f orig-state)))))  ; if the cell has more than 3 neighbors, it dies.
36.  
37. ; Advance time by one frame.
38. (: tick (-> Quadtree Quadtree))
39. (define (tick living-cells)
40.   (let ([cell-list (descendant-coordinates living-cells)])
41.     (quadtree-fold null
42.                    (append-map (λ ([cell : coordinate])
43.                                  (filter (curry determine-cell-state living-cells)
44.                                          (neighbor-coords cell)))
45.                                cell-list))))
46.  
47. ; Advances time an arbitrary number of frames.
48. (: iterate-history (-> History Integer History))
49. (define (iterate-history history i)
50.   (cond
51.     [(<= i 0) history]
52.     [else (iterate-history (append history (list (tick (last history)))) (- i 1))]))
53.  
54. ; I'd like to find a cleaner way to do this.
55. (: neighbor-coords (-> coordinate (Listof coordinate)))
56. (define (neighbor-coords coordinate)
57.   (let ([x : Integer (coordinate-x coordinate)]
58.         [y : Integer (coordinate-y coordinate)])
59.     (append-map (curry coordmap x) (range (- y 1) (+ y 2)))))
60.  
61. ; give all the ys for an x
62. (: coordmap (-> Integer Integer (Listof coordinate)))
63. (define (coordmap x y)
64.   (map (λ ([z : Integer]) (coordinate z y))
65.        (range (- x 1) (+ x 2))))
66.  
67. ; ronder
68. (: render-frame (-> Quadtree (Instance Bitmap%)))
69. (define (render-frame cells)
70.   (let ([target (make-bitmap canvas-size canvas-size)])
71.     (let ([dc : (Instance Bitmap-DC%) (new bitmap-dc% [bitmap target])])
72.       (send dc set-background "black")
73.       (send dc set-pen "black" 1 'transparent)
74.       (send dc set-brush "black" 'solid)
75.       (send dc draw-rectangle 0 0 canvas-size canvas-size)
76.       (send dc set-brush "green" 'solid)
77.       (send dc set-pen "green" 1 'solid)
78.       (recursidraw dc (descendant-coordinates cells)) target)))
79.  
80. ; draww
81. (: recursidraw (-> (Instance Bitmap-DC%) (Listof coordinate) (Instance Bitmap-DC%)))
82. (define (recursidraw dc cells)
83.   (cond
84.     [(empty? cells) dc]
85.     [else   (let ([cell : coordinate (first cells)])
86.               (send dc draw-rectangle
87.                     (* cell-scale (coordinate-y cell))
88.                     (* cell-scale (coordinate-x cell)) cell-scale cell-scale)
89.               (recursidraw dc (rest cells)))]))
90.  
91. ; mhm
92. (define a-fine-mess (iterate-history moment-zero frames-to-animate))
93.  
94. ; spit it out
95. (write-animated-gif (map (curry render-frame) a-fine-mess) 10 output-file-name)
96.  
97.  
98. ; When I did my first tests of this implementation, I was initially very disappointed--
99. ; it seemed that my fourth implementation of Conway's Game of Life in Racket was doomed to be
100. ; the least-performant of all. However, I ran tests with longer values of frames-to-animate, and
101. ; it seems like the quadtree implementation overtakes the previous implementation around 100
102. ; frames in. I haven't tried turning off all the debugging/profiling stuff and compiling the bytecode,
103. ; but I am curious how performant this can be made.
104.  
105. ; For comparison (moment-zero was set to equivalent values for both):
106.  
107. ; list-based GoL implementation
108. ; > (time (void (iterate-history moment-zero 10)))
109. ; cpu time: 11669 real time: 11761 gc time: 94
110. ; > (time (void (iterate-history moment-zero 100)))
111. ; cpu time: 255155 real time: 257376 gc time: 956
112. ; > (time (void (iterate-history moment-zero 200)))
113. ; cpu time: 496005 real time: 500710 gc time: 2087
114.  
115. ; quadtree-based GoL implementation:
116. ; > (time (void (iterate-history moment-zero 10)))
117. ; cpu time: 38672 real time: 39119 gc time: 326
118. ; > (time (void (iterate-history moment-zero 100)))
119. ; cpu time: 261972 real time: 254202 gc time: 9704
120. ; > (time (void (iterate-history moment-zero 200)))
121. ; cpu time: 354715 real time: 365443 gc time: 2088

=>