Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
324 - Newsletter - Puzzle solutions

Langton's ant (from Rosetta Code)

Langton's ant is a cellular automaton that models an ant sitting on a plane of cells, all of which are white initially, the ant facing in one of four directions.

Each cell can either be black or white.

The ant moves according to the color of the cell it is currently sitting in, with the following rules:

  1. If the cell is black, it changes to white and the ant turns left; If the cell is white, it changes to black and the ant turns right;
  2. The ant then moves forward to the next cell, and repeat from step 1.

This rather simple ruleset leads to an initially chaotic movement pattern, and after about 10,000 steps, a cycle appears where the ant moves steadily away from the starting location in a diagonal corridor about 10 cells wide. Conceptually the ant can then walk infinitely far away.

Model this problem and run it out to 10,000 steps. A 100x100 grid should be sufficient. You can stop if it goes outside of that grid, or if you hit 10,000 steps.

Bonus points for visualizing it (send me pictures!).

(ns langtons-ant.core
(:import ( File)
(java.awt Color)
(java.awt.image BufferedImage)
(javax.imageio ImageIO)))
(defn turn-right [direction]
(condp = direction
;; visualize
(defn add-pos [a b]
(mapv + a b))
(defn normalize-grid [grid]
(let [pos (keys grid)
[minx miny] (->> (reduce #(vector (min (first %1) (first %2)) (min (second %1) (second %2))) [0 0] pos)
(map (fn [x] (Math/abs x))))
normalized-grid (reduce #(assoc %1 (add-pos (first %2) [minx miny]) (second %2)) {} grid)]
(defn print-grid [grid]
(let [normalized-grid (normalize-grid grid)]
(clojure.string/join "\n"
(for [y (range 0 100)]
(apply str (for [x (range 0 100)]
(if (= ::black (get normalized-grid [x y]))
" "))))))))
(def colors {::background Color/WHITE
::black Color/BLACK
::white Color/WHITE})
;; From Stack-Overflow
(defn draw-png
"Take width, height, and the map of mines. Save to a file."
[width height minemap file]
(let [block 5 ;block size
bi (BufferedImage. (* block width) (* block height) BufferedImage/TYPE_INT_ARGB)
g (.createGraphics bi)]
(.setColor g (colors ::background))
(.fillRect g 0 0 (* block width) (* block height))
(doseq [[[x y] high] (normalize-grid minemap)]
(.setColor g (colors high))
(.fillRect g (* block x) (* block y) (dec block) (dec block)))
(ImageIO/write bi "png" (File. file)))))
(move-forward ::south [0 1])
(draw-png 100 100 (langtons-ant :steps 12000) "LangtonAnts.png")
(print-grid (langtons-ant :steps 11000))
(langtons-ant :steps 12000)
(defn init-world [width height]
{:width width
:height height
:grid (into [] (repeat height (into [] (repeat width 0))))
:ant-pos [(quot width 2) (quot height 2)]
:ant-dir :up
:stopped? false})
(defn within-bounds? [[row col] width height]
(and (>= row 0) (>= col 0)
(< row width) (< col height)))
(defn turn-right [dir]
(case dir
:up :right
:right :down
:down :left
:left :up))
(defn turn-left [dir]
(case dir
:up :left
:left :down
:down :right
:right :up))
(defn move [[x y] dir]
(case dir
:up [x (dec y)]
:right [(inc x) y]
:down [x (inc y)]
:left [(dec x) y]))
(defn iter-world [{:keys [width height grid
:as world}]
(if (and (not stopped?) (within-bounds? ant-pos width height))
(let [cell-color (get-in grid ant-pos)
is-white? (= cell-color 0)
next-dir (if is-white? (turn-right ant-dir) (turn-left ant-dir))
next-pos (move ant-pos next-dir)
next-grid (assoc-in grid ant-pos (if is-white? 1 0))]
{:width width
:height height
:grid next-grid
:ant-pos next-pos
:ant-dir next-dir
:stopped? false})
(assoc world :stopped? true)))
(defonce state (atom {:blacks #{}
:pos [0 0]
:dir [0 1]
:iteration 0}))
(def directions [[0 1]
[1 0]
[0 -1]
[-1 0]])
(def turn-right (zipmap directions (rest (cycle directions))))
(def turn-left (zipmap directions (drop 3 (cycle directions))))
(defn step [{:keys [blacks pos dir iteration]}]
(if (contains? blacks pos)
(let [new-dir (turn-left dir)]
{:blacks (disj blacks pos)
:dir new-dir
:pos (mapv + pos new-dir)
:iteration (inc iteration)})
(let [new-dir (turn-right dir)]
{:blacks (conj blacks pos)
:dir new-dir
:pos (mapv + pos new-dir)
:iteration (inc iteration)})))
(reset! state {:blacks #{}
:pos [0 0]
:dir [0 1]
:iteration 0})
(dotimes [x 100000]
(swap! state step))
(count (:blacks @state))
ns ants.core
(defn make-board
"creates nxn board with 1 for black and 0 for white"
;; (vec (take (* n n) (repeatedly #(rand-int 2))))
(vec (take (* n n) (repeat 0)))
(defn put-A-in-board
"The ant will be a small arrow on the board looking in direction `dir'"
[board pos dir]
(let [A (case dir
0 \u21d1
1 \u21d2
2 \u21d3
3 \u21d0) ]
(assoc board pos (str A " "))))
(defn b-and-w
"Transform the board from 0, 1 to black and white tiles"
(vec (map #(if (= % 0) \u25fd \u25fe) board)))
(defn divide-lines [board n]
(loop [b board
out []]
(if (seq b)
(recur (drop n b) (conj out (take n b)))
(conj out (take n (repeat "- "))))))
(defn print-board [board]
(doseq [row board]
(println row))
(Thread/sleep 500))
(defn posdelta [n newdir]
{0 (- n) ;; north
1 1 ;; east
2 n ;; south
3 -1 } ;; west
(defn newdir [d c]
"transform white (0) to 1 and black (1) to -1
for clockwise and counter-clockwise turns resp."
(let [c (- 1 (* 2 c))]
(mod (+ d c) 4)))
(defn conv2d->1d [n coord]
(let [[x y] coord]
(+ (* n y) x)))
(defn conv1d->2d [n pos]
(let [x (mod pos n)
y (quot pos n)]
[x y]))
(defn update-board [n [board pos dir]]
(let [col (nth board pos)
newcol (mod (inc col) 2)
newdir (newdir dir col)
newpos (+ pos (posdelta n newdir))
newboard (assoc board pos newcol)
validpos (and (pos? newpos)
(<= newpos (* n n))
(< (Math/abs (- (mod pos n) (mod newpos n))) 2))]
(if (> n 30)
(println "color:" (if col "black" "white") ","
"dir:" (get ["N" "O" "S" "W"] dir) ","
"pos:" newpos)
(-> board
(put-A-in-board pos newdir)
(divide-lines n)
[newboard newpos newdir validpos]))
(defn ausgabe [n board startpos startdir]
(loop [[r b pos dir validpos] [0 board startpos startdir true]]
(prn r)
(> r 100000) (println (dec r) " rounds are up.")
(not validpos) (println "Your ant fell off the rim of the world.")
:else (recur (cons (inc r) (update-board n [b pos dir validpos])))
(defn -main
[& args]
(let [[n pos] args
n (or (if n (if (number? (read-string n)) (read-string n)))
pos (or (if pos (if (number? (read-string pos)) (read-string pos)))
(conv2d->1d n [(int (/ n 2)) (int (/ n 2))]))]
;; (println "Jetzt geht's los!" n pos)
(ausgabe n (make-board n) pos 0)))
Copy link

Hettomei commented May 8, 2019

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment