Farmer, Goat, Wolf, Cabbage in core.logic

(ns corelogicplay.fgwc
  (:require [clojure.core.logic :as l]))

(defn move [curr-loc new-loc]
  (l/conde
    [(l/== curr-loc :left) (l/== new-loc :right)]
    [(l/== curr-loc :right) (l/== new-loc :left)]))

(defn safe? [state]
  (l/fresh [f g w c]
           (l/== [f g w c] state)
           (l/conde
             [(l/== state [f f w c])] ;; Farmer same place as goat
             [(l/== state [f g f f])]))) ;; Wolf and cabbage in same place as farmer

(defn perform-state-transition [current-state new-state]
  (l/fresh [new-loc f g w c]
           (safe? new-state)
           (l/== [f g w c] current-state)
           (move f new-loc)
           (l/conde
              ;; Farmer moves alone
              [(l/== new-state [new-loc g w c])]
              ;; Farmer takes goat
              [(l/== f g)
               (l/== new-state [new-loc new-loc w c])]
              ;; Farmer takes wolf
              [(l/== f w)
               (l/== new-state [new-loc g new-loc c])]
              ;; Farmer takes cabbage
              [(l/== f c)
               (l/== new-state [new-loc g w new-loc])])))

(defn solve [current-state path]
  (l/fresh [next-state path-part]
           (l/conde
             [(l/== current-state [:right :right :right :right])
              (l/== path [current-state])]
             [(perform-state-transition current-state next-state)
              (solve next-state path-part)
              (l/conso current-state path-part path)])))


(defn solve-fgwc-puzzle []
  (l/run 1 [q] ;; Get 1 solution
          (solve [:left :left :left :left] q)))

Output:

(solve-fgwc-puzzle)
=>
(([:left :left :left :left]
  [:right :right :left :left]
  [:left :right :left :left]
  [:right :right :right :left]
  [:left :left :right :left]
  [:right :left :right :right]
  [:left :left :right :right]
  [:right :right :right :right]))