The Wolf the Goat and the Cabbage puzzle in miniKanren and Racket

wolf-goat-cabbage.rkt

#lang racket

;; Using [miniKanren](http://www.minikanren.org), a DSL for logic
;; programming, to solve the Wolf, Goat, and Cabbage problem.

;; THE PUZZLE: https://en.wikipedia.org/wiki/Wolf,_goat_and_cabbage_problem
;;
;; Once upon a time a farmer went to a market and purchased a wolf, a goat,
;; and a cabbage. On his way home, the farmer came to the bank of a river and
;; rented a boat. But crossing the river by boat, the farmer could carry only
;; himself and a single one of his purchases: the wolf, the goat, or the
;; cabbage.
;; 
;; If left unattended together, the wolf would eat the goat, or the goat would
;; eat the cabbage.
;; 
;; The farmer's challenge was to carry himself and his purchases to the far
;; bank of the river, leaving each purchase intact.

;; A GOAT: for no reason at all, here is a picture of a Goat:
;;
;; https://www.strava.com/activities/896715718

;; We'll use a miniKanren implementation, based on the second editon of "The
;; Reasoned Schemer" book. My implementation is available here
;; https://gist.github.com/alex-hhh/e7bbe951872e627d8802c334a701980c

(require "mk.rkt")

(module+ test
  (require rackunit))

;; The participants in the puzzle are the Wolf, the Goat and the Cabbage, and
;; the first thing we need to do is define a relation, `participant/o`, which
;; restricts a term X to one of these values.  Being a relation, this can be
;; used both to check if a term is a valid participant and also to generate
;; all the valid participants (see unit tests below)

(defrel (participant/o x)
  (member/o x '(Goat Wolf Cabbage)))

(module+ test
  ;; The `participant/o' relation succedes for valid participants and fails
  ;; for invalid ones.
  (check-equal?
   (run 1 q (fresh () (participant/o 'Goat) (== q 'Success)))
   '(Success))

  ;; The symbol 'Rabbit and the number 123 are not participants, and neither
  ;; is the list '(Goat)
  (check-equal?
   (run 1 q (fresh () (participant/o 'Rabbit) (== q 'Success)))
   '())
  (check-equal?
   (run 1 q (fresh () (participant/o 123) (== q 'Success)))
   '())
  (check-equal?
   (run 1 q (fresh () (participant/o '(Goat)) (== q 'Success)))
   '())

  ;; Enumerate the participants
  (check-equal?
   (run* q (participant/o q))
   '(Goat Wolf Cabbage)))

;; The puzzle participants are not friends: they eat each other.  This is
;; encoded in the `eats/o` relation which restricts who-eats-who. Being a
;; relation, it can also answer the opposite question, "Who is eaten by
;; whom?", as well as to enumereate all the who-eats-who relationships.

(defrel (eats/o who what)
  (cond/e
    ((== who 'Goat) (== what 'Cabbage))
    ((== who 'Wolf) (== what 'Goat))))

(module+ test
  ;; What does the Goat eat?  What does the Wolf eat?
  (check-equal?
   (run 1 q (eats/o 'Goat q))
   '(Cabbage))
  (check-equal?
   (run 1 q (eats/o 'Wolf q))
   '(Goat))

  ;; Who eats the Cabbage? Who eats the Goat?, Who eats the Wolf? (no one)
  (check-equal?
   (run 1 q (eats/o q 'Cabbage))
   '(Goat))
  (check-equal?
   (run 1 q (eats/o q 'Goat))
   '(Wolf))
  (check-equal?
   (run 1 q (eats/o q 'Wolf))
   '()))

;; We'll represent a group of participants on the river bank using a list, for
;; example, the list '(Wolf Cabbage) means that the Wolf and Cabbage are on a
;; river bank and the empty list '() means there are no participants on a
;; river bank.
;;
;; Since there is one participant of each type in the puzzle, we need to
;; enforce this restriction.  For example, '(Wolf Cabbage) is a group, but
;; '(Wolf Cabbage Wolf) is not, since there is only one Wolf in our puzzle.
;;
;; The `group-helper/o` relation checks if `g` is a valid group, that is, a
;; list of unique participants.  It does that by checking that each item in
;; the list is valid and tracking which participants have been seen so far.
;;
;; Note the use of `cond/a` in the check below -- the `cond/a` differs form
;; `cond/e` in that the first branch that succeedes will produce values and
;; this is important if we want to fail for seen participants.

(defrel (group-helper/o g seen)
  (cond/e
    ((== g '()))                        ; The empty group is a valid group.
    ((fresh (head tail)
       ;; Otherwise the group is a list with a HEAD and a TAIL
       (cons/o head tail g)
       ;; The first element of the group (HEAD) needs to be a valid
       ;; participant
       (participant/o head)
       (cond/a
         ;; If we have seen this participant before, we fail
         ((once (member/o head seen)) fail)
         ((fresh (updated)
            ;; otherwise add this participant to the seen ones and check the
            ;; remaining of the list.
            (cons/o head seen updated)
            (group-helper/o tail updated))))))))

;; The `group/o` relation enforces that `g` is a valid group, or generates all
;; valid groups.  It simply starts `group-helper/o` with an empty "seen" list
(defrel (group/o g)
  (group-helper/o g '()))

(module+ test

  ;; The empty group is a valid group
  (check-equal?
   (run 1 q (fresh () (group/o '()) (== q 'Success)))
   '(Success))

  ;; ... and so are '(Wolf Cabbage) '(Cabbage Wolf)
  (check-equal?
   (run 1 q (fresh () (group/o '(Wolf Cabbage)) (== q 'Success)))
   '(Success))
  (check-equal?
   (run 1 q (fresh () (group/o '(Cabbage Wolf)) (== q 'Success)))
   '(Success))

  ;; ... but duplicates are not valid groups
  (check-equal?
   (run 1 q (fresh () (group/o '(Wolf Cabbage Wolf)) (== q 'Success)))
   '())

  ;; The group/o relation can also be used to generate all the valid groups in
  ;; the puzzle, and there is only 16 of them:

  (check-equal?
   (run* q (group/o q))
   '(()
     (Goat)
     (Wolf)
     (Cabbage)
     (Goat Wolf)
     (Goat Cabbage)
     (Wolf Goat)
     (Cabbage Goat)
     (Goat Wolf Cabbage)
     (Wolf Cabbage)
     (Goat Cabbage Wolf)
     (Cabbage Wolf)
     (Wolf Goat Cabbage)
     (Cabbage Goat Wolf)
     (Wolf Cabbage Goat)
     (Cabbage Wolf Goat))))

;; Some participant groups are safe to be left unattended, some are not.
;; `(Wolf Cabbage) is safe, since the Wolf does not eat Cabbage, but `(Goat
;; Cabbage) is not, since the Goat, left unsupervised, will eat the Cabbage.
;; The `safe-group/o` relation checks if a group `g` is safe.

(defrel (safe-group/o g)
  ;; `g` must be a valid group
  (group/o g)
  ;; The use of `cond/u` here, instead of `cond/a` is an optimisation -- when
  ;; we fail beacuse found one set of who/what eats in the group , we don't
  ;; need to try any other combinations of who/what anymore.
  (cond/u ((fresh (who what)
             (eats/o who what)
             (member/o who g)
             (member/o what g))
           ;; fail if we find a pair of participants who eat each other...
           fail)
          (succeed)))

(module+ test
  ;; The empty group is safe
  (check-equal?
   (run 1 q (fresh () (safe-group/o '()) (== q 'Success)))
   '(Success))
  ;; The Wolf does not eat the Cabbage, so `(Wolf Cabbage) is safe
  (check-equal?
   (run 1 q (fresh () (safe-group/o '(Wolf Cabbage)) (== q 'Success)))
   '(Success))
  ;; ... but the Goat does eat the Cabbage, so `(Goat Cabbage) is not safe
  (check-equal?
   (run 1 q (fresh () (safe-group/o '(Goat Cabbage)) (== q 'Success)))
   '())

  ;; As with `group/o`, the `safe-group/o` relation can also be used to
  ;; generate all the safe groups in the puzzle:
  (check-equal?
   (run* q (safe-group/o q))
   '(()
     (Goat)
     (Wolf)
     (Cabbage)
     (Wolf Cabbage)
     (Cabbage Wolf))))

;; The puzzle requires to pick a participant form a group and ferry it across
;; the river.  This has to be done in such a way that the participants that
;; remain on the river bank won't eat each other.  The `pick/o` relation
;; allows picking a participant from a group, such that the remaining
;; participants form a safe group.

(defrel (pick/o g participant out)
  (group/o g)
  (fresh (head tail)
    (cons/o head tail g)
    (cond/e
      ((== participant head)
       (== out tail))
      ((fresh (intermediate)
         (pick/o tail participant intermediate)
         (cons/o head intermediate out)))))
  (safe-group/o out))

(module+ test
  ;; There is nothing to pick from an empty group
  (check-equal?
   (run 1 q (fresh (c o) (pick/o '() c o) (== q 'Success)))
   '())

  ;; If there is only one participant, there is only one pick
  (check-equal?
   (run* (participant remaining) (pick/o '(Goat) participant remaining))
   '((Goat ())))

  ;; If there are two possibilities, they can both be picked
  (check-equal?
   (run* (participant remaining) (pick/o '(Goat Wolf) participant remaining))
   '((Goat (Wolf))
     (Wolf (Goat))))

  ;; However, from the `(Goat Wolf Cabbage) group only Goat can be picked so
  ;; the remaining participants don't eat each other.
  (check-equal?
   (run* (participant remaining) (pick/o '(Goat Cabbage Wolf) participant remaining))
   '((Goat (Cabbage Wolf))))

  ;; The `pick/o` relation can also be used to find all the groups from which
  ;; 'Cabbage can be picked.  Note that the group `(Goat Cabbage Wolf) is not
  ;; in this list, since we cannot pick 'Cabbage from that group and still
  ;; leaving the group safe (the Wolf will eat the Goat):
  (check-equal?
   (run* q (fresh (o) (pick/o q 'Cabbage o)))
   '((Cabbage)
     (Goat Cabbage)
     (Cabbage Goat)
     (Wolf Cabbage)
     (Cabbage Wolf))))

;; The `pick/o` relation will pick an existing participant from a group, but
;; this is not sufficient to be to solve the puzzle.  The key to solving the
;; puzzle is to realize that the boat can ferry empty accross the river, that
;; is, if the group is safe, where no one gets eaten (e.g. Wolf and Cabbage),
;; than we have the option of ferrying Nothing to the other bank, in addition
;; to picking one of the participant from the group.
(defrel (pick-maybe-nothing/o g participant out)
  (cond/e
    ((safe-group/o g)
     ;; If the group is safe, there is an option to pick 'Nothing
     (== participant 'Nothing)
     (== out g))
    ((pick/o g participant out))))

(module+ test
  ;; We have the option to pick 'Nothing from the empty group
  (check-equal?
   (run 1 q (fresh (o) (pick-maybe-nothing/o '() q o)))
   '(Nothing))

  ;; From a single element group, we have the option of either picking
  ;; nothing, or picking the participant
  (check-equal?
   (run* q (fresh (o) (pick-maybe-nothing/o '(Goat) q o)))
   '(Nothing Goat))

  ;; The pick-maybe-nothing/o relation can also be used to find from which
  ;; groups we can pick 'Nothing, these are effectively all the safe groups.
  (check-equal?
   (run* q (fresh (o) (pick-maybe-nothing/o q 'Nothing o)))
   '(()
     (Goat)
     (Wolf)
     (Cabbage)
     (Wolf Cabbage)
     (Cabbage Wolf))))

;; Succeed if the two lists L1 and L2 have the same length
(defrel (same-length/o l1 l2)
  (cond/e
    ((null/o l1) (null/o l2))
    ((fresh (a1 d1 a2 d2)
       (cons/o a1 d1 l1)
       (cons/o a2 d2 l2)
       (same-length/o d1 d2)))))

(module+ test
  ;; Empty lists have the same length
  (check-equal?
   (run 1 q (fresh () (same-length/o '() '()) (== q 'Succeed)))
   '(Succeed))

  (check-equal?
   (run 1 q (fresh () (same-length/o '(a b c) '(1 2 3)) (== q 'Succeed)))
   '(Succeed))

  (check-equal?
   (run 1 q (fresh () (same-length/o '(a b c) '(1 2 3 4)) (== q 'Succeed)))
   '()))

;; Succeed if every element in the list L1 is also present in L2
(defrel (subset-of/o l1 l2)
  (cond/e
    ((null/o l1))
    ((fresh (a d)
       (cons/o a d l1)
       (proper-member/o a l2)
       (subset-of/o d l2)))))

(module+ test
  ;; The empty list is a subset of any lists
  (check-equal?
   (run 1 q (fresh () (subset-of/o '() '(1 2 3)) (== q 'Succeed)))
   '(Succeed))

  (check-equal?
   (run 1 q (fresh () (subset-of/o '(1 2) '(3 2 4 1)) (== q 'Succeed)))
   '(Succeed))

  (check-equal?
   (run 1 q (fresh () (subset-of/o '(1 2 5) '(3 2 4 1)) (== q 'Succeed)))
   '()))

;; So far, our group relations would generate every combinations of
;; participants, for example both '(Wolf Cabbage) and '(Cabbage Wolf).  We
;; need a relation to verify that two groups are the same when they contain
;; the same elements.  We enforce this by saying that two lists are the same
;; if they have the same length and L1 is a subset of L2 and L2 is a subset of
;; L1.
(defrel (same/o l1 l2)
  (same-length/o l1 l2)
  (subset-of/o l1 l2)
  (subset-of/o l2 l1))

(module+ test
  (check-equal?
   (run 1 q (fresh () (same/o '(Wolf Cabbage) '(Cabbage Wolf)) (== q 'Succeed)))
   '(Succeed))
  (check-equal?
   (run 1 q (fresh () (same/o '(Wolf Goat) '(Wolf Cabbage)) (== q 'Succeed)))
   '())

  ;; We can also use the `same/o` relation to obtain all the groups which are
  ;; the same with the `(Wolf Goat Cabbage) group:
  (check-equal?
   (run* q (same/o '(Wolf Goat Cabbage) q))
   '((Wolf Goat Cabbage)
     (Wolf Cabbage Goat)
     (Goat Wolf Cabbage)
     (Goat Cabbage Wolf)
     (Cabbage Wolf Goat)
     (Cabbage Goat Wolf))))

;; As we search for a solution, we'll need to keep track of the groups we have
;; seen, to avoid going in an infinite loop: Ferrying the Goat accross the
;; river back and forth will satisfy the condition that the participants left
;; on either river bank are in a safe group, but it will go into an infinite
;; loop and will never find a solution to the puzzle.
;;
;; While planning the solution, we'll keep track of the previous groups we'll
;; seen and check if the newly proposed group is in fact a new one.
;; `seen-group/o` will check if a group `g` is present in `history` which is a
;; list of groups.
(defrel (seen-group/o g history)
  (fresh (head tail)
    (cons/o head tail history)
    ;; cond/a would be more efficient here, but with it the `seen-group/o`
    ;; relation cannot be used to generate histories containing a specified
    ;; group, which is an interesting exercise (See unit test)
    (cond/e ((same/o g head))
            ((seen-group/o g tail)))))

(module+ test
  ;; When history is empty, the group was not seen
  (check-equal?
   (run 1 q (fresh () (seen-group/o '(Goat) '())) (== q 'Succeed))
   '())
  ;; Some basic usage examples:
  (check-equal?
   (run 1 q (fresh () (seen-group/o '(Goat) '((Wolf) (Cabbage Wolf)))) (== q 'Succeed))
   '())
  (check-equal?
   (run 1 q (fresh () (seen-group/o '(Wolf) '((Wolf) (Cabbage Wolf))) (== q 'Succeed)))
   '(Succeed))

  ;; The `seen-group/o` relation can also be used to find all the histories
  ;; where a specific group was seen, but the output might be surprising.
  ;; First, since there are an infinite number of histories which can contain
  ;; a group, we'll just get the first 5 here using (run 5 q ...).
  ;;
  ;; The symbols _.0, _.1, _.2, etc stand for "any value", so the list '((Wolf
  ;; Cabbage) . _.0) means a list whose first element is `(Wolf Cabbage)
  ;; followed by any tail value, that is, all lists which have `(Wolf Cabbage)
  ;; as the first element.  Essentially, the answer for the histories which
  ;; contain `(Wolf Cabbage) are the all the lists which have that element in
  ;; the first position, followed by all the lists that have the element in
  ;; the second position and so on.
  (check-equal?
   (run 5 q (seen-group/o '(Wolf Cabbage) q))
   '(((Wolf Cabbage) . _.0)
     ((Cabbage Wolf) . _.0)
     (_.0 (Wolf Cabbage) . _.1)
     (_.0 (Cabbage Wolf) . _.1)
     (_.0 _.1 (Wolf Cabbage) . _.2))))

;; The problem with "not".  Of course, when we choose the next move, we want
;; to pick a group that was NOT yet seen, and `seen-group/o` succeeds if a
;; group was seen.  Unfortunately, "not" in a relational language has some
;; challenges.  We can easily implement `not-seen-group/o` such that it fails
;; when `seen-group/o` succeeds, but this would break the symetry that we had
;; in our relations so far.
(defrel (not-seen-group1/o g history)
  ;; cond/u (instead of cond/a) is an optimization here, to avoid trying to
  ;; exhaust all `seen groups`
  (cond/u ((seen-group/o g history) fail)
          (succeed)))

(module+ test
  ;; not-seen-group/o works as expected of both `g` and `history` are known,
  ;; for example:
  (check-equal?
   (run 1 q (fresh () (not-seen-group1/o '(Wolf) '((Goat) (Cabbage))) (== q 'Succeed)))
   '(Succeed))
  (check-equal?
   (run 1 q (fresh () (not-seen-group1/o '(Wolf) '((Goat) (Cabbage) (Wolf))) (== q 'Succeed)))
   '())

  ;; ... however, if we try to find what values are NOT in a history, or what
  ;; histories don't contain a value, the predicate fails:

  ;; Cannot find which value is not in this history
  (check-equal?
   (run 1 q (not-seen-group1/o q '((Goat) (Cabbage) (Wolf))))
   '())

  ;; Cannot find what history does not contain '(Wolf)
  (check-equal?
   (run 1 q (not-seen-group1/o '(Wolf) q))
   '()))

;; The problem is that there is no way to represent the value "a list without
;; a specific element" in miniKanren (an extension of the language using
;; `absent/o` is able to represent such lists).  In our case, we don't
;; actually need this feature, but it is a good idea to protect the relation
;; and report an error if the values are not grounded, since the `fail` the
;; relation would return does not represent an actual failure and can be
;; misleading:
(defrel (not-seen-group/o g history)
  (project (g history)
    (if (ground*? g)
        (if (ground*? history)
            succeed
            (error "not-seen-group/o: history is not ground"))
        (error "not-seen-group/o: g is not ground")))
  ;; cond/u (instead of cond/a) is an optimization here, to avoid trying to
  ;; exhaust all `seen groups`
  (cond/u ((seen-group/o g history) fail)
          (succeed)))

(module+ test
  ;; not-seen-group/o works as expected of both `g` and `history` are known,
  ;; for example:
  (check-equal?
   (run 1 q (fresh () (not-seen-group/o '(Wolf) '((Goat) (Cabbage))) (== q 'Succeed)))
   '(Succeed))
  (check-equal?
   (run 1 q (fresh () (not-seen-group/o '(Wolf) '((Goat) (Cabbage) (Wolf))) (== q 'Succeed)))
   '())

  ;; The `not-seen-group/o` relation now reports an error if the result cannot
  ;; be determined (input values are not ground).
  (check-exn
   exn:fail?
   (lambda () (run 1 q (not-seen-group/o q '((Goat) (Cabbage) (Wolf))))))
  (check-exn
   exn:fail?
   (lambda () (run 1 q (not-seen-group/o '(Wolf) q)))))

;; We now need to define the next data structure for solving the problem: the
;; River Bank.  There are two river banks in the problem, the left one and the
;; right one and each holds a group of participants.  For a river bank, we
;; also need to track what the goal group is (i.e. what are we aiming for when
;; planning the trips), as well as a history of previous groups that we have
;; seen so far, to avoid getting stuck in an infinite loop.
;;
;; A river bank will be represented as a list, with the 'River-Bank symbol as
;; the first element -- this is not required, but since the only data
;; structure supported by miniKanren is the list, it is difficult to tell
;; apart a "group" list and a "river bank" list.
;;
;; Here is what the Left and Right banks looks like at the start of the
;; puzzle.  For example, the left bank contains all the participants, the goal
;; state is the empty group and the history contains the first group, since we
;; don't want to see that again while planning the trip.
;;
;; '(River-Bank Left (Wolf Goat Cabbage) () ((Wolf Goat Cabbage)))
;; '(River-Bank Right () (Wolf Goat Cabbage) (()))
;;
;; In general a river bank look like:
;;
;; '(River-Bank tag group goal history)
;;
;; Where:
;;
;; `River-Bank` is a symbol identifying this as a River-Bank structure.
;;
;; `tag` is either the Left or Right symbols -- this will help telling them
;; apart and construct plan steps that the user can understand;
;;
;; `group` is the current group of participants on the bank, for example,
;; '(Goat Wolf Cabbage),
;;
;; `goal` is the goal group for each bank -- this is used to check if we have
;; completed the plan, for the Left, which starts with all the participants,
;; this is the empty list (i.e. no participants left on that bank), for the
;; right bank, which starts out empty, the goal is the full list of
;; participants.
;;
;; `history` is a list of previous groups seen on the bank during the planning
;; process -- this starts out as an empty list.


;; Succeed if `state`, a River-Bank, has reached its goal, this simply checks
;; if the current group in the river bank matches the goal
(defrel (goal-state/o state)
  (fresh (tag group goal history)
    (== `(River-Bank ,tag ,group ,goal ,history) state)
    (same/o group goal)))

(module+ test
  (check-equal?
   (run 1 q (fresh () (goal-state/o '(River-Bank Left (Goat Wolf) () ()))
                   (== q 'Succeed)))
   '())
  (check-equal?
   (run 1 q (fresh () (goal-state/o '(River-Bank Left (Goat Wolf) (Wolf Goat) ()))
                   (== q 'Succeed)))
   '(Succeed)))

;; Pick a participant from a river bank and return an updated river bank,
;; without the participant.  Participant can be 'Nothing, meaning that nothing was
;; picked.  This also adds the new group to the river bank history.
(defrel (pick-participant-from/o state participant out)
  (fresh (tag group goal history updated-group)
    (== `(River-Bank ,tag ,group ,goal ,history) state)
    (pick-maybe-nothing/o group participant updated-group)
    (not-seen-group/o updated-group history)
    (== `(River-Bank ,tag ,updated-group ,goal (,updated-group . ,history)) out)))

(module+ test
  ;; From a (Wolf Goat Cabbage) group, only one option is available, the Goat.
  (check-equal?
   (run* (q r) (pick-participant-from/o '(River-Bank Left (Wolf Goat Cabbage) () ()) q r))
   '((Goat                              ; picking this one
      (River-Bank Left (Wolf Cabbage) () ((Wolf Cabbage))))))

  ;; From a (Wolf Cabbage) group, we can pick Nothing, the Wolf or the Cabbage
  ;; -- note how the history is updated in each case.
  (check-equal?
   (run* (q r) (pick-participant-from/o '(River-Bank Left (Wolf Cabbage) () ()) q r))
   '((Nothing (River-Bank Left (Wolf Cabbage) () ((Wolf Cabbage))))
     (Wolf (River-Bank Left (Cabbage) () ((Cabbage))))
     (Cabbage (River-Bank Left (Wolf) () ((Wolf)))))))

;; Once a participant was ferried accross the river, it needs to be added to
;; that state, producing a new output state.  Special care is taken not to add
;; 'Nothing to the state
(defrel (add-participant-to/o state participant out)
  (cond/a
   ((== participant 'Nothing)
    (== out state))
   ((fresh (tag group goal history)
      (== `(River-Bank ,tag ,group ,goal ,history) state)
      (== `(River-Bank ,tag (,participant . ,group) ,goal ,history) out)))))

(module+ test
  ;; Don't add 'Nothing to the state
  (check-equal?
   (run* q (add-participant-to/o '(River-Bank Right () (Wolf Goat Cabbage) ()) 'Nothing q))
   '((River-Bank Right () (Wolf Goat Cabbage) ())))

  ;; Add the goat to the state
  (check-equal?
   (run* q (add-participant-to/o '(River-Bank Right () (Wolf Goat Cabbage) ()) 'Goat q))
   '((River-Bank Right (Goat) (Wolf Goat Cabbage) ()))))

;; The `make-step/o` creates a plan step, to move a participant form one side
;; of the river to the other.  The plan step is simply a list forming a
;; sentence, for example (Ferry Goat From Left To Right), and it is
;; constructed given a "from" and "to" states plus a participant.
(defrel (make-step/o from to participant step)
  (fresh (ftag fgroup fgoal fhistory ttag tgroup tgoal thistory)
    (== `(River-Bank ,ftag ,fgroup ,fgoal ,fhistory) from)
    (== `(River-Bank ,ttag ,tgroup ,tgoal ,thistory) to)
    (== `(Ferry ,participant From ,ftag To ,ttag) step)))

(module+ test
  (check-equal?
   (run* q (make-step/o
            '(River-Bank Left (Goat Wolf Cabbage) () ())
            '(River-Bank Right () (Goat Wolf Cabbage) ())
            'Goat
            q))
   '((Ferry Goat From Left To Right))))

;; We finally come to constructing the actual travel plan to solve the puzzle.
;; With all the relations defined so far, all that remains is to define the
;; constraints for planning process.  The `do-plan/o` relation will construct
;; a PLAN to move participants FROM a river bank TO the other one:
;;
;; * If the FROM state is already in the goal state, the plan is empty
;;   (i.e. nothing needs to be done), otherwise:
;;
;; * Pick a participant, producing a new FROM river bank state UPDATED-FROM
;;
;; * Add that participant to the TO river bank, producing a new state,
;;   UPDATED-TO
;;
;; * Construct a step in the plan by collating the information with the
;;   participant and the name of the two river banks
;;
;; * Add the step to the plan
;;
;; * Construct the remaining of the plan by swapping the two river banks and
;;   calling `do-plan/o` recursively.

(defrel (do-plan/o from to plan)
  (cond/e
   ((goal-state/o from)
    (== plan '()))
   ((fresh (participant step remaining updated-from updated-to)
      (pick-participant-from/o from participant updated-from)
      (add-participant-to/o to participant updated-to)
      (make-step/o from to participant step)
      (cons/o step remaining plan)
      (do-plan/o updated-to updated-from remaining)))))

;; Finally, we can set up the puzzle with the initial configuration to
;; construct the solution.
(defrel (wolf-goat-cabbage-plan/o plan)
  (let ([from '(Wolf Goat Cabbage)]
        [to '()])
    (do-plan/o
     `(River-Bank Left ,from ,to (,from))
     `(River-Bank Right ,to ,from (,to))
     plan)))

(module+ test
  (check-equal?
   (run* q (wolf-goat-cabbage-plan/o q))
   '(((Ferry Goat From Left To Right)
      (Ferry Nothing From Right To Left)
      (Ferry Wolf From Left To Right)
      (Ferry Goat From Right To Left)
      (Ferry Cabbage From Left To Right)
      (Ferry Nothing From Right To Left)
      (Ferry Goat From Left To Right))

     ((Ferry Goat From Left To Right)
      (Ferry Nothing From Right To Left)
      (Ferry Cabbage From Left To Right)
      (Ferry Goat From Right To Left)
      (Ferry Wolf From Left To Right)
      (Ferry Nothing From Right To Left)
      (Ferry Goat From Left To Right)))))