324 - PurelyFunctional.tv Newsletter - Puzzle solutions

00 Langton's Ant.md

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!).

Andreas Werner.clj

(ns langtons-ant.core
  (:import (java.io 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)]
    normalized-grid))

(defn print-grid [grid]
  (let [normalized-grid (normalize-grid grid)]
    (print
      (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 https://stackoverflow.com/questions/6973290/generate-and-save-a-png-image-in-clojure
(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)]
    (do
      (.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)))))


(comment
  (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)
  )

Duminda Rathnayaka.clj

(ns ant.world)

(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
                          ant-pos
                          ant-dir
                          stopped?]
                   :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)))

Eric Normand.clj

(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)})))

(comment
  (reset! state {:blacks #{}
                 :pos [0 0]
                 :dir [0 1]
                 :iteration 0})

  (dotimes [x 100000]
    (swap! state step))

  state
  (count (:blacks @state))
  )

Oliver Muench.clj

ns ants.core
  (:gen-class))

(defn make-board
  "creates nxn board with 1 for black and 0 for white"
  [n]
  ;; (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"
  [board]
  (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]
  (get 
   {0 (- n) ;; north
    1  1    ;; east
    2  n    ;; south
    3 -1 }  ;; west
   newdir))

(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
          (b-and-w)
          (put-A-in-board pos newdir)
          (divide-lines n)
          (print-board)))
       [newboard newpos newdir validpos]))

(defn ausgabe [n board startpos startdir]
  (loop [[r b pos dir validpos] [0 board startpos startdir true]]
    (prn r)
    (cond
      (> 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)))
              40)
        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)))

;; From Stack-Overflow https://stackoverflow.com/questions/6973290/generate-and-save-a-png-image-in-clojure

I love you good developpers