Skip to content

Instantly share code, notes, and snippets.

@devstopfix

devstopfix/ants.clje

Last active May 14, 2020 15:53
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save devstopfix/4bbe8eb45a765198bba9cd11a95a26bf to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save devstopfix/4bbe8eb45a765198bba9cd11a95a26bf to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. devstopfix revised this gist May 14, 2020. 1 changed file with 183 additions and 178 deletions.
    361 changes: 183 additions & 178 deletions ants.clje
    View file
    Original file line number Diff line number Diff line change
    @@ -11,13 +11,13 @@
    ; Video of the original code :- https://www.youtube.com/watch?v=dGVqrGmwOAw
    ; Announcment :- https://groups.google.com/forum/#!msg/clojure/Zq76uzzkS8M/UzfXj9jKyw4J
    ;
    ;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ant sim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;
    ; Conversion to clojerl - Clojure running on the BEAM
    ;
    ; Download from http://clojerl.org/ make and run with
    ;
    ; bin/clje ants.clje
    ; bin/clje -m ants
    ;
    ; The code is ported directly. The only differences are:
    ;
    @@ -34,19 +34,17 @@
    ; which serializes the actions - the actions will then succeed or fail and the ant
    ; will adjust acordingly. ie the first ant will get the food, the second will have
    ; to re-evaulate their decision on their next turn.
    ; 3. render-place does not paint the pheremone trail - there are too many rectangles
    ; per frame! However the code exists and can be uncommented.
    ;
    ; (c) 2020 Devstopfix
    ;
    ;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜
    ; (c) 2020 Devstopfix and Juan Facorro
    ;
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ant sim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (ns ants)

    ;dimensions of square world
    (def dim 80)
    (def dim 80)
    ;number of ants = nants-sqrt^2
    (def nants-sqrt 7)
    (def nants-sqrt 7)
    ;number of places with food
    (def food-places 35)
    ;range of amount of food at a place
    @@ -55,70 +53,70 @@
    ;evaporation rate
    (def evap-rate 0.99)

    (def animation-sleep-ms (quot 1000 5)) ; 5 fps
    (def animation-sleep-ms (quot 1000 10)) ; 5 fps
    (def ant-sleep-ms (quot 1000 25)) ; 25 fps
    (def evap-sleep-ms 1000)

    (ns ants.sim (:use ants))

    (defrecord cell [food pher home]) ; may also have ant

    (defn new-world [dim]
    (apply vector
    (map (fn [_]
    (apply vector (map (fn [_] (cell. 0 0 false))
    (range dim))))
    (defn new-world [dim]
    (apply vector
    (map (fn [_]
    (apply vector (map (fn [_] (cell. 0 0 false))
    (range dim))))
    (range dim))))

    (defn evaporate [cell] (update cell :pher * evap-rate))

    (def world-fn
    (fn* [world]
    (receive*

    #erl [:place pid loc]
    (let [[x y] loc
    cell (-> world (nth x) (nth y))]
    (erlang/send pid #erl[:cell cell])
    (world-fn world))

    #erl [:drop-food loc]
    (let [[x y] loc]
    (world-fn (update-in world [x y] update :food inc)))

    #erl [:move-ant pid ant from to]
    (let [[x1 y1] from [x2 y2] to]
    (if (-> world (nth x2) (nth y2) (:ant))
    (do
    (erlang/send pid #erl[:moved false])
    (world-fn world))
    (do
    (erlang/send pid #erl[:moved true])
    (-> world
    (update-in [x1 y1] update :pher inc)
    (update-in [x1 y1] dissoc :ant)
    (update-in [x2 y2] assoc :ant (select-keys ant [:dir :food]))
    (world-fn)))))

    #erl [:take-food pid loc]
    (let [[x y] loc]
    (let [available-food (-> world (nth x) (nth y) (:food))]
    (if (pos? available-food)
    (do
    (erlang/send pid #erl[:taken true])
    (world-fn (update-in world [x y] update :food dec)))
    (do
    (erlang/send pid #erl[:taken false])
    (world-fn world)))))

    :snapshot
    (do
    (erlang/send :graphics #erl[:world world])
    (world-fn world))

    :evaporate
    (let [map-vec (comp vec map)]
    (world-fn (map-vec (partial map-vec evaporate) world))))))
    (defn world-fn
    [world]
    (receive*

    #erl [:place pid loc]
    (let [[x y] loc
    cell (-> world (nth x) (nth y))]
    (erlang/send pid #erl[:cell cell])
    (recur world))

    #erl [:drop-food loc]
    (let [[x y] loc]
    (recur (update-in world [x y] update :food inc)))

    #erl [:move-ant pid ant from to]
    (let [[x1 y1] from [x2 y2] to]
    (if (-> world (nth x2) (nth y2) (:ant))
    (do
    (erlang/send pid #erl[:moved false])
    (recur world))
    (do
    (erlang/send pid #erl[:moved true])
    (-> world
    (update-in [x1 y1] update :pher inc)
    (update-in [x1 y1] dissoc :ant)
    (update-in [x2 y2] assoc :ant (select-keys ant [:dir :food]))
    (recur)))))

    #erl [:take-food pid loc]
    (let [[x y] loc]
    (let [available-food (-> world (nth x) (nth y) (:food))]
    (if (pos? available-food)
    (do
    (erlang/send pid #erl[:taken true])
    (recur (update-in world [x y] update :food dec)))
    (do
    (erlang/send pid #erl[:taken false])
    (recur world)))))

    :snapshot
    (do
    (erlang/send :graphics #erl[:world world])
    (recur world))

    :evaporate
    (let [map-vec (comp vec map)]
    (recur (map-vec (partial map-vec evaporate) world)))))

    (defn place [loc]
    (erlang/send :world #erl[:place (erlang/self) loc])
    @@ -128,8 +126,8 @@
    (defn home-places [] (for [x home-range y home-range] [x y]))

    (defn make-home [world]
    (reduce
    (fn [world loc]
    (reduce
    (fn [world loc]
    (-> world
    (update-in loc assoc :home true)
    (update-in loc assoc :ant {:dir (rand-int 4)})))
    @@ -138,7 +136,7 @@

    (defn make-food [world]
    (reduce
    (fn [world n]
    (fn [world n]
    (let [loc [(rand-int dim) (rand-int dim)]
    f (-> food-range (rand-int) (inc))]
    (update-in world loc assoc :food f)))
    @@ -160,15 +158,15 @@

    (def dir-count (count dir-delta))

    (defn bound
    (defn bound
    "returns n wrapped into range 0-b"
    [b n]
    (let [n (rem n b)]
    (if (neg? n)
    (+ n b)
    (if (neg? n)
    (+ n b)
    n)))

    (defn wrand
    (defn wrand
    "given a vector of slice sizes, returns the index of a slice given a
    random spin of a roulette wheel with compartments proportional to
    slices."
    @@ -180,20 +178,20 @@
    i
    (recur (inc i) (+ (slices i) sum))))))

    (defn delta-loc
    (defn delta-loc
    "returns the location one step in the given dir. Note the world is a torus"
    [[x y] dir]
    (let [[dx dy] (dir-delta (bound dir-count dir))]
    [(bound dim (+ x dx)) (bound dim (+ y dy))]))

    (defn rank-by
    (defn rank-by
    "returns a map of xs to their 1-based rank when sorted by keyfn"
    [keyfn xs]
    (let [sorted (sort-by (comp float keyfn) xs)]
    (reduce (fn [ret i] (assoc ret (nth sorted i) (inc i)))
    {} (range (count sorted)))))

    ; Ant process tracks the location of an ant, and controls the behavior of
    ; Ant process tracks the location of an ant, and controls the behavior of
    ; the ant at that location

    (defrecord ant [loc dir]) ; may also have food
    @@ -226,7 +224,7 @@

    (defn behave [ant]
    (let [loc (:loc ant)
    p (place loc)
    p (place loc)
    ahead (ant-place ant identity)
    ahead-left (ant-place ant dec)
    ahead-right (ant-place ant inc)
    @@ -243,11 +241,11 @@
    (try-move-ant ant)

    :else
    (let [ranks (merge-with +
    (let [ranks (merge-with +
    (rank-by #(if (:home %) 1 0) places)
    (rank-by :pher places))]
    (([try-move-ant #(turn % -1) #(turn % 1)]
    (wrand [(if (:ant ahead) 0 (ranks ahead))
    (wrand [(if (:ant ahead) 0 (ranks ahead))
    (ranks ahead-left) (ranks ahead-right)]))
    ant)))

    @@ -263,99 +261,90 @@

    (and (pos? (:food ahead)) (not (:home ahead)) (not (:ant ahead)))
    (try-move-ant ant)
    :else ; wander
    (let [ranks (merge-with +

    :else ; wander
    (let [ranks (merge-with +
    (rank-by :food places)
    (rank-by :pher places))]
    (([try-move-ant #(turn % -1) #(turn % 1)]
    (wrand [(if (:ant ahead) 0 (ranks ahead)) (ranks ahead-left) (ranks ahead-right)]))
    ant))))))

    (def ant-fn
    (fn* [state]
    (do
    (timer/sleep ant-sleep-ms)
    (-> state (behave) (ant-fn)))))
    (defn ant-fn
    [state]
    (timer/sleep ant-sleep-ms)
    (recur (behave state)))

    (def evaporator-fn
    (fn* []
    (do
    (timer/sleep evap-sleep-ms)
    (erlang/send :world :evaporate)
    (evaporator-fn))))
    (defn evaporator-fn
    []
    (timer/sleep evap-sleep-ms)
    (erlang/send :world :evaporate)
    (recur))

    (defn run []
    (let [pid (erlang/spawn (fn* [] (world-fn (setup))))]
    (let [pid (erlang/spawn #(world-fn (setup)))]
    (erlang/register :world pid)
    (erlang/spawn (fn* [] (evaporator-fn)))
    (erlang/spawn #(evaporator-fn))
    (doseq [loc (home-places)]
    (let [a (ant. loc (rand-int dir-count))]
    (erlang/spawn (fn* [] (ant-fn a)))))))

    (erlang/spawn #(ant-fn a))))))

    (ns ants.graphics (:use ants))

    (def title "Ants Clojure/BEAM")
    ;scale factor for pheromone drawing
    ; 20.0 is the default,
    ; nil disables paitning)
    (def pher-scale nil) ; 20.0
    (def title "Ants Clojure/BEAM 2020")
    ;scale factor for pheromone drawing
    ; 20.0 is the default,
    ; nil disables painting)
    (def pher-scale 20.0) ; 20.0
    ;scale factor for food drawing
    (def food-scale 30.0)
    ;pixels per world cell
    (def scale 5)
    (def grid-px (* dim scale))

    (defn fill-cell [dc x y brush]
    (let [pen (wxPen/new (wxBrush/getColour brush))]
    (defn fill-cell [dc x y brush pen]
    (wxDC/setBrush dc brush)
    (wxDC/setPen dc pen)
    (wxDC/drawRectangle dc #erl[(* x scale) (* y scale) scale scale])
    (wxPen/destroy pen)))
    (wxDC/drawRectangle dc #erl[(* x scale) (* y scale) scale scale]))

    (def s2 (quot scale 2))
    (def s4 (dec scale))
    (defn render-ant [dc ant x y state]
    (let [[hx hy tx ty] ({0 [s2 0 s2 s4]
    1 [s4 0 0 s4]
    2 [s4 s2 0 s2]
    3 [s4 s4 0 0]
    4 [s2 s4 s2 0]
    5 [ 0 s4 s4 0]
    6 [ 0 s2 s4 s2]
    (let [[hx hy tx ty] ({0 [s2 0 s2 s4]
    1 [s4 0 0 s4]
    2 [s4 s2 0 s2]
    3 [s4 s4 0 0]
    4 [s2 s4 s2 0]
    5 [ 0 s4 s4 0]
    6 [ 0 s2 s4 s2]
    7 [ 0 0 s4 s4]}
    (:dir ant))
    pen (if (:food ant) (:ant-with-food-pen state) (:ant-pen state))]
    (wxDC/setPen dc pen)
    (wxDC/drawLine dc #erl[(+ hx (* x scale)) (+ hy (* y scale))]
    (wxDC/drawLine dc #erl[(+ hx (* x scale)) (+ hy (* y scale))]
    #erl[(+ tx (* x scale)) (+ ty (* y scale))])))

    (defn render-food [dc p x y]
    (defn render-food [dc p x y brush pen]
    (let [alpha (int (min 255 (* 255 (/ (:food p) food-scale))))
    colour #erl[0x8F 0xB5 0xFE alpha]
    brush (wxBrush/new colour)]
    (fill-cell dc x y brush)
    (wxBrush/destroy brush)))
    colour #erl[0x8F 0xB5 0xFE alpha]]
    (wxBrush/setColour brush colour)
    (fill-cell dc x y brush pen)))

    (defn render-pher [dc p x y]
    (defn render-pher [dc p x y brush pen]
    (let [alpha (int (min 255 (* 255 (/ (:pher p) pher-scale))))
    colour #erl[0x91 0xDC 0x47 alpha]
    brush (wxBrush/new colour)]
    (fill-cell dc x y brush)
    (wxBrush/destroy brush)))

    (defn render-place [dc p x y state]
    (when (and pher-scale (pos? (:pher p))) (render-pher dc p x y))
    (when (pos? (:food p)) (render-food dc p x y))
    colour #erl[0x91 0xDC 0x47 alpha]]
    (wxBrush/setColour brush colour)
    (fill-cell dc x y brush pen)))

    (defn render-place [dc p x y state brush pen]
    (when (and pher-scale (pos? (:pher p))) (render-pher dc p x y brush pen))
    (when (pos? (:food p)) (render-food dc p x y brush pen))
    (when-let [ant (:ant p)] (render-ant dc ant x y state)))

    (defn render-bg [dc brush]
    (let [pen (wxPen/new (wxBrush/getColour brush))]
    (wxDC/setPen dc pen)
    (wxDC/setBrush dc brush)
    (wxDC/drawRectangle dc #erl[0 0 grid-px grid-px])
    (wxPen/destroy pen)))
    (defn render-bg [dc brush pen]
    (wxDC/setPen dc pen)
    (wxDC/setBrush dc brush)
    (wxDC/drawRectangle dc #erl[0 0 grid-px grid-px]))

    (defn render-home [dc brush]
    (let [x (* home-off scale) y x
    @@ -366,14 +355,15 @@
    (wxDC/drawRectangle dc #erl[x y w h])
    (wxPen/destroy pen)))

    (defn render [state frame]
    (let [dc (wxClientDC/new frame)]
    (render-bg dc (:bg-brush state))
    (render-home dc (:home-brush state))
    (defn render [state]
    (let [dc (:bitmap-dc state)
    brush (:cell-brush state)
    pen (:cell-pen state)]
    (render-bg dc (:bg-brush state) pen)
    (doseq [[x row] (map-indexed vector (:world state))]
    (doseq [[y cell] (map-indexed vector row)]
    (render-place dc cell x y state)))
    (wxClientDC/destroy dc)))
    (render-place dc cell x y state brush pen)))
    (render-home dc (:home-brush state))))

    (defn make-frame []
    (let [server (wx/new)
    @@ -382,51 +372,66 @@
    (wxWindow/fit frame)
    (wxWindow/setBackgroundStyle panel 2) ; flicker free
    (wxFrame/connect frame :close_window)
    (wxFrame/connect panel :paint)
    (wxFrame/connect panel :paint #erl(:callback))
    (wxFrame/centre frame)
    (wxFrame/show frame)
    panel))

    (def graphics-fn
    (fn* [state]
    (receive*
    #erl[:world world]
    (do
    (wxFrame/refresh (:frame state))
    (graphics-fn (assoc state :world world)))

    #erl[:wx id frame other #erl[:wxPaint :paint]]
    (do
    (render state frame)
    (graphics-fn state))

    #erl[:wx id #erl[:wx_ref r :wxFrame f] #erl"" #erl[:wxClose :close_window]]
    true)))

    (def snapshot-fn
    (fn* []
    (do
    (timer/sleep ants/animation-sleep-ms)
    (erlang/send :world :snapshot)
    (snapshot-fn))))

    (defn fat-pen [r g b]
    (let [pen (wxPen/new #erl[r g b])]
    (wxPen/setWidth pen 2)
    [frame panel]))

    (defn* handle_info
    ([#erl[:world world] state]
    (render state)
    (wxFrame/refresh (:canvas state))
    #erl[:noreply (assoc state :world world)])
    ([_ state]
    #erl[:noreply state]))

    (defn* handle_event
    [#erl[:wx id #erl[:wx_ref r :wxFrame f] #erl"" #erl[:wxClose :close_window]]
    state]
    (erlang/halt 0)
    #erl[:stop :closed state])

    (defn handle_sync_event
    [wx obj state]
    (let [dc (wxPaintDC/new (:canvas state))]
    (wxDC/drawBitmap dc (:bitmap state) #erl[0 0])
    (wxPaintDC/destroy dc))
    :ok)

    (defn snapshot-fn
    []
    (timer/sleep ants/animation-sleep-ms)
    (erlang/send :world :snapshot)
    (recur))

    (defn fat-pen [r g b]
    (let [pen (wxPen/new #erl[r g b])]
    (wxPen/setWidth pen 2)
    pen))

    ; Run simulation and graphics until the user closes the window

    (ants.sim/run)

    (let [frame (make-frame)
    state {:frame frame
    :ant-pen (fat-pen 0 0 0)
    :ant-with-food-pen (fat-pen 0x58 0x81 0xF8)
    :bg-brush (wxBrush/new #erl[238 238 238])
    :border-pen (wxPen/new #erl[238 238 238])
    :home-brush (wxBrush/new #erl[221 221 221])
    :world []}]
    (erlang/register :graphics (erlang/self))
    (erlang/spawn (fn* [] (snapshot-fn)))
    (graphics-fn state))
    (defn init [_]
    (let [[frame canvas] (make-frame)
    bitmap (wxBitmap/new grid-px grid-px)
    state {:canvas canvas
    :bitmap bitmap
    :bitmap-dc (wxMemoryDC/new bitmap)
    :ant-pen (fat-pen 0 0 0)
    :ant-with-food-pen (fat-pen 0x58 0x81 0xF8)
    :bg-brush (wxBrush/new #erl[238 238 238])
    :border-pen (wxPen/new #erl[238 238 238])
    :home-brush (wxBrush/new #erl[221 221 221 0])
    :cell-brush (wxBrush/new #erl[0 0 0])
    :cell-pen (wxPen/new #erl[0 0 0 0] #erl(#erl[:width 0]))
    :world []}]
    (erlang/register :graphics (erlang/self))
    (erlang/spawn #(snapshot-fn))
    #erl[frame state]))

    (ns ants)

    (defn -main []
    (ants.sim/run)
    (wx_object/start :ants.graphics {} #erl())
    (receive*))
  2. James Every revised this gist Apr 24, 2020. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion ants.clje
    View file
    Original file line number Diff line number Diff line change
    @@ -304,7 +304,7 @@
    ;scale factor for food drawing
    (def food-scale 30.0)
    ;pixels per world cell
    (def scale 15)
    (def scale 5)
    (def grid-px (* dim scale))

    (defn fill-cell [dc x y brush]
  3. James Every renamed this gist Apr 24, 2020. 1 changed file with 9 additions and 7 deletions.
    16 changes: 9 additions & 7 deletions ants.clj → ants.clje
    View file
    Original file line number Diff line number Diff line change
    @@ -7,7 +7,7 @@
    ; the terms of this license.
    ; You must not remove this notice, or any other, from this software.
    ;
    ; Original Clojure JVM code :- https://gist.github.com/devstopfix/b60bdc67a6557286f14b035f2f993536
    ; Original Clojure JVM code :- https://gist.github.com/michiakig/1093917
    ; Video of the original code :- https://www.youtube.com/watch?v=dGVqrGmwOAw
    ; Announcment :- https://groups.google.com/forum/#!msg/clojure/Zq76uzzkS8M/UzfXj9jKyw4J
    ;
    @@ -17,7 +17,7 @@
    ;
    ; Download from http://clojerl.org/ make and run with
    ;
    ; bin/clje ants.clj
    ; bin/clje ants.clje
    ;
    ; The code is ported directly. The only differences are:
    ;
    @@ -27,7 +27,7 @@
    ; (defmacro dosync [& body]
    ; `(sync nil ~@body))
    ;
    ; This allows updates to an agent and a ref in a transaction. We use optimistic locking.
    ; This allows updates to two agents in a transaction. We use optimistic locking.
    ; A process may inspect the world and make a decision. If two ants come to the
    ; same decision (pick up the same piece of food, or move to the same square) when
    ; they come to action the decision they will send a message to the world process
    @@ -297,12 +297,14 @@
    (ns ants.graphics (:use ants))

    (def title "Ants Clojure/BEAM")
    ;scale factor for pheromone drawing
    (def pher-scale 20.0)
    ;scale factor for pheromone drawing
    ; 20.0 is the default,
    ; nil disables paitning)
    (def pher-scale nil) ; 20.0
    ;scale factor for food drawing
    (def food-scale 30.0)
    ;pixels per world cell
    (def scale 5)
    (def scale 15)
    (def grid-px (* dim scale))

    (defn fill-cell [dc x y brush]
    @@ -344,7 +346,7 @@
    (wxBrush/destroy brush)))

    (defn render-place [dc p x y state]
    ; (when (pos? (:pher p)) (render-pher dc p x y))
    (when (and pher-scale (pos? (:pher p))) (render-pher dc p x y))
    (when (pos? (:food p)) (render-food dc p x y))
    (when-let [ant (:ant p)] (render-ant dc ant x y state)))

  4. James Every revised this gist Apr 24, 2020. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion ants.clj
    View file
    Original file line number Diff line number Diff line change
    @@ -17,7 +17,7 @@
    ;
    ; Download from http://clojerl.org/ make and run with
    ;
    ; bin/clje ants.clje
    ; bin/clje ants.clj
    ;
    ; The code is ported directly. The only differences are:
    ;
  5. James Every renamed this gist Apr 24, 2020. 1 changed file with 0 additions and 0 deletions.
    0 ants.clje → ants.clj
    View file
    File renamed without changes.
  6. James Every revised this gist Apr 24, 2020. 1 changed file with 1 addition and 0 deletions.
    1 change: 1 addition & 0 deletions ants.clje
    View file
    Original file line number Diff line number Diff line change
    @@ -9,6 +9,7 @@
    ;
    ; Original Clojure JVM code :- https://gist.github.com/devstopfix/b60bdc67a6557286f14b035f2f993536
    ; Video of the original code :- https://www.youtube.com/watch?v=dGVqrGmwOAw
    ; Announcment :- https://groups.google.com/forum/#!msg/clojure/Zq76uzzkS8M/UzfXj9jKyw4J
    ;
    ;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜
    ;
  7. James Every revised this gist Apr 24, 2020. 1 changed file with 2 additions and 2 deletions.
    4 changes: 2 additions & 2 deletions ants.clje
    View file
    Original file line number Diff line number Diff line change
    @@ -7,7 +7,7 @@
    ; the terms of this license.
    ; You must not remove this notice, or any other, from this software.
    ;
    ; Original Clojure JVM code :- https://gist.github.com/michiakig/1093917
    ; Original Clojure JVM code :- https://gist.github.com/devstopfix/b60bdc67a6557286f14b035f2f993536
    ; Video of the original code :- https://www.youtube.com/watch?v=dGVqrGmwOAw
    ;
    ;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜
    @@ -26,7 +26,7 @@
    ; (defmacro dosync [& body]
    ; `(sync nil ~@body))
    ;
    ; This allows updates to two agents in a transaction. We use optimistic locking.
    ; This allows updates to an agent and a ref in a transaction. We use optimistic locking.
    ; A process may inspect the world and make a decision. If two ants come to the
    ; same decision (pick up the same piece of food, or move to the same square) when
    ; they come to action the decision they will send a message to the world process
  8. James Every revised this gist Apr 24, 2020. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion ants.clje
    View file
    Original file line number Diff line number Diff line change
    @@ -1,5 +1,5 @@
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ant sim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ; Copyright (c) Rich Hickey. All rights reserved.
    ; Copyright (c) 2008 Rich Hickey. All rights reserved.
    ; The use and distribution terms for this software are covered by the
    ; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
    ; which can be found in the file CPL.TXT at the root of this distribution.
  9. James Every created this gist Apr 14, 2020.
    429 changes: 429 additions & 0 deletions ants.clje
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,429 @@
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ant sim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ; Copyright (c) Rich Hickey. All rights reserved.
    ; The use and distribution terms for this software are covered by the
    ; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
    ; which can be found in the file CPL.TXT at the root of this distribution.
    ; By using this software in any fashion, you are agreeing to be bound by
    ; the terms of this license.
    ; You must not remove this notice, or any other, from this software.
    ;
    ; Original Clojure JVM code :- https://gist.github.com/michiakig/1093917
    ; Video of the original code :- https://www.youtube.com/watch?v=dGVqrGmwOAw
    ;
    ;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜
    ;
    ; Conversion to clojerl - Clojure running on the BEAM
    ;
    ; Download from http://clojerl.org/ make and run with
    ;
    ; bin/clje ants.clje
    ;
    ; The code is ported directly. The only differences are:
    ;
    ; 1. the Clojure JVM code modelled Ants as threads, we use one process per Ant on the BEAM
    ; 2. Clojure updates state using STM and this wrapper:
    ;
    ; (defmacro dosync [& body]
    ; `(sync nil ~@body))
    ;
    ; This allows updates to two agents in a transaction. We use optimistic locking.
    ; A process may inspect the world and make a decision. If two ants come to the
    ; same decision (pick up the same piece of food, or move to the same square) when
    ; they come to action the decision they will send a message to the world process
    ; which serializes the actions - the actions will then succeed or fail and the ant
    ; will adjust acordingly. ie the first ant will get the food, the second will have
    ; to re-evaulate their decision on their next turn.
    ; 3. render-place does not paint the pheremone trail - there are too many rectangles
    ; per frame! However the code exists and can be uncommented.
    ;
    ; (c) 2020 Devstopfix
    ;
    ;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜

    (ns ants)

    ;dimensions of square world
    (def dim 80)
    ;number of ants = nants-sqrt^2
    (def nants-sqrt 7)
    ;number of places with food
    (def food-places 35)
    ;range of amount of food at a place
    (def food-range 100)
    (def home-off (quot dim 4))
    ;evaporation rate
    (def evap-rate 0.99)

    (def animation-sleep-ms (quot 1000 5)) ; 5 fps
    (def ant-sleep-ms (quot 1000 25)) ; 25 fps
    (def evap-sleep-ms 1000)

    (ns ants.sim (:use ants))

    (defrecord cell [food pher home]) ; may also have ant

    (defn new-world [dim]
    (apply vector
    (map (fn [_]
    (apply vector (map (fn [_] (cell. 0 0 false))
    (range dim))))
    (range dim))))

    (defn evaporate [cell] (update cell :pher * evap-rate))

    (def world-fn
    (fn* [world]
    (receive*

    #erl [:place pid loc]
    (let [[x y] loc
    cell (-> world (nth x) (nth y))]
    (erlang/send pid #erl[:cell cell])
    (world-fn world))

    #erl [:drop-food loc]
    (let [[x y] loc]
    (world-fn (update-in world [x y] update :food inc)))

    #erl [:move-ant pid ant from to]
    (let [[x1 y1] from [x2 y2] to]
    (if (-> world (nth x2) (nth y2) (:ant))
    (do
    (erlang/send pid #erl[:moved false])
    (world-fn world))
    (do
    (erlang/send pid #erl[:moved true])
    (-> world
    (update-in [x1 y1] update :pher inc)
    (update-in [x1 y1] dissoc :ant)
    (update-in [x2 y2] assoc :ant (select-keys ant [:dir :food]))
    (world-fn)))))

    #erl [:take-food pid loc]
    (let [[x y] loc]
    (let [available-food (-> world (nth x) (nth y) (:food))]
    (if (pos? available-food)
    (do
    (erlang/send pid #erl[:taken true])
    (world-fn (update-in world [x y] update :food dec)))
    (do
    (erlang/send pid #erl[:taken false])
    (world-fn world)))))

    :snapshot
    (do
    (erlang/send :graphics #erl[:world world])
    (world-fn world))

    :evaporate
    (let [map-vec (comp vec map)]
    (world-fn (map-vec (partial map-vec evaporate) world))))))

    (defn place [loc]
    (erlang/send :world #erl[:place (erlang/self) loc])
    (receive* #erl[:cell cell] cell))

    (def home-range (range home-off (+ nants-sqrt home-off)))
    (defn home-places [] (for [x home-range y home-range] [x y]))

    (defn make-home [world]
    (reduce
    (fn [world loc]
    (-> world
    (update-in loc assoc :home true)
    (update-in loc assoc :ant {:dir (rand-int 4)})))
    world
    (home-places)))

    (defn make-food [world]
    (reduce
    (fn [world n]
    (let [loc [(rand-int dim) (rand-int dim)]
    f (-> food-range (rand-int) (inc))]
    (update-in world loc assoc :food f)))
    world
    (range food-places)))

    (defn setup [] (-> dim (new-world) (make-home) (make-food)))

    ;dirs are 0-7, starting at north and going clockwise
    ;these are the deltas in order to move one step in given dir
    (def dir-delta {0 [0 -1]
    1 [1 -1]
    2 [1 0]
    3 [1 1]
    4 [0 1]
    5 [-1 1]
    6 [-1 0]
    7 [-1 -1]})

    (def dir-count (count dir-delta))

    (defn bound
    "returns n wrapped into range 0-b"
    [b n]
    (let [n (rem n b)]
    (if (neg? n)
    (+ n b)
    n)))

    (defn wrand
    "given a vector of slice sizes, returns the index of a slice given a
    random spin of a roulette wheel with compartments proportional to
    slices."
    [slices]
    (let [total (reduce + slices)
    r (rand total)]
    (loop [i 0 sum 0]
    (if (< r (+ (slices i) sum))
    i
    (recur (inc i) (+ (slices i) sum))))))

    (defn delta-loc
    "returns the location one step in the given dir. Note the world is a torus"
    [[x y] dir]
    (let [[dx dy] (dir-delta (bound dir-count dir))]
    [(bound dim (+ x dx)) (bound dim (+ y dy))]))

    (defn rank-by
    "returns a map of xs to their 1-based rank when sorted by keyfn"
    [keyfn xs]
    (let [sorted (sort-by (comp float keyfn) xs)]
    (reduce (fn [ret i] (assoc ret (nth sorted i) (inc i)))
    {} (range (count sorted)))))

    ; Ant process tracks the location of an ant, and controls the behavior of
    ; the ant at that location

    (defrecord ant [loc dir]) ; may also have food

    (defn take-food [loc]
    (erlang/send :world #erl[:take-food (erlang/self) loc])
    (receive* #erl[:taken f] f))

    (defn move-ant [ant from to]
    (erlang/send :world #erl[:move-ant (erlang/self) ant from to])
    (receive* #erl[:moved b] b))

    (defn ant-place [ant dir-delta]
    "Find a place that an ant could move to"
    (-> (:loc ant)
    (delta-loc (dir-delta (:dir ant)))
    (place)))

    (defn turn [ant amt]
    (let [dir (bound dir-count (+ (:dir ant) amt))]
    (assoc ant :dir dir)))

    (defn turn-about [ant] (turn ant (quot dir-count 2)))

    (defn try-move-ant [ant]
    (let [loc-ahead (delta-loc (:loc ant) (:dir ant))]
    (if (move-ant ant (:loc ant) loc-ahead)
    (assoc ant :loc loc-ahead)
    ant)))

    (defn behave [ant]
    (let [loc (:loc ant)
    p (place loc)
    ahead (ant-place ant identity)
    ahead-left (ant-place ant dec)
    ahead-right (ant-place ant inc)
    places [ahead ahead-left ahead-right]]
    (if (:food ant)
    ; going home
    (cond
    (:home p)
    (do
    (erlang/send :world #erl[:drop-food loc])
    (dissoc ant :food))

    (and (:home ahead) (not (:ant ahead)))
    (try-move-ant ant)

    :else
    (let [ranks (merge-with +
    (rank-by #(if (:home %) 1 0) places)
    (rank-by :pher places))]
    (([try-move-ant #(turn % -1) #(turn % 1)]
    (wrand [(if (:ant ahead) 0 (ranks ahead))
    (ranks ahead-left) (ranks ahead-right)]))
    ant)))

    ; foraging
    (cond
    ; found food in the wild?
    (and (pos? (:food p)) (not (:home p)))
    (if (take-food loc)
    (-> ant
    (assoc :food true)
    (turn-about))
    ant)

    (and (pos? (:food ahead)) (not (:home ahead)) (not (:ant ahead)))
    (try-move-ant ant)

    :else ; wander
    (let [ranks (merge-with +
    (rank-by :food places)
    (rank-by :pher places))]
    (([try-move-ant #(turn % -1) #(turn % 1)]
    (wrand [(if (:ant ahead) 0 (ranks ahead)) (ranks ahead-left) (ranks ahead-right)]))
    ant))))))

    (def ant-fn
    (fn* [state]
    (do
    (timer/sleep ant-sleep-ms)
    (-> state (behave) (ant-fn)))))

    (def evaporator-fn
    (fn* []
    (do
    (timer/sleep evap-sleep-ms)
    (erlang/send :world :evaporate)
    (evaporator-fn))))

    (defn run []
    (let [pid (erlang/spawn (fn* [] (world-fn (setup))))]
    (erlang/register :world pid)
    (erlang/spawn (fn* [] (evaporator-fn)))
    (doseq [loc (home-places)]
    (let [a (ant. loc (rand-int dir-count))]
    (erlang/spawn (fn* [] (ant-fn a)))))))


    (ns ants.graphics (:use ants))

    (def title "Ants Clojure/BEAM")
    ;scale factor for pheromone drawing
    (def pher-scale 20.0)
    ;scale factor for food drawing
    (def food-scale 30.0)
    ;pixels per world cell
    (def scale 5)
    (def grid-px (* dim scale))

    (defn fill-cell [dc x y brush]
    (let [pen (wxPen/new (wxBrush/getColour brush))]
    (wxDC/setBrush dc brush)
    (wxDC/setPen dc pen)
    (wxDC/drawRectangle dc #erl[(* x scale) (* y scale) scale scale])
    (wxPen/destroy pen)))

    (def s2 (quot scale 2))
    (def s4 (dec scale))
    (defn render-ant [dc ant x y state]
    (let [[hx hy tx ty] ({0 [s2 0 s2 s4]
    1 [s4 0 0 s4]
    2 [s4 s2 0 s2]
    3 [s4 s4 0 0]
    4 [s2 s4 s2 0]
    5 [ 0 s4 s4 0]
    6 [ 0 s2 s4 s2]
    7 [ 0 0 s4 s4]}
    (:dir ant))
    pen (if (:food ant) (:ant-with-food-pen state) (:ant-pen state))]
    (wxDC/setPen dc pen)
    (wxDC/drawLine dc #erl[(+ hx (* x scale)) (+ hy (* y scale))]
    #erl[(+ tx (* x scale)) (+ ty (* y scale))])))

    (defn render-food [dc p x y]
    (let [alpha (int (min 255 (* 255 (/ (:food p) food-scale))))
    colour #erl[0x8F 0xB5 0xFE alpha]
    brush (wxBrush/new colour)]
    (fill-cell dc x y brush)
    (wxBrush/destroy brush)))

    (defn render-pher [dc p x y]
    (let [alpha (int (min 255 (* 255 (/ (:pher p) pher-scale))))
    colour #erl[0x91 0xDC 0x47 alpha]
    brush (wxBrush/new colour)]
    (fill-cell dc x y brush)
    (wxBrush/destroy brush)))

    (defn render-place [dc p x y state]
    ; (when (pos? (:pher p)) (render-pher dc p x y))
    (when (pos? (:food p)) (render-food dc p x y))
    (when-let [ant (:ant p)] (render-ant dc ant x y state)))

    (defn render-bg [dc brush]
    (let [pen (wxPen/new (wxBrush/getColour brush))]
    (wxDC/setPen dc pen)
    (wxDC/setBrush dc brush)
    (wxDC/drawRectangle dc #erl[0 0 grid-px grid-px])
    (wxPen/destroy pen)))

    (defn render-home [dc brush]
    (let [x (* home-off scale) y x
    w (* nants-sqrt scale) h w
    pen (wxPen/new #erl[0x58 0x81 0xD8])]
    (wxDC/setPen dc pen)
    (wxDC/setBrush dc brush)
    (wxDC/drawRectangle dc #erl[x y w h])
    (wxPen/destroy pen)))

    (defn render [state frame]
    (let [dc (wxClientDC/new frame)]
    (render-bg dc (:bg-brush state))
    (render-home dc (:home-brush state))
    (doseq [[x row] (map-indexed vector (:world state))]
    (doseq [[y cell] (map-indexed vector row)]
    (render-place dc cell x y state)))
    (wxClientDC/destroy dc)))

    (defn make-frame []
    (let [server (wx/new)
    frame (wxFrame/new server -1 title #erl( #erl[:size #erl[grid-px grid-px]]))
    panel (wxPanel/new frame 0 0 grid-px grid-px)]
    (wxWindow/fit frame)
    (wxWindow/setBackgroundStyle panel 2) ; flicker free
    (wxFrame/connect frame :close_window)
    (wxFrame/connect panel :paint)
    (wxFrame/centre frame)
    (wxFrame/show frame)
    panel))

    (def graphics-fn
    (fn* [state]
    (receive*
    #erl[:world world]
    (do
    (wxFrame/refresh (:frame state))
    (graphics-fn (assoc state :world world)))

    #erl[:wx id frame other #erl[:wxPaint :paint]]
    (do
    (render state frame)
    (graphics-fn state))

    #erl[:wx id #erl[:wx_ref r :wxFrame f] #erl"" #erl[:wxClose :close_window]]
    true)))

    (def snapshot-fn
    (fn* []
    (do
    (timer/sleep ants/animation-sleep-ms)
    (erlang/send :world :snapshot)
    (snapshot-fn))))

    (defn fat-pen [r g b]
    (let [pen (wxPen/new #erl[r g b])]
    (wxPen/setWidth pen 2)
    pen))

    ; Run simulation and graphics until the user closes the window

    (ants.sim/run)

    (let [frame (make-frame)
    state {:frame frame
    :ant-pen (fat-pen 0 0 0)
    :ant-with-food-pen (fat-pen 0x58 0x81 0xF8)
    :bg-brush (wxBrush/new #erl[238 238 238])
    :border-pen (wxPen/new #erl[238 238 238])
    :home-brush (wxBrush/new #erl[221 221 221])
    :world []}]
    (erlang/register :graphics (erlang/self))
    (erlang/spawn (fn* [] (snapshot-fn)))
    (graphics-fn state))