cljgol

cljgol.clj

(ns cljgol.core
  (:use [seesaw core color graphics]))

(set! *unchecked-math* true)
(set! *warn-on-reflection* true)

(def wCells 100)
(def hCells 100)
(def cellSize 5)
(def cellColor (color 0 255 0))
(def statusBarHeight 20)
(def windowWidth (* (long wCells) (long cellSize)))
(def windowHeight (+ (long statusBarHeight) (* (long hCells) (long cellSize))))
(def frameCap 30)
(def maxFrameDuration (long (quot 1000 (long frameCap))))

(defn vec2d
  [sx sy fun]
  (mapv
   (fn[x]
     (mapv (fn [y] (fun x y))
           (range sx)))
   (range sy)))

(defn random-board [] (vec2d wCells hCells (fn [x y] (rand-int 2))))
(def globalBoard (atom (random-board)))


(def lastTime (atom (System/currentTimeMillis)))

;;Using function application variant of collections for more efficient
;;alternative to get-in. We use direct method invocation (uncommon) to and
;;specific type hinting to avoid the more general path that clojure.core/nth
;;provides, since we're doing this "a lot". E.g., this is brittle but more
;;efficient (~9x faster).
(defn look-in [coll ^clojure.lang.Indexed v]
  ((coll (.nth v 0))
   (.nth v 1)))

;;helper function for efficient memoization of our indices. clojure.core/memoize
;;is suboptimal for this use case. Assumes we are not performing concurrent
;;writes.
(defn memo-2 [f]
  (let [xs (java.util.HashMap.)]
    (fn [x y]
      (if-let [^java.util.HashMap ys (.get xs x)]
        (if-let [res (.get ys y)]
          res
          (let [res (f x y)]
            (do (.put ys y res)
                res)))
        (let [res     (f x y)
              ys    (doto (java.util.HashMap.)
                      (.put y res))
              _     (.put xs x ys)]
          res)))))

;;Compute the indices that are adjacent to point [x y]. This will never change,
;;so we can optionally cache the results. Another approach is to define a macro
;;that computes the indices in part of a loop and does something like a
;;reduction without allocating anything. For now, this appears fast enough
;;though. This was very popular when clojure folks were implementing efficient
;;solutions to Brian's Brain (a similar cellular automata thing).
(defn indices* [x y]
    (vec (for [^long i  (range (dec x) (+ 2 x))
               ^long j  (range (dec y) (+ 2 y))
               :let [xnew (mod i wCells)
                     ynew (mod j hCells)]
               :when (or (not= x xnew) (not= y ynew))
               ]
           [xnew ynew])))
;;we'd like to avoid building all these vectors, so we memoize them once.
(alter-var-root #'indices* memo-2)

;;use a function with some perhaps overdone type hinting and direct method
;;invocation to get our values out. This style is perhaps typically less used.
(defn indices [^clojure.lang.Indexed xy]
  (indices* (.nth xy 0) (.nth xy 1)))

;;Our revised version of neighbors eschews creating additional lazy sequences,
;;and just transforms cell values into 0|1, then reduces over them by summing to
;;effect counting. This allows us to avoid map, filter, and count invocations,
;;although we still have some allocation from indices (one time due to
;;memoization). We also get a more efficient traversal of the seq implementation
;;since vectors already implement chunked seqs directly.
(defn neighbors [board p]
  (transduce  (map #(if (pos? (look-in board %)) 1 0))
              (completing (fn [^long l ^long r] (+ l r)))
              0
              (indices p)))

;;Should be faster.
(defn gol ^long [board p]
  (let [v ^int (look-in board p)
        n ^int (neighbors board p)]
    (cond
      (= n 3) 1
      (and (= v 1)
           (= n 2)) 1
      :else 0)))

;;There appears to be some confounding between timing in the original
;;implementation and rendering frames. To decouple the "simulation" speed vs.
;;the rendering, we can just define some helpers that will allow us to roughly
;;gauge how fast our new GOL functions are.

(defn step [board]
  (vec2d wCells hCells (fn [x y] (gol board [x y]))))

(defn steps! [n]
  (dotimes [i n]
    (swap! globalBoard step)))

(defn steps-per-second!
  ([]   (steps-per-second! #(steps %)))
  ([f]
   (let [t1 (System/currentTimeMillis)
         _ (init!)
         _ (f 100)
         t2 (System/currentTimeMillis)]
     (* (/ 100.0 (- t2 t1)) ;;steps/ms
        1000 ;;ms/s
        ))))

(defn init! []
  (reset! globalBoard (random-board)))

;;this is inaccurate, at least to me.
;;It seems to framelock the rendering if sleep is turned on.
;;During experimentation I dropped the sleep and added it in elsewhere.
;;Now it returns the time it took to wait between frames
;;(somewhat useless at the moment) in ms.
(defn fps ^double
  []
  (let [previous (long @lastTime)
        current (long (System/currentTimeMillis))
        diff (- current previous)
        toSleep (long (- (long maxFrameDuration) diff))] 
    #_(when (pos? toSleep) (Thread/sleep toSleep))
    (reset! lastTime (System/currentTimeMillis))
    #_(double (/ 1000 (- (System/currentTimeMillis) previous)))
    (double (- (System/currentTimeMillis) previous))
    ))

(def bigfont (seesaw.font/font "ARIAL-BOLD-24"))

(defn painter [c ^java.awt.Graphics2D g]
  (let [board @globalBoard
        xrange (range 0 wCells)
        yrange (range 0 hCells)
        red  (color 255 0 0)
        blue (color 0 0 255)
        ^long cs cellSize
        tnow (System/currentTimeMillis)]
    (.setColor g red)
    (.drawRect g 0 0 windowWidth (- (long windowHeight) (long statusBarHeight)))
    (.setColor g cellColor)
    ;;should be faster since look-in is on the hot path and more efficient now.
    (doseq [^long i xrange
            ^long j yrange
            :when (== 1  (look-in board [i j]))]
      (.fillRect g (* cs ^long i) (* cs ^long j) cs cs))
    (.setColor g blue)
    (.setFont g ^java.awt.Font bigfont )
    (.drawString g (str "Frame Rendering Time(ms): " (- (System/currentTimeMillis) tnow))
       50 (- (long windowHeight) 5))
    (.drawString g (str "Delay(ms): " (fps)) 50 (- (long windowHeight) 100))
    (reset! globalBoard (step board))))

(def m-canvas
    (canvas :id :mcanvas
            :background :black
            :paint painter))

;;Changed from the timer-based idiom to use something that's less global and
;;more encapsulated. While the frame is visible, we spin up a future that will
;;repaint according to a delay. If the frame is no longer visible, we stop. It's
;;possible to have 0 delay here, in theory rendering as fast as Swing (or
;;seesaw) will allow us to submit repaints.
(defn animate!
  ([frm delay]
   (let [the-frame (atom frm)
         wait (if (pos? delay)
                (fn [] (Thread/sleep delay))
                (fn [] nil))]
     (future (loop []
               (repaint! m-canvas)
               (if (some-> @the-frame
                           visible?)
                 (do (wait)
                     (recur))
                 (println "ending animation"))))))
  ([frm] (animate! frm 17)))

(defn -main
  [& args]
  (let [delay (or (first args) 17)]
    (invoke-later
     (do (reset! globalBoard (random-board))
         (-> (frame :title "Game Of Life",
                    :width (+ 3 (long windowWidth)), :height (+ windowHeight 100),
                    :content m-canvas,
                    #_#_:on-close :exit)
             #_pack!
             show!
             (animate! delay))))))



(comment

  ;;legacy testing...
  ;;We can see how the old functions perform compared to the new
  ;;purely in the simulation update step (computing a new GOL board).
(defn old-neighbors
  [board p]
  (let [x (first p)
        y (second p)
        xrange (range (dec x) (+ 2 x))
        yrange (range (dec y) (+ 2 y))]
    (for [i xrange j yrange
          :let [q [(mod i wCells) (mod j hCells)] ]
          :when (not= p q)]
      (get-in board q))))


(defn old-gol
  [board p]
  (let [v (get-in board p)
        n (count (filter pos? (old-neighbors board p)))]
    (cond
      (= n 3) 1
      (and (= v 1) (= n 2)) 1
      :else 0)))

(defn old-step [board]
  (vec2d wCells hCells (fn [x y] (old-gol board [x y]))))

(defn old-steps! [n]
  (dotimes [i n]
    (swap! globalBoard old-step)))

;; cljgol.core> (steps-per-second! #(old-steps! %))
;; 18.611576400521123
;; cljgol.core> (steps-per-second!)
;; 266.6666666666667
;; cljgol.core>

;;14x is better, and consistent with the gains from the existing bottlenecks.
;;We can still do better though, more to come.
)

Tried playing with it, too, wondering if aget/aset will be better.
No! They use reflection to access the array.
Any idea on how to access nested arrays efficiently?
The best solution I can think of would be with zero allocations, just keeping two nested arrays, using one to draw the other, then swap them

Your ultimate best bet if you go the array route would be to use a flat array and handle the nesting in the indexing (via primitive ops).
Nested arrays aren't bad though, so long as you hint the array you're unpacking.
You can still get past reflection for array access and get very good perf by hinting the array ops. There are a couple of libs that do this, but ones that I've used are:

;;from christophe Garande   - for working on 2d arrays efficiently.
(defmacro deep-aget 
  ([hint array idx]
    `(aget ~(vary-meta array assoc :tag hint) ~idx))
  ([hint array idx & idxs]
    `(let [a# (aget ~(vary-meta array assoc :tag 'objects) ~idx)]
       (deep-aget ~hint a# ~@idxs))))                   

;;from christophe Garande   - for working on 2d arrays efficiently.
(defmacro deep-aset [hint array & idxsv]
  (let [hints '{booleans boolean
                bytes byte
                chars char
                longs long
                ints int
                shorts short
                doubles double
                floats float} 
        [v idx & sxdi] (reverse idxsv)
        idxs (reverse sxdi)
        v (if-let [h (hints hint)] (list h v) v)
        nested-array (if (seq idxs)
                       `(deep-aget ~'objects ~array ~@idxs)
                        array)
        a-sym (with-meta (gensym "a") {:tag hint})]
      `(let [~a-sym ~nested-array]
         (aset ~a-sym ~idx ~v))))  

You can also do like a function wrapper if you have a 2d grid that you know is all primitives, in lieu of the macros above:

(defn ^int get-cell [arr x y]
   (aget ^ints (aget ^objects arr x) y))