Skip to content

Instantly share code, notes, and snippets.

@pepijndevos
Created August 5, 2018 15:26
Show Gist options
  • Save pepijndevos/15f65445eded496a89df6502e4fe1ef0 to your computer and use it in GitHub Desktop.
Save pepijndevos/15f65445eded496a89df6502e4fe1ef0 to your computer and use it in GitHub Desktop.
Concatenative Behavior Tree in Clojure
(ns b3clj.core)
; TODO more stack operations
(defn spush
([stack item] (spush stack :data item))
([stack typ item] (update-in stack [typ] conj item)))
(defn spop
([stack] (spop stack :data))
([stack typ]
(update-in stack [typ] rest)))
(defn speek
([stack] (speek stack :data))
([stack typ] (first (get stack typ))))
(defn sswap
([stack] (sswap stack :data))
([stack typ]
(update-in stack [typ]
(fn [[a b & r]]
(conj r a b)))))
(defn succeed [stack] (spush stack :status :success))
(defn fail [stack] (spush stack :status :failure))
(defn run [stack] (spush stack :status :running))
(defn composite [unit stack & fns]
(loop [stack (spush stack :status unit)
[f & fns] fns]
(let [stack (f stack)
stack (update-in stack [:status]
(fn [[st acc & other]]
(cons (if (= acc unit) st acc) other)))]
(if (and fns (= (speek stack :status) unit))
(recur stack fns)
stack))))
; TODO more node types
(def sequential (partial composite :success))
(def selector (partial composite :failure))
(defn complete [fn stack]
(first
(drop-while
#(= (speek % :status) :running)
(iterate fn (fn stack)))))
; Implement FizzBuzz
; (map fizzbuzz (range 100))
(defn modn [n]
#(if (= 0 (mod (speek %) n))
(-> %
spop
succeed)
(fail %)))
(defn message [msg]
#(-> %
(spush msg)
succeed))
(defn fizzbuzz [n]
(-> {}
(spush n)
(selector
#(sequential %
(modn 15)
(message "FizzBuzz"))
#(sequential %
(modn 3)
(message "Fizz"))
#(sequential %
(modn 5)
(message "Buzz")))
speek))
; Age guessing game
; (share {:bob 5} [[:dave 6 :eve] [:dave 4 :bob] [:alice 2 :carl] [:alice 3 :bob]])
(defn know-age [stack]
(if (speek stack :age)
(succeed stack)
(fail stack)))
(defn useful-hint [stack]
(let [hint (speek stack :hint)
[a diff b] hint
[name age] (speek stack :age)]
(if hint
(if (or (= a name) (= b name))
(succeed stack)
(-> stack
(spop :hint)
run))
(fail stack))))
(defn calculate-hint [stack]
(let [hint (speek stack :hint)
[a diff b] hint
[name age] (speek stack :age)
stack (if hint
(-> stack
(spop :hint)
run)
(succeed stack))]
(-> stack
(spush :age
(if (= a name)
[b (+ age diff)]
[a (- age diff)]))
(sswap :age))))
(defn person [stack]
;(println stack)
(sequential stack
know-age
useful-hint
calculate-hint))
(defn share [ages hints]
(loop [ages ages]
(let [pstacks (for [age ages] {:age (list age) :hint (sequence hints)})
pstacks (map (partial complete person) pstacks)
new-ages (reduce into {} (map :age pstacks))]
(if (= ages new-ages)
new-ages
(recur new-ages)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment