/
game_of_life.clj
178 lines (138 loc) · 5.59 KB
/
game_of_life.clj
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
(ns tech.v2.apl.game-of-life
"https://youtu.be/a9xAKttWgP4"
(:require [tech.v2.tensor :as tens]
[tech.v2.datatype :as dtype]
[tech.v2.datatype.functional :as dtype-fn]
[clojure.test :refer :all]))
(defn membership
[lhs rhs]
(let [membership-set (set (dtype/->vector rhs))]
(dtype-fn/boolean-unary-reader
:object
(contains? membership-set x)
lhs)))
(defn apl-take
"Negative numbers mean left-pad. Positive numbers mean right-pad."
[item new-shape]
(let [item-shape (dtype/shape item)
abs-new-shape (mapv #(Math/abs (int %)) new-shape)
abs-min-shape (mapv min item-shape abs-new-shape)
reshape-item (apply tens/select item (map range abs-min-shape))
retval (tens/new-tensor abs-new-shape
:datatype (dtype/get-datatype item))
copy-item (apply tens/select retval
(map (fn [n-elems orig-item]
(if (>= orig-item 0)
(range n-elems)
(take-last n-elems (range (- orig-item)))))
abs-min-shape
new-shape))]
(dtype/copy! reshape-item copy-item)
retval))
(defn rotate-vertical
[tens amount]
(let [n-shape (count (dtype/shape tens))
offsets (->> (concat (repeat (- n-shape 1) 0)
[(- amount)])
vec)]
(tens/rotate tens offsets)))
(defn rotate-horizontal
[tens amount]
(let [n-shape (count (dtype/shape tens))
offsets (->> (concat [(- amount)]
(repeat (- n-shape 1) 0))
vec)]
(tens/rotate tens offsets)))
(def range-tens (tens/reshape (vec (range 9)) [3 3]))
(def bool-tens (-> range-tens
(membership [1 2 3 4 7])
;;convert to zeros/ones for display.
(tens/clone :datatype :int8)))
(def take-tens (apl-take bool-tens [5 7]))
(def right-rotate (rotate-vertical take-tens -2))
(def down-rotate (rotate-horizontal right-rotate -1))
(def R-matrix down-rotate)
(def rotate-arg [1 0 -1])
(def group-rotated (->> rotate-arg
(map (partial rotate-vertical down-rotate))))
(def table-rotated (->> rotate-arg
(mapcat (fn [rot-amount]
(->> group-rotated
(mapv #(rotate-horizontal
% rot-amount)))))))
(def summed (apply dtype-fn/+ table-rotated))
(defn game-of-life-operator
[original new-matrix]
;;We do a typed reader here so that everything happens in byte space with no boxing.
(-> (dtype-fn/binary-reader
:int8
;;Clojure conservatively interprets all integers as longs so we have to specify
;;that we want a byte.
(unchecked-byte
(if (or (= 3 y)
(and (not= 0 x)
(= 4 y)))
1
0))
original
new-matrix)
;;Force the actual result to be calculated. Else we would get a *huge* chain of
;;reader maps. We don't have to specify the datatype here because the statement
;;above produced an int8 (byte) reader.
(tens/tensor-force)))
(def next-gen (game-of-life-operator R-matrix summed))
(defn life
[R]
(->> (for [horz-amount rotate-arg
vert-amount rotate-arg]
(tens/rotate R [horz-amount vert-amount]))
;;This doesn't help the dense version much but it gives
;;the sparse version at least some parallelism
;;Simple parallel reduction
(partition-all 2)
(pmap (fn [items]
(if (= 2 (count items))
(apply dtype-fn/+ items)
(first items))))
(apply dtype-fn/+)
(game-of-life-operator R)))
(defn life-seq
[R]
(cons R (lazy-seq (life-seq (life R)))))
(def half-RR (apl-take R-matrix [-10 -20]))
(def RR (-> (apl-take R-matrix [-10 -20])
(apl-take [15 35])))
(defn mat->pic-mat
[R]
(->> R
(dtype-fn/unary-reader
(if (= 0 (int x))
(char 0x02DA)
(char 0x2021)))))
(defn print-life-generations
[& [n-gens]]
(doseq [life-item (take (or n-gens 1000) (life-seq RR))]
(println (mat->pic-mat life-item))
(Thread/sleep 125)))
(def end-state
[[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
[0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0]
[0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1]
[0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1]
[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0]])
(deftest game-of-life-test
(is (= end-state
(->> (life-seq RR)
(take 1000)
last
(tens/->jvm)))))