Backgammon Game in clojure. I'm creating a game that I can use to train an AI model.

commands.md

I'm using the Calva extension in IntelliJ IDEA and sometimes I run the game from the REPL.

(play-until-winner initial-game-state)

Sometimes I run it from the bash command line.

java -cp "lib/spec.alpha-0.6.249.jar:lib/core.specs.alpha-0.5.81.jar:lib/clojure-1.12.0.jar:src/main/clojure" clojure.main -i src/main/clojure/backgammon/core.clj -e "(in-ns 'backgammon.core)" -e "(play-until-winner initial-game-state)"

core.clj

(ns backgammon.core)

;; --- 1. THE DATA ---
(def initial-game-state
  {:board [2 0 0 0 0 -5 0 -3 0 0 0 5 -5 0 0 0 3 0 5 0 0 0 0 -2]
   :bar {:positive 0 :negative 0}
   :off {:positive 0 :negative 0}
   :current-player :positive
   :dice []
   :history []
   :last-roll []})

;; --- 2. THE DICE ---
(defn roll-dice []
  (let [d1 (inc (rand-int 6))
        d2 (inc (rand-int 6))]
    (if (= d1 d2) [d1 d1 d1 d1] [d1 d2])))

;; --- 3. THE RULES & SCORER ---
(defn hit? [dest-count player]
  (if (= player :positive) (= dest-count -1) (= dest-count 1)))

(defn all-home? [state player]
  (let [board (:board state)
        indices (if (= player :positive) (range 0 18) (range 6 24))]
    (not (some #(if (= player :positive) (pos? (nth board %)) (neg? (nth board %))) indices))))

;; --- THE MISSING SCORER ---
;; This must be defined BEFORE play-all-dice calls it
(defn evaluate-state [state]
  (let [board (:board state)
        pos-off (get-in state [:off :positive] 0)
        neg-off (get-in state [:off :negative] 0)
        pos-bar (get-in state [:bar :positive] 0)
        neg-bar (get-in state [:bar :negative] 0)]
    (+ (* 100 pos-off)
       (* -100 neg-off)
       (* -50 pos-bar)
       (* 50 neg-bar)
       (reduce + (map-indexed
                   (fn [idx val]
                     (cond
                       (= val 1) -20   ;; Penalty for Positive Blot
                       (> val 1) 15    ;; Bonus for Positive Anchor
                       (= val -1) 20   ;; Bonus if Negative left a Blot
                       (< val -1) -15  ;; Penalty if Negative has an Anchor
                       :else 0))
                   board)))))

(defn valid-move? [state from-idx die-value]
  (let [player (:current-player state)
        sign (if (= player :positive) 1 -1)
        to-idx (+ from-idx (* sign die-value))
        dest-count (get-in state [:board to-idx] 0)]
    (and
      (or (<= 0 to-idx 23)
          (and (all-home? state player)
               (if (= player :positive) (> to-idx 23) (< to-idx 0))))
      (let [src-count (cond (= from-idx -1) 1 (= from-idx 24) -1 :else (get-in state [:board from-idx]))]
        (if (= player :positive) (pos? src-count) (neg? src-count)))
      (or (not (<= 0 to-idx 23))
          (zero? dest-count)
          (if (= player :positive) (>= dest-count -1) (<= dest-count 1))))))

;; --- 4. MOVING PIECES ---
(defn execute-move [state from die-value]
  (let [player (:current-player state)
        sign (if (= player :positive) 1 -1)
        from-idx (if (= from :bar) (if (= player :positive) -1 24) from)
        to-idx (+ from-idx (* sign die-value))]
    (if (valid-move? state from-idx die-value)
      (let [dest-count (get-in state [:board to-idx] 0)
            is-off (not (<= 0 to-idx 23))
            next-state (if (= from :bar)
                         (update-in state [:bar player] dec)
                         (update-in state [:board from-idx] #(- % sign)))]
        (if is-off
          (update-in next-state [:off player] inc)
          (if (hit? dest-count player)
            (-> next-state
                (update-in [:bar (if (= player :positive) :negative :positive)] inc)
                (assoc-in [:board to-idx] sign))
            (update-in next-state [:board to-idx] #(+ % sign)))))
      state)))

(defn apply-move [state from-idx die-value]
  (if (some #(= % die-value) (:dice state))
    (let [new-state (execute-move state from-idx die-value)]
      (if (not= new-state state)
        (-> new-state
            (assoc :dice (let [[pre post] (split-with #(not= % die-value) (:dice state))]
                           (concat pre (rest post))))
            (update :history conj {:p (:current-player state) :from from-idx :die die-value}))
        state))
    state))

;; --- 5. AUTOMATION & FLOW ---
(defn start-turn [state]
  (let [roll (roll-dice)]
    (assoc state :dice roll :last-roll roll)))

(defn get-legal-moves [state]
  (let [player (:current-player state)
        dice (distinct (:dice state))
        bar-count (get-in state [:bar player])]
    (if (pos? bar-count)
      (for [d dice :when (valid-move? state (if (= player :positive) -1 24) d)] {:from :bar :die d})
      (let [indices (keep-indexed #(when (if (= player :positive) (pos? %2) (neg? %2)) %1) (:board state))]
        (for [idx indices d dice :when (valid-move? state idx d)] {:from idx :die d})))))

(defn play-all-dice [state]
  (loop [curr-state state
         attempts 0]
    (let [moves (get-legal-moves curr-state)]
      (if (and (seq (:dice curr-state)) (seq moves) (< attempts 10))
        (let [player (:current-player curr-state)
              best-move (apply max-key
                               (fn [m]
                                 (let [res (execute-move curr-state (:from m) (:die m))]
                                   (if (= player :positive) (evaluate-state res) (* -1 (evaluate-state res)))))
                               moves)
              next-s (apply-move curr-state (:from best-move) (:die best-move))]
          (if (= next-s curr-state) curr-state (recur next-s (inc attempts))))
        curr-state))))

(defn winner? [state player]
  (>= (get-in state [:off player] 0) 15))

(defn check-victory [state]
  (let [player (:current-player state)]
    (if (winner? state player)
      (assoc state :winner player)
      state)))

(defn next-turn [state]
  (update state :current-player #(if (= % :positive) :negative :positive)))

;; --- 6. THE GAME ENGINE ---
(defn play-until-winner [initial-state]
  (println ">>> ENGINE STARTING")
  (let [final-state (loop [state (assoc initial-state :history [])
                           turn-count 0]
                      (if (or (:winner state) (> turn-count 1000))
                        state
                        (recur (-> state (start-turn) (play-all-dice) (check-victory) (next-turn))
                               (inc turn-count))))]
    (println "\n🏆 WINNER:" (:winner final-state))
    (println "Final Board:" (:board final-state))
    (println "Final Off:  " (:off final-state))
    (println "\n--- LAST 20 MOVES ---")
    (doseq [m (take-last 20 (:history final-state))]
      (println "Player" (:p m) "from" (:from m) "using" (:die m)))
    final-state))