The Farmer, Fox, Chicken and Grain problem (in lisp)

The same problem in lisp. Here you can see how much work has to be done to mimic sets.


(defun safe-p (list)
  (or (member 'farmer list)
      (and (not (and (member 'fox list)
                     (member 'chicken list)))
           (not (and (member 'chicken list)
                     (member 'grain list))))))

(defun permute-state (state)
  (let (result)
    (destructuring-bind (near far) state
      (if (member 'farmer near)
          (let ((others (set-difference near '(farmer))))
            (push (list 'farmer (list others
                                      (cons 'farmer far))) result)
            (loop for item in others
                  do (push (list item (list  (remove item others) (cons item (cons 'farmer far)))) result))
            result)
          ; we just reverse the sides                                                                                                    
          (loop for (move (near far)) in (permute-state (reverse state))
                collect (list move (list far near)))))))

(defvar *history* nil)
(defun solve (initial-state goal-state moves)
  (if (and (null (set-difference (first initial-state) (first goal-state)))
           (null (set-difference (second initial-state) (second goal-state))))
      (progn
        (format t "Found solution~%")
        (loop for move in (reverse moves)
              and direction = 'forward then (if (eq direction 'forward)
                                                'back
                                                'forward)
              do (if (eq move 'farmer)
                     (format t "Farmer crosses ~A~%" direction)
                     (format t "Farmer crosses ~A with ~A~%" direction move)))))
  (loop for (move new-state) in (permute-state initial-state)
        do
        (if (and (not (member (sort  (copy-list (first new-state)) #'string-lessp) *history* :test #'equal))
                 (safe-p (first new-state))
                 (safe-p (second new-state)))
            (progn
              (push (sort (copy-list (first new-state)) #'string-lessp) *history*)
              (solve new-state goal-state (cons move moves))))))

and the output:

CL-USER: (progn (setf *history* nil) (solve '((farmer fox chicken grain) ()) '(() (farmer fox chicken grain)) nil))
Found solution                                                                                                                           
Farmer crosses FORWARD with CHICKEN                                                                                                      
Farmer crosses BACK                                                                                                                      
Farmer crosses FORWARD with GRAIN                                                                                                        
Farmer crosses BACK with CHICKEN                                                                                                         
Farmer crosses FORWARD with FOX                                                                                                          
Farmer crosses BACK                                                                                                                      
Farmer crosses FORWARD with CHICKEN                                                                                                      
NIL
CL-USER:

One Reply to “The Farmer, Fox, Chicken and Grain problem (in lisp)”

Comments are closed.