Skip to content

Commit 289725e

Browse files
committed
neuroevolution
1 parent 81f7c8b commit 289725e

12 files changed

+667
-11
lines changed

Diff for: deps.edn

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
11
{:paths ["src" "resources"]
2-
:deps {org.clojure/clojure {:mvn/version "1.11.1"}
2+
:deps {org.clojure/clojure {:mvn/version "1.12.0"}
33
sicmutils/sicmutils {:mvn/version "0.22.0"}
4-
clojure2d/clojure2d {:mvn/version "1.4.6-SNAPSHOT"}}}
4+
clojure2d/clojure2d {:mvn/version "1.5.0-SNAPSHOT"}}}

Diff for: project.clj

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
(defproject clojure2d-examples "1.4.6-SNAPSHOT"
1+
(defproject clojure2d-examples "1.5.0-SNAPSHOT"
22
:description "Examples for Clojure2d library"
33
:url "https://github.com/Clojure2D/clojure2d-examples"
44
:license {:name "The Unlicense"

Diff for: src/ex53_ppl.clj

+7-2
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,11 @@
11
;; https://www.youtube.com/watch?v=makaJpLvbow
22
;; http://zool33.uni-graz.at/artlife/PPS
33

4+
;; * particle moves with constant velocity 'v'
5+
;; * particle rotates with constant angle 'alpha'
6+
;; * neighbourhood within radius 'r'
7+
;; * rotate 'beta' times number of neighbours count left or right depending where the number of neighbours is higher
8+
49
;; press mouse to add spores
510

611
(ns ex53-ppl
@@ -60,7 +65,7 @@
6065
;; a -69 b -1
6166
;; 42 9
6267
;; 79.6 -1.8
63-
(spore id pos 0.67 (m/sq 11.0) (m/radians 181) (m/radians -7) (first pal))))
68+
(spore id pos 0.67 (m/sq 11.0) (m/radians 180) (m/radians 17) (first pal))))
6469

6570
(defn draw
6671
[canvas window _ spores]
@@ -77,7 +82,7 @@
7782
(def window (c2d/show-window {:canvas (c2d/black-canvas csize csize)
7883
:draw-fn draw
7984
:background :black
80-
:draw-state (take 400 (map next-spore (range)))}))
85+
:draw-state (take 100 (map next-spore (range)))}))
8186

8287

8388
(comment c2d/save window "results/ex53/spores.jpg")

Diff for: src/ex63_particle_life.clj

+178-6
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,16 @@
11
;; https://www.youtube.com/watch?v=scvuli-zcRc
2+
3+
;; each particle has position/velocity/color/radius
4+
;; each pair a->b has repel/attract linear profile
5+
26
(ns ex63-particle-life
37
(:require [fastmath.vector :as v]
48
[fastmath.core :as m]
59
[fastmath.random :as r]
610
[clojure2d.color :as c]
711
[clojure2d.core :as c2d]
8-
[clojure.pprint :as pp])
12+
[clojure.pprint :as pp]
13+
[clojure2d.extra.utils :as utils])
914
(:import [fastmath.vector Vec2]
1015
[fastmath.java Array]))
1116

@@ -19,16 +24,21 @@
1924
(defrecord Setup [^long n ^doubles alpha ^doubles beta types ^double fmult])
2025
(defrecord Particle [^Vec2 pos ^Vec2 vel ^ParticleType ptype])
2126

27+
(defn get-n-alpha-beta [^long n]
28+
[(repeatedly n #(r/randval 0.15 0.0 (r/randval (r/drand 0.2 1.0) (r/drand -1.0 1.0))))
29+
(repeatedly n #(r/randval 0.1 0.00001 (r/drand 0.001 0.5)))])
30+
2231
(defn random-setup
2332
[^long n]
2433
(let [n2 (m/* n n)
25-
alpha (double-array (repeatedly n2 #(r/randval (r/drand 0.2 1.0) (r/drand -1.0 1.0))))
26-
beta (double-array (repeatedly n2 #(r/drand 0.001 0.5)))
34+
[a b] (get-n-alpha-beta (r/randval 0.5 (r/irand 1 (m/inc n2)) n2))
35+
alpha (double-array (take n2 (cycle a)))
36+
beta (double-array (take n2 (cycle b)))
2737
types (mapv (fn [id c]
2838
(ParticleType. id (r/drand 5.0 100.0) c (m/sqrt (r/drand 0.5 0.98))
2939
(r/brand 0.2)))
3040
(range n)
31-
(c/palette (c/palette) n))]
41+
(c/palette :category10 #_(c/palette)))]
3242
(map->Setup {:n n :alpha alpha :beta beta :types types :fmult (r/drand 1.0 40.0)})))
3343

3444
(defn random-particle
@@ -111,12 +121,174 @@
111121
(c2d/set-color canvas (.color ptype))
112122
(c2d/ellipse canvas (.x p) (.y p) 4 4))
113123
#_(when (= frame 200) (c2d/save canvas "results/ex63/plife.jpg"))
114-
[setup (move setup particles 0.1)]))
124+
[setup (move setup particles 0.02)]))
125+
126+
(def setup (random-setup (r/irand 3 8)))
115127

116128
(def window (c2d/show-window {:canvas (c2d/black-canvas csize csize :highest)
117129
:draw-fn draw
118130
:background :black
119-
:draw-state (let [setup (random-setup (r/irand 2 6))]
131+
:draw-state (do
120132
(pp/pprint setup)
121133
[setup (random-particles setup 1200)])}))
122134

135+
136+
137+
(def setups {:s4 {:n 3,
138+
:alpha
139+
[0.6684104736324896, 0.964616865419524, 0.0, 0.4797524863542435,
140+
0.420585350696979, 0.0, 0.2919907666469499, 0.764963999761529,
141+
0.46580437967504296],
142+
:beta
143+
[0.4789021847690479, 0.3982629457198275, 0.32274878567328485,
144+
0.006632143916497076, 1.0E-5, 0.07558784022513844,
145+
0.39278491978642616, 0.47501099696327787, 0.0020077077145747415],
146+
:types
147+
[{:id 0,
148+
:rmax 71.43515738762513,
149+
:color [31.0 119.0 180.0 255.0],
150+
:friction 0.9232725105802526,
151+
:directional? false}
152+
{:id 1,
153+
:rmax 68.68845289469147,
154+
:color [255.0 127.0 14.0 255.0],
155+
:friction 0.9857304980002655,
156+
:directional? false}
157+
{:id 2,
158+
:rmax 70.19663550537409,
159+
:color [44.0 160.0 44.0 255.0],
160+
:friction 0.8686615546986293,
161+
:directional? false}],
162+
:fmult 31.116278104592784}
163+
164+
:s3 {:n 6,
165+
:alpha
166+
[0.694393853127492, -0.8935978076229849, 0.9183734540489523,
167+
0.7517707166455021, 0.2841941531837335, 0.08925882019419396,
168+
0.908367258300788, 0.23138605339016705, 0.539474804503183,
169+
-0.9802196408483186, -0.8693660024733327, 0.0, 0.7318061764631272,
170+
0.36360691819690205, 0.6418568962430138, -0.7204320305125755,
171+
0.7380792217531813, 0.5787396658363937, -0.3291955538172251,
172+
0.5226483215785241, 0.8492266307322129, 0.3096562062402062,
173+
0.8063587650931772, -0.3644435757551976, 0.8051225172807546,
174+
-0.5702459858224584, 0.5013477590334159, 0.6723543784338462,
175+
0.7772786635514581, 0.28393901651846987, -0.6212617087079326,
176+
0.7462814541882263, 0.5095448072377847, 0.6821193350277652,
177+
0.744776841823634, 0.6573983356630304],
178+
:beta
179+
[0.2521608562860081, 0.4076959642424631, 0.3103972482705078,
180+
0.05991445703790259, 0.33953089577942736, 0.050659182809147274,
181+
0.052623099321584106, 0.254639482159116, 1.0E-5, 0.07454095722220755,
182+
1.0E-5, 0.4305425458078607, 0.4371284549400973, 0.05456589836363007,
183+
0.2078867381683436, 0.16536217864365724, 0.47043636960772117,
184+
0.27048908630161494, 0.15059986908922987, 0.4390023446634153,
185+
0.03301475339225711, 0.3720308037048845, 0.0029457710760157595,
186+
0.031390696923137944, 0.1432372555387937, 0.21132657604152602,
187+
0.3097446374760432, 0.031617830977375645, 0.20440732589153868,
188+
0.16253467914474676, 0.3945421621765617, 1.0E-5, 0.4213522149830562,
189+
0.4483283120778598, 0.1478064798692622, 0.15434745560839033],
190+
:types
191+
[{:id 0,
192+
:rmax 15.771133363147245,
193+
:color [31.0 119.0 180.0 255.0],
194+
:friction 0.7369008895452103,
195+
:directional? false}
196+
{:id 1,
197+
:rmax 77.88466217203033,
198+
:color [255.0 127.0 14.0 255.0],
199+
:friction 0.742985355025393,
200+
:directional? false}
201+
{:id 2,
202+
:rmax 77.38995861457622,
203+
:color [44.0 160.0 44.0 255.0],
204+
:friction 0.7144989164158658,
205+
:directional? false}
206+
{:id 3,
207+
:rmax 68.67660805859893,
208+
:color [214.0 39.0 40.0 255.0],
209+
:friction 0.8187926632606051,
210+
:directional? false}
211+
{:id 4,
212+
:rmax 75.82489142446111,
213+
:color [148.0 103.0 189.0 255.0],
214+
:friction 0.9162043128890355,
215+
:directional? false}
216+
{:id 5,
217+
:rmax 79.67260413418143,
218+
:color [140.0 86.0 75.0 255.0],
219+
:friction 0.8348123850263762,
220+
:directional? false}],
221+
:fmult 30.13358133507849}
222+
:s2 {:n 5,
223+
:alpha
224+
[0.4096941637038132, 0.7167869425818219, -0.32250537479967933,
225+
0.5386508874278341, 0.12807755622037065, 0.0, 0.4489072259997007,
226+
0.9896151168560674, 0.9870059536071383, 0.9943843293539436,
227+
0.7491114682697713, 0.33010843632119924, 0.7042231463915714,
228+
-0.7913023790316922, 0.3694785167828138, 0.5724792191873702,
229+
0.9059717885051928, 0.0, 0.0, 0.25949275669321237, 0.0,
230+
0.7237415492644526, 0.0, 0.97214261378972, -0.28404642077174125],
231+
:beta
232+
[0.3311261892212369, 1.0E-5, 0.2727371400015111, 0.1715326178323534,
233+
0.3053054536904885, 0.4596220521429988, 0.4506163728516102,
234+
0.05611679472790398, 0.41469073616930296, 0.4662889916108893, 1.0E-5,
235+
0.3534310494315174, 0.4477496639046428, 0.19391289970963096,
236+
0.09647721646228848, 0.07308633354123334, 1.0E-5, 0.4458567825806172,
237+
0.042402269698742015, 0.25336376918476833, 0.1604594387044829,
238+
0.2552475370479657, 0.14908202819195338, 0.1715479419363129,
239+
0.09240843722873682],
240+
:types
241+
[{:id 0,
242+
:rmax 22.86349110354877,
243+
:color [31.0 119.0 180.0 255.0],
244+
:friction 0.7601831434324019,
245+
:directional? false}
246+
{:id 1,
247+
:rmax 49.79661987038962,
248+
:color [255.0 127.0 14.0 255.0],
249+
:friction 0.8783872977760014,
250+
:directional? true}
251+
{:id 2,
252+
:rmax 25.025388507912442,
253+
:color [44.0 160.0 44.0 255.0],
254+
:friction 0.8479055550231204,
255+
:directional? false}
256+
{:id 3,
257+
:rmax 75.35682558801884,
258+
:color [214.0 39.0 40.0 255.0],
259+
:friction 0.8866316497140466,
260+
:directional? true}
261+
{:id 4,
262+
:rmax 62.630326653746465,
263+
:color [148.0 103.0 189.0 255.0],
264+
:friction 0.9419449593651739,
265+
:directional? false}],
266+
:fmult 21.256799389828544}
267+
268+
:s1 {:n 3,
269+
:alpha
270+
[-0.2878465209499428, 0.3463005068872791, 0.2987004015528645,
271+
0.3314686112984623, 0.9638365915599234, 0.0, 0.0, 0.409478856063085,
272+
0.9782069295942872],
273+
:beta
274+
[1.0E-5, 1.0E-5, 0.11977249430498567, 0.28028181676786035,
275+
0.16076709471770154, 0.1745661371553218, 0.32387773897765815,
276+
0.30520192473181557, 0.130891008790613],
277+
:types
278+
[{:id 0,
279+
:rmax 32.001238494811865,
280+
:color [31.0 119.0 180.0 255.0],
281+
:friction 0.8140996451576056,
282+
:directional? false}
283+
{:id 1,
284+
:rmax 75.82987151812112,
285+
:color [255.0 127.0 14.0 255.0],
286+
:friction 0.9343131741539131,
287+
:directional? false}
288+
{:id 2,
289+
:rmax 94.72174580527093,
290+
:color [44.0 160.0 44.0 255.0],
291+
:friction 0.8919310657290059,
292+
:directional? false}],
293+
:fmult 6.227255807255642}}
294+
)

Diff for: src/ex70_bitfields.clj

+2
Original file line numberDiff line numberDiff line change
@@ -61,3 +61,5 @@
6161
(utils/show-image c)))
6262

6363
(bitfield)
64+
65+
(m/unuse-primitive-operators)

Diff for: src/neuroevolution/car.clj

+49
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
(ns neuroevolution.car
2+
(:require [fastmath.vector :as v]
3+
[fastmath.random :as r]
4+
[fastmath.core :as m]
5+
[neuroevolution.noise :as n])
6+
(:import [fastmath.vector Vec2]))
7+
8+
(set! *warn-on-reflection* true)
9+
(set! *unchecked-math* :warn-on-boxed)
10+
11+
(def ^:const MAX-VELOCITY 15.0)
12+
(def ^:const MAX-ACCELERATION-F 1.0)
13+
(def ^:const MAX-ACCELERATION-B 0.4)
14+
(def ^:const MAX-ROTATION 0.05)
15+
(def ^:const FRICTION 0.92)
16+
17+
(defrecord Car [position velocity ^double angle direction])
18+
19+
(defn car
20+
([position] (car position (r/drand m/TWO_PI)))
21+
([position ^double angle] (car position (v/vec2 0.0 0.0) angle))
22+
([position velocity ^double angle]
23+
(->Car position velocity angle (v/vec2 (m/cos angle) (m/sin angle)))))
24+
25+
(def basket-offset (v/vec2 30.0 0.0))
26+
27+
(defn baskets-position [^Car car]
28+
(let [rotated (v/rotate basket-offset (m/- (.angle car) m/HALF_PI))]
29+
[(v/add (.position car) rotated)
30+
(v/sub (.position car) rotated)]))
31+
32+
(defn step
33+
[^Car car ^double acc ^double rot]
34+
(let [^Vec2 pos (.position car)
35+
#_#_ drag (get-in n/grad-map [(unchecked-int (.x pos)) (unchecked-int (.y pos))])
36+
rot (m/* MAX-ROTATION (m/constrain rot -1.0 1.0))
37+
acc (let [a (m/constrain acc -1.0 1.0)]
38+
(if (m/neg? a)
39+
(m/* MAX-ACCELERATION-B a)
40+
(m/* MAX-ACCELERATION-F a)))
41+
npos (v/add pos (.velocity car))
42+
nvel (-> (.direction car)
43+
(v/mult acc)
44+
(v/add (.velocity car))
45+
#_ (v/add drag)
46+
(v/mult FRICTION)
47+
(v/limit MAX-VELOCITY))
48+
nangle (m/mod (m/+ (.angle car) rot) m/TWO_PI)]
49+
(Car. npos nvel nangle (v/vec2 (m/cos nangle) (m/sin nangle)))))

Diff for: src/neuroevolution/chromosome.clj

+46
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
(ns neuroevolution.chromosome
2+
(:require [fastmath.core :as m]
3+
[fastmath.random :as r])
4+
(:import [fastmath.java Array]))
5+
6+
(set! *warn-on-reflection* true)
7+
(set! *unchecked-math* :warn-on-boxed)
8+
9+
(defn gen-perceptron [^long in] (conj (repeatedly (m/inc in) r/grand)))
10+
(defn gen-layer [[in out]] (reduce concat (repeatedly out (partial gen-perceptron in))))
11+
(defn random-net [profile] (double-array (mapcat gen-layer (partition 2 1 profile))))
12+
13+
(defn mutate [^double probability ^doubles chromosome]
14+
(let [cnt (alength chromosome)
15+
mx (unchecked-int (m/inc (m/* cnt probability)))
16+
^doubles nchr (double-array cnt)]
17+
(System/arraycopy chromosome 0 nchr 0 cnt)
18+
(dotimes [_ (r/irand mx)]
19+
(let [pos (r/irand cnt)]
20+
(Array/aset nchr pos (case (unchecked-int (r/irand 10))
21+
0 (m/* 2.0 (Array/aget chromosome pos))
22+
1 (m/- (Array/aget chromosome pos))
23+
2 (m/* 0.5 (Array/aget chromosome pos))
24+
3 (r/grand 2)
25+
4 (r/grand 10)
26+
5 (r/grand 100)
27+
6 (m/* 1.1 (Array/aget chromosome pos))
28+
7 (m/* 0.9 (Array/aget chromosome pos))
29+
(r/grand)))))
30+
nchr))
31+
32+
(defn crossover
33+
([[chromosome1 chromosome2]] (crossover chromosome1 chromosome2))
34+
([^doubles chromosome1 ^doubles chromosome2]
35+
(let [cnt (alength chromosome1)
36+
p (r/irand 1 cnt)
37+
p- (m/- cnt p)
38+
t1 (double-array cnt)
39+
t2 (double-array cnt)]
40+
(System/arraycopy chromosome1 0 t1 0 p)
41+
(System/arraycopy chromosome2 p t1 p p-)
42+
(System/arraycopy chromosome2 0 t2 0 p)
43+
(System/arraycopy chromosome1 p t2 p p-)
44+
[t1 t2])))
45+
46+

0 commit comments

Comments
 (0)