Example of FSM (finite state machine) usage in Clojure

antsgame.clj

(ns antsgame
  (:gen-class))


(defn new-ant
  "Create new ant"
  [name]
  {:name       name
   :distance   0
   :state      :born
   :state-desc "I'm a new ant!"
   :food       []
   :danger     []})


(defn print-state
  "Prints current ant state"
  [ant]
  (println (format "Ant %s: %s" (:name ant) (:state-desc ant))))


(defn ant-without-food?
  "Returns true if ant has food, otherwise false."
  [ant]
  (empty? (:food ant)))


(def ant-found-food? (complement ant-without-food?))


(defn set-find-food-state
  "Set state for ant to find the food. Returns ant map."
  [ant]
  (assoc ant :state :find-food :food [] :state-desc "is seeking for food"))


(defn set-go-home-state
  "Set state for ant to return to home. Returns ant map."
  [ant]
  (assoc ant :state :go-home :state-desc "is returning at home"))


(defn set-run-away-state
  "Set state for ant to run away from danger. Returns ant map."
  [ant]
  (assoc ant :state :run-away :state-desc (str "is running away from danger - " (first (:danger ant)))))


(defn add-food!
  "Add food to ant"
  [ant food]
  (println (format "Ant %s: found food - %s" (:name ant) food))
  (assoc ant :food (conj (:food ant) food)))


(defn throw-food!
  "Throw food by ant"
  [ant]
  (println (format "Ant %s: put food into the anthill: %s." (:name ant) (:food ant)))
  (assoc ant :food []))


(defn see-danger?
  "Returns true if ant see the danger."
  [ant]
  (boolean (seq (:danger ant))))


(defn place-danger-near-ant!
  "Place the danger near the ant. Now ant can see the danger."
  [ant danger]
  (println (format "Ant %s: see the danger - %s" (:name ant) danger))
  (assoc ant :danger (conj (:danger ant) danger)))


(defn remove-danger-from-ant!
  "Remove danger from ant. Now ant feels no danger."
  [ant]
  (if-let [danger (peek (:danger ant))]
    (do
      (println (format "Ant %s: see no danger - %s" (:name ant) danger))
      (assoc ant :danger (pop (:danger ant))))
    ant))


(def no-danger? (complement see-danger?))


(defn ant-at-home?
  "Return true if ant at home, false if not"
  [ant]
  (zero? (:distance ant)))


(def ant-fsm
  {:born      {:find-food {:conditions   []
                           :pre-actions  [print-state]
                           :actions      [set-find-food-state]
                           :post-actions [print-state]}}
   :find-food {:go-home  {:conditions   [ant-found-food? no-danger?]
                          :pre-actions  []
                          :actions      [set-go-home-state]
                          :post-actions [print-state]}
               :run-away {:conditions   [see-danger?]
                          :pre-actions  []
                          :actions      [set-run-away-state]
                          :post-actions [print-state]}}
   :go-home   {:find-food {:conditions   [ant-at-home?]
                           :pre-actions  []
                           :actions      [throw-food! set-find-food-state]
                           :post-actions [print-state]}
               :run-away  {:conditions   [see-danger?]
                           :pre-actions  []
                           :actions      [set-run-away-state]
                           :post-actions [print-state]}}
   :run-away  {:find-food {:conditions   [ant-without-food? no-danger?]
                           :pre-actions  []
                           :actions      [set-find-food-state]
                           :post-actions [print-state]}
               :go-home   {:conditions   [ant-found-food? no-danger?]
                           :pre-actions  []
                           :actions      [set-go-home-state]
                           :post-actions [print-state]}}})


(defn find-next-transition
  "Takes FSM graph and current state of ant and detect the next transition of a state.
  Returns {:next-step _ :pre-actions [] :actions [] :post-actions []} if found
  or nil if not."
  [fsm ant]
  (let [current-state        (:state ant)
        possible-transitions (get fsm current-state)]
    (reduce (fn [acc [k v]]
              (let [conditions        (:conditions v)
                    found-transition? (every? (fn [c] (c ant)) conditions)]
                (if found-transition?
                  (reduced {:next-step    k
                            :pre-actions  (:pre-actions v)
                            :actions      (:actions v)
                            :post-actions (:post-actions v)})
                  acc))) nil possible-transitions)))


(defn go-next-transition
  "Move ant to the next transition state. Returns ant map."
  [ant {:keys [pre-actions post-actions actions] :as next-transition}]
  (if next-transition
    (let [_             (run! (fn [action-fn] (action-fn ant)) pre-actions)
          new-ant-state (reduce (fn [acc action-fn] (action-fn acc)) ant actions)
          _             (run! (fn [action-fn] (action-fn new-ant-state)) post-actions)]
      new-ant-state)
    ant))


(defn add-food-with-probability!
  "Add some food for ant with some probability. Returns ant map."
  [ant]
  (if (= :find-food (:state ant))
    (let [n (rand-int 100)]
      (if (< n 10)
        (add-food! ant (rand-nth ["fly" "cookie" "sugar" "grass"]))
        ant))
    ant))


(defn add-danger-with-probability!
  "Add some danger for ant with some probability. Returns ant map"
  [ant]
  (if (no-danger? ant)
    (let [n (rand-int 100)]
      (if (< n 5)
        (place-danger-near-ant! ant (rand-nth ["cat" "frog" "bird" "wasp"]))
        ant))
    ant))


(defn remove-danger-with-probability!
  "Remove danger for ant with some probability"
  [ant]
  (if (see-danger? ant)
    (let [n (rand-int 100)]
      (if (< n 25)
        (remove-danger-from-ant! ant)
        ant))
    ant))


(defn throw-food-with-probability!
  "Throw food by ant with some probability"
  [ant]
  (if (= :go-home (:state ant))
    (let [n (rand-int 100)]
      (if (< n 15)
        (throw-food! ant)
        ant))
    ant))


(defn increase-distance-from-home
  "Increase number of steps from home."
  [ant]
  (update ant :distance inc))


(defn decrease-distance-from-home
  "Decrease number of steps from home."
  [ant]
  (update ant :distance dec))


(defn ant-next-step
  "Make step from/toward home."
  [ant]
  ;;(println (format "Ant %s: is %s steps away from home" (:name ant) (:distance ant)))
  (condp = (:state ant)
    :go-home (decrease-distance-from-home ant)
    :find-food (increase-distance-from-home ant)
    :run-away (increase-distance-from-home ant)
    ant))


(defn run-game
  "Run game in other thread using given FSM, ants collection"
  [fsm ants-vector *continue-game? game-speed-ms]
  (future
    (loop [ants-vector ants-vector]
      (when @*continue-game?
        (let [ants-with-new-state (mapv #(go-next-transition % (find-next-transition fsm %)) ants-vector)
              events         (comp                     ;; all external events
                                    remove-danger-with-probability!
                                    add-danger-with-probability!
                                    add-food-with-probability!
                                    ant-next-step)
              ;; apply all events to ants collection
              ants-final-state    (mapv events ants-with-new-state)]
          (Thread/sleep game-speed-ms)                                ;; this is the game speed
          (recur ants-final-state)))))
  nil)


(defn stop-game
  [*continue-game?]
  (reset! *continue-game? false))


(comment

  (do
    (def ants-vector [(new-ant 1) (new-ant 2)])
    (def *continue-game? (atom true))
    (run-game ant-fsm ants-vector *continue-game? 400))

  (stop-game *continue-game?)
  )


(defn -main
  "entry point to app."
  [& [number-of-ants game-speed-ms]]
  (let [number-of-ants (if number-of-ants (Long/parseLong number-of-ants) 2)
        game-speed-ms (if game-speed-ms (Long/parseLong game-speed-ms) 400)
        ants-vector     (mapv new-ant (range number-of-ants))
        *continue-game? (atom true)]
    (println "Number of ants: " number-of-ants ", game speed (ms):" game-speed-ms)
    (run-game ant-fsm ants-vector *continue-game? game-speed-ms)
    (read-line)
    (stop-game *continue-game?))

  (System/exit 0))