jdV1fa - Online Common Lisp Interpreter & Debugging Tool

(defstruct estado
  ml cl ; misioneros y caníbales en la izquierda
  mr cr ; misioneros y caníbales en la derecha
  side ; 0 = bote a la izquierda, 1 = derecha
  camino) ; lista de pasos

(defun estado-valido-p (st)
  (let ((ml (estado-ml st))
        (cl (estado-cl st))
        (mr (estado-mr st))
        (cr (estado-cr st)))
    (and (>= ml 0) (<= ml 3)
         (>= cl 0) (<= cl 3)
         (>= mr 0) (<= mr 3)
         (>= cr 0) (<= cr 3)
         (or (= ml 0) (>= ml cl))
         (or (= mr 0) (>= mr cr)))))

(defun mover (st m c)
  (let* ((ml (estado-ml st))
         (cl (estado-cl st))
         (mr (estado-mr st))
         (cr (estado-cr st))
         (side (estado-side st)))
    (cond
      ((= side 0)
       (make-estado :ml (- ml m) :cl (- cl c)
                    :mr (+ mr m) :cr (+ cr c)
                    :side 1
                    :camino (append (estado-camino st)
                                    (list (format nil "~dM~dC ->" m c)))))
      (t
       (make-estado :ml (+ ml m) :cl (+ cl c)
                    :mr (- mr m) :cr (- cr c)
                    :side 0
                    :camino (append (estado-camino st)
                                    (list (format nil "~dM~dC <-" m c))))))))

(defun iguales (a b)
  (and (= (estado-ml a) (estado-ml b))
       (= (estado-cl a) (estado-cl b))
       (= (estado-mr a) (estado-mr b))
       (= (estado-cr a) (estado-cr b))
       (= (estado-side a) (estado-side b))))

(defun repetido-p (nuevo camino)
  (some (lambda (e) (iguales e nuevo)) camino))

(defparameter *viajes*
  '((2 0) (0 2) (1 1) (1 0) (0 1)))

(defun resolver (estado final camino)
  (when (iguales estado final)
    (push estado camino)
    (mostrar-solucion (reverse camino))
    (return-from resolver))

  (dolist (v *viajes*)
    (let ((m (first v))
          (c (second v)))
      (when (and (<= (+ m c) 2) (> (+ m c) 0))
        (let ((nuevo (mover estado m c)))
          (when (and (estado-valido-p nuevo)
                     (not (repetido-p nuevo camino)))
            (resolver nuevo final (cons estado camino))))))))

(defun personas (m c)
  (concatenate 'string
               (make-string m :initial-element #\M)
               (make-string c :initial-element #\C)))

(defun lado-a-string (m c)
  (format nil "[~a]" (personas m c)))

(defun mostrar-paso (anterior actual)
  (let ((ml (estado-ml anterior))
        (cl (estado-cl anterior))
        (mr (estado-mr anterior))
        (cr (estado-cr anterior))
        (side (estado-side anterior))
        (ml2 (estado-ml actual))
        (cl2 (estado-cl actual))
        (mr2 (estado-mr actual))
        (cr2 (estado-cr actual))
        (side2 (estado-side actual)))

    ;; Determinar quién cruzó
    (let* ((dm (- ml ml2))
           (dc (- cl cl2))
           (m (abs dm))
           (c (abs dc))
           (cruce (personas m c)))
      (format t "~%Paso ~a (antes de cruzar):~%" (+ 1 (length (estado-camino anterior))))
      (if (= side 0)
          (format t "~a B ~~~~~~ []~%" (lado-a-string ml cl))
          (format t "~a ~~~~~~ B ~a~%" (lado-a-string ml cl) (lado-a-string mr cr)))
      (format t "Cruzando con: ~a~%" cruce)
      (format t "Paso ~a (después de cruzar):~%" (+ 1 (length (estado-camino anterior))))
      (if (= side2 0)
          (format t "~a B ~~~~~~ []~%" (lado-a-string ml2 cl2))
          (format t "~a ~~~~~~ B ~a~%" (lado-a-string ml2 cl2) (lado-a-string mr2 cr2))))))

(defun mostrar-solucion (camino)
  (format t "~%====================================~%") ;traviesos
  (format t "Solución en ~d pasos~%" (length (estado-camino (car (last camino)))))
  (loop for (a b) on camino while b do
        (mostrar-paso a b))
  (format t "~%====================================~%"))

(defun main ()
  (let ((inicio (make-estado :ml 3 :cl 3 :mr 0 :cr 0 :side 0 :camino '()))
        (fin (make-estado :ml 0 :cl 0 :mr 3 :cr 3 :side 1 :camino '())))
    (resolver inicio fin '())))