2048 game implementation in Clojure

Question

This is my first Clojure program. If you want to run it locally please check out https://github.com/achikin/game2048-clj

core.clj

(ns game2048.core
  (:require [nightlight.core :refer [start]])
  (:require [game2048.ui :as ui])
  (:require [lanterna.screen :as s])
  (:require [game2048.game :as g])
  (:gen-class))

(def x 1)
(def y 1)

(defn game-loop
  [scr board]
    (recur 
     scr 
     (ui/draw-board
      scr x y
      (g/game-step (s/get-key-blocking scr) board))))

(defn -main []
  (let [scr (s/get-screen) board (g/new-board)]
    (s/in-screen scr 
      (do
        (ui/draw-board scr x y board)
        (ui/draw-agenda scr x (+ y (:height g/board-size) 1) g/agenda)
        (game-loop scr board)))))

game.clj

(ns game2048.game
  (:require [game2048.board :as b]))

(def max-score 2048)

(def board-size {:width 4 :height 4})

(def agenda
  '("←↑→↓ - make move"
    "r - reset"
    "q - quit"))

(defn new-board []
  (b/add-random-tiles (b/empty-board board-size)))

(defn process-key
  "Either exit or transform board according to a key passed"
  [key board]
  (case key
    (:up :down :left :right) (b/make-move key board)
    \q (System/exit 0)
    \r (b/empty-board board-size)))

(defn check-board
  "Check for logical conditions and transform board accordingly"
  [board-before-keypress board]
  (let [board-after-rand (b/add-random-tiles board)]
    (cond
      (= board-before-keypress board) board
      (b/full? board-after-rand) (new-board)
      (b/contains-max? max-score board) (new-board)
      :else board-after-rand)))

(defn game-step
  [key board]
  (check-board board
    (process-key key board)))

ui.clj

(ns game2048.ui
 (:require [game2048.board :as b])
 (:require [lanterna.screen :as s]))

(def maxlen 5)

(defn count-digits [n] 
  (if (zero? n) 1
   (-> n Math/log10 Math/floor long inc)))

(defn repeat-str
  [n st]
  (apply str (repeat n st)))

(defn pad-number
  [length number]
  (let [n (count-digits number)
        pads (/ (- length n) 2)]
    (apply str (repeat-str pads " ") (str number) (repeat-str pads " "))))

(defn max-number
  [board]
  (apply max board))

(defn max-length
  [board]
  (+ (count-digits (max-number board)) 2))

(defn draw-row
  ([screen x y row]
   (if-not (empty? row)
      (do
       (s/put-string screen x y (pad-number maxlen (first row)))     
       (recur screen (+ x maxlen) y (rest row))))))

(defn draw-rows
  "Draw each row and update screen"
  [screen x y rows]
  (if-not (empty? rows)
    (do 
      (draw-row screen x y (first rows))
      (recur screen x (inc y) (rest rows)))
    (s/redraw screen)))

(defn draw-board
  "Break board into horizontal rows and draw them into lanterna/screen
  returns initial board for further processing"
  [screen x y board]
  (do
    (draw-rows screen x y (b/part-board :horizontal board))
    board))

(defn draw-agenda
  [scr x y [first & rest]]
  (if first
    (do
      (s/put-string scr x y first)
      (recur scr x (inc y) rest))
    (s/redraw scr)))

board.clj

(ns game2048.board
  (:require [game2048.row :as row]))

(defn get-n-zeroes
  [n]
  (repeat n 0))

(defn empty-board 
  "Board is represented as width, height and 1 dimentional list of fields
  Zero represents empty field"
  [size]
  (merge size {:data (get-n-zeroes (* (:width size) (:height size)))}))

(defn part-board
  "Partition board list into horizontal or vertical slices"
  [direction board]
  (case direction
    :horizontal (partition (:width board) (:data board))
    :vertical (partition (:height board) 
               (apply interleave 
                 (partition (:width board) (:data board))))))

(defn gather
  "Gather board from horizontal or vertical slices
back into map"
  [direction board]
  (case direction
    :horizontal {:width (-> board first count) 
                 :height (count board) 
                 :data (apply concat board)}
    :vertical {:width (count board) 
               :height (-> board first count) 
               :data (apply interleave board)}))

(defn find-indexes
  "Find all indexes of value in collection" 
  [val coll]
  (reduce-kv 
    (fn [a k v] (if (= v val) (conj a k) a))                     
    []
    coll)) 

(defn choose-index
  "Choose random value from collection"
  [indexes]
  (rand-nth indexes))

(defn choose-value 
  "2 chosen with 2/3 probability
   4 chosen with 1/3 probability"
  []
  (rand-nth '(2 2 4)))

(defn rand-replace
  "Replace one value in collection with another one chosen with index-fn"
  [index-fn oldval value-fn coll]
  (let [array (into [] coll)
        indexes (find-indexes oldval array)]
   (if (empty? indexes)
       coll
       (seq (assoc array 
              (index-fn indexes) (value-fn))))))

(defn add-random-tile
  "Replace random zero with 2 or 4 in seq"
  [board]
  (rand-replace choose-index 0 choose-value board))

(defn add-random-tiles
  "Replace random zero with 2 or 4 in board
  in case if you want to add more than one tile"
  [board]
  (assoc board :data (add-random-tile (:data board))))


(defn which-partition
  "Determine if move is horizontal or vertical"
  [direction]
  (if (contains? #{:left :right} direction)
    :horizontal
    :vertical))

"Up movement is eqivalent to left movement
and down movement equivalent to right movement"
(def dir-map 
  {:up :left 
   :down :right 
   :left :left 
   :right :right})

(defn make-move
  "Break board into either horizontal or vertical slices
perform move on each slice, and gather result back into new board"
  [direction board]
  (let [part (which-partition direction)]
    (gather part
      (map #(row/move (direction dir-map) %) (part-board part board)))))

(defn full?
  "True if there are no empty(0) fields left"
  [board]
  (not-any? #{0} (:data board)))

(defn contains-max?
  "True if one of the sells reached maximum value"
  [max-score board]
  (not (empty? (filter #(= max-score %) (:data board)))))

row.clj

(ns game2048.row)

(defmulti padd (fn [direction len coll] direction))
"Pad collections with zeroes either on the left or on the right"
(defmethod padd :left
  [direction len coll]
  (concat (repeat (- len (count coll)) 0) coll))
(defmethod padd :right
  [direction len coll]
  (concat coll (repeat (- len (count coll)) 0)))

(defmulti merger(fn [dir & args] dir))
"Check if there are equal adjustent fields and merge them
e.g. (merger :left '(1 1 2 2)) -> (2 4)"

(defmethod merger :left
  ([dir [first second & rest] newrow]
   (if first
    (if (= first second)
     (recur dir rest (cons (+ first second) newrow))
     (recur dir (cons second rest) (cons first newrow)))
    (reverse newrow)))
  ([dir row]
   (merger dir row '())))

(defmethod merger :right
  [dir row]
  (reverse (merger :left (reverse row))))

(defn remove-zeroes
  "Return collection dropping all zeroes"
  [coll]
  (filter (fn [x] (not (zero? x))) 
    coll))

(defn opposite-dir
  [dir]
  (case dir
    :left :right
    :right :left))

(defn move
  "Remove zeroes, then merge values, then pad result with zeroes
  e.g. (move :left '(1 1 0 2 2) -> (1 1 2 2) -> (2 4 0 0 0)"
  [dir row]
  (let [row-size (count row)]
    (padd (opposite-dir dir) row-size (merger dir (remove-zeroes row)))))

board_test.clj

(ns game2048.board-test
  (:use clojure.test)
  (:require [game2048.board :as b]))

(def empty-board-3-3 
  {:width 3
   :height 3
   :data '(0 0 0 0 0 0 0 0 0)})

(def empty-board-2-4 
  {:width 2
   :height 4
   :data '(0 0 0 0 0 0 0 0)})

(deftest empty-board
  (is (= (b/empty-board {:width 3 :height 3}) empty-board-3-3))
  (is (= (b/empty-board {:width 2 :height 4}) empty-board-2-4)))

(def part-board-2-2
  {:width 2
   :height 2
   :data '(1 1 2 2)})
(def part-board-2-2-left
  {:width 2
   :height 2
   :data '(2 0 4 0)})

(def part-board-2-2-horizontal '((1 1)(2 2)))
(def part-board-2-2-vertical '((1 2)(1 2)))

(deftest part-board
  (is (= (b/part-board :horizontal part-board-2-2) part-board-2-2-horizontal))
  (is (= (b/part-board :vertical part-board-2-2) part-board-2-2-vertical)))

(deftest gather
  (is (= (b/gather :horizontal '((1 1) (2 2))) part-board-2-2))
  (is (= (b/gather :vertical '((1 2) (1 2))) part-board-2-2)))

(defn index-fn-1
  [coll]
  1)

(defn index-fn-3
  [coll]
  3)

(defn value-fn-2
  []
  2)

(defn value-fn-4
  []
  4)
(deftest rand-replace
  (is (= (b/rand-replace index-fn-1 0 value-fn-2 '(0 0 0)) '(0 2 0)))
  (is (= (b/rand-replace index-fn-3 0 value-fn-4 '(0 0 0 0 0)) '(0 0 0 4 0))))

(def board-move
  {:width 2
   :height 2
   :data '(2 4 2 4)})
(def board-move-up
  {:width 2
   :height 2
   :data '(4 8 0 0)})

(def board-move-down
  {:width 2
   :height 2
   :data '(0 0 4 8)})

(deftest make-move
  (is (= (b/make-move :left part-board-2-2) part-board-2-2-left))
  (is (= (b/make-move :up board-move) board-move-up))
  (is (= (b/make-move :down board-move) board-move-down))
  (is (= (b/make-move :right board-move) board-move)))

(deftest full
  (is (b/full? {:width 2 :height 2 :data '(1 2 3 4)}))
  (is (not (b/full? {:width 2 :height 2 :data '(1 2 3 0)}))))

(deftest contains-max
  (is (b/contains-max? 2048 {:width 2 :height 2 :data '(1 2 2048 4)})))

Flowchart

Answer 1

core.clj

(def x 1)
(def y 1)

1. Use more descriptive names. These seem to be used as the origin for rendering the game, so maybe something like x-origin and y-origin would be good.
2. Add docstrings to document the meaning and purpose of each var / function
3. It might be worth-while making these dynamic vars. Then you can render the game in a different location (e.g., if you want to render two games for head-to-head competition) using bindings.
4. You could combine the two into a single *origin* var.

Combining these points, you'd end up with something like:

(def ^:dynamic *origin*
  "Defines the origin at which to render the game"
  [1 1])

game.clj

(def agenda
  '("←↑→↓ - make move"
    "r - reset"
    "q - quit"))

I like the way you take a data-centric approach here. It's a good pattern.

(defn process-key
  "Either exit or transform board according to a key passed"
  [key board]
  (case key
    (:up :down :left :right) (b/make-move key board)
    \q (System/exit 0)
    \r (b/empty-board board-size)))

1. You have the keys hard-coded to their actions. You could decouple this by using a data-centric approach (similar to agenda).
2. You don't have a clause in your case, so this code will throw an exception if any other key is pressed.
3. Ending the game by calling System/exit limits what you can do afterwards. For example, you can't go back to a menu of games. Avoid System/exit unless it is absolutely necessary. One way to avoid it in this case would be to return nil. Then have your main loop terminate if a nil is encountered.

Using a data-centric approach, I would do something like this:

(def ^:dynamic *actions*
  "Maps keys to action fns.  Each action is a function that takes a board state and returns a new board state."
  {:up    b/move-up
   :down  b/move-down
   :left  b/move-left
   :right b/move-right
   \q     (constantly nil)
   \r     (fn [board]
            (b/empty-board board-size))})

Then process-key can be defined as:

(defn process-key
  "Either exit or transform board according to a key passed"
  ([key board]
    (let [action (get *actions* key identity)]
      (action board))))

identity is used as the default to provide an effective no-op when the key can't be mapped.

board.clj

All the functions that manipulate board state deal directly with the internal representation of the board -- there's no abstraction. You should consider defining a protocol to define an interface for dealing with boards. There are many approaches. Here's one option:

(defprotocol IBoard
  (rows [board] [board data])
  (columns [board] [board data])

Then use deftype to provide an implementation.

Now, we can define the move- functions like:

(defn move-up [board]
  (columns board (map compress (columns board))))

(defn move-down [board]
  (columns board (map reverse (map compress (map reverse (columns board))))))

Though it would be more idiomatic to use ->>:

(defn move-left [board]
  (->> (rows board)   ;; Obtain row-centric view of the board
       (map compress) ;; "Compress" each row
       (rows board))) ;; Construct new board from compressed rows

(defn move-right [board]
  (->> (rows board)   ;;
       (map reverse)  ;; Reverse rows, so compression happens in correct order
       (map compress) ;; "Compress" each row
       (map reverse)  ;; Reverse rows back to original order
       (rows board))) ;; Construct new board from compressed rows

If desired, you could refactor these to take advantage of the shared structure.

compress takes a sequence and replaces consecutive elements with a single element of their sum. For the above functions to work, the result of compress must have the same length as its input (i.e., padded with 0s). Otherwise, you'll have to handle padding elsewhere.

I believe this design would allow you to get rid of row.clj.

ui.clj

(def maxlen 5)

I think you should avoid a hard limit here. At the very least, make maxlen dynamic. But even better, calculate it dynamically via max-length (which you currently don't use, BTW). If you do this, you might want to have a minlen, to avoid the cell size changing too often.

(defn count-digits [n] 
  (if (zero? n) 1
   (-> n Math/log10 Math/floor long inc)))

This is way too complicated. Just convert the number to a string and count the number of characters in the string:

(defn count-digits [n]
  (count (str n)))

Alternatively, use String's length property:

(defn count-digits [n]
  (. (str n) length))

(defn draw-row
  ([screen x y row]
   (if-not (empty? row)
      (do
       (s/put-string screen x y (pad-number maxlen (first row)))     
       (recur screen (+ x maxlen) y (rest row))))))

Avoid using recur if there's an alternative that fits well. In this case, I would use doseq:

(defn draw-row
  ([screen x y row]
    (doseq [[i n] (zip (range) row)]
      (let [x' (+ x (* i maxlen))
            n' (pad-number maxlen n)]
        s/put-string screen x' y n'))))

The same applies for draw-rows.

Also, you're calling s/redraw in draw-rows. I think it would make more sense to call it from draw-board. But really, redrawing the screen is arguably a separate concern from rendering the board. So it might be best to do the redraw at a higher level, such as the main loop.