fork download
copy 
  1. (defstruct estado
  2.   ml cl ; misioneros y caníbales en la izquierda
  3.   mr cr ; misioneros y caníbales en la derecha
  4.   side ; 0 = bote a la izquierda, 1 = derecha
  5.   camino) ; lista de pasos previos
  6.  
  7. (defun estado-valido-p (st)
  8.   (let ((ml (estado-ml st))
  9.         (cl (estado-cl st))
  10.         (mr (estado-mr st))
  11.         (cr (estado-cr st)))
  12.     (and (>= ml 0) (<= ml 3)
  13.          (>= cl 0) (<= cl 3)
  14.          (>= mr 0) (<= mr 3)
  15.          (>= cr 0) (<= cr 3)
  16.          (or (= ml 0) (>= ml cl))
  17.          (or (= mr 0) (>= mr cr)))))
  18.  
  19. (defun mover (st m c)
  20.   (let* ((ml (estado-ml st))
  21.          (cl (estado-cl st))
  22.          (mr (estado-mr st))
  23.          (cr (estado-cr st))
  24.          (side (estado-side st)))
  25.     (if (= side 0)
  26.         ;; Mover de izquierda a derecha
  27.         (make-estado :ml (- ml m) :cl (- cl c)
  28.                      :mr (+ mr m) :cr (+ cr c)
  29.                      :side 1
  30.                      :camino (append (estado-camino st) (list (format nil "~dM~dC ->" m c))))
  31.         ;; Mover de derecha a izquierda
  32.         (make-estado :ml (+ ml m) :cl (+ cl c)
  33.                      :mr (- mr m) :cr (- cr c)
  34.                      :side 0
  35.                      :camino (append (estado-camino st) (list (format nil "~dM~dC <-" m c)))))))
  36.  
  37. (defun iguales (a b)
  38.   (and (= (estado-ml a) (estado-ml b))
  39.        (= (estado-cl a) (estado-cl b))
  40.        (= (estado-mr a) (estado-mr b))
  41.        (= (estado-cr a) (estado-cr b))
  42.        (= (estado-side a) (estado-side b))))
  43.  
  44. (defun repetido-p (nuevo historial)
  45.   (some (lambda (e) (iguales e nuevo)) historial))
  46.  
  47. (defparameter *viajes* '((2 0) (0 2) (1 1) (1 0) (0 1)))
  48.  
  49. (defun resolver (estado final historial)
  50.   (when (iguales estado final)
  51.     (mostrar-solucion (reverse (cons estado historial)))
  52.     (return-from resolver t))
  53.  
  54.   (dolist (v *viajes*)
  55.     (let ((m (first v))
  56.           (c (second v)))
  57.       (let ((nuevo (mover estado m c)))
  58.         (when (and (estado-valido-p nuevo)
  59.                    (not (repetido-p nuevo historial)))
  60.           (when (resolver nuevo final (cons estado historial))
  61.             (return-from resolver t)))))))
  62.  
  63. (defun personas (m c)
  64.   (concatenate 'string
  65.                (make-string m :initial-element #\M)
  66.                (make-string c :initial-element #\C)))
  67.  
  68. (defun lado-a-string (m c)
  69.   (format nil "[~3a]" (personas m c)))
  70.  
  71. ;; FUNCIÓN CORREGIDA: Ahora siempre muestra ambos lados
  72. (defun mostrar-paso (anterior actual)
  73.   (let ((side (estado-side anterior))
  74.         (ml (estado-ml anterior))
  75.         (cl (estado-cl anterior))
  76.         (mr (estado-mr anterior))
  77.         (cr (estado-cr anterior))
  78.         (movimiento (car (last (estado-camino actual)))))
  79.  
  80.     (format t "~%Estado actual: ~a ~a ~a" 
  81.             (lado-a-string ml cl)
  82.             (if (= side 0) " B ~~~~   " "   ~~~~ B ")
  83.             (lado-a-string mr cr))
  84.     (format t "~%Acción: ~a" movimiento)))
  85.  
  86. (defun mostrar-solucion (camino)
  87.   (format t "~%====================================")
  88.   (format t "~%SOLUCIÓN ENCONTRADA")
  89.   (loop for (a b) on camino while b do
  90.         (mostrar-paso a b))
  91.   ;; Mostrar el estado final alcanzado
  92.   (let ((ultimo (car (last camino))))
  93.     (format t "~%Estado Final:  ~a ~a ~a" 
  94.             (lado-a-string (estado-ml ultimo) (estado-cl ultimo))
  95.             "   ~~~~ B "
  96.             (lado-a-string (estado-mr ultimo) (estado-cr ultimo))))
  97.   (format t "~%====================================~%"))
  98.  
  99. (defun main ()
  100.   (let ((inicio (make-estado :ml 3 :cl 3 :mr 0 :cr 0 :side 0 :camino '()))
  101.         (fin (make-estado :ml 0 :cl 0 :mr 3 :cr 3 :side 1 :camino '())))
  102.     (resolver inicio fin '())))
  103.  
  104. (main)
Success #stdin #stdout 0.02s 30444KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
====================================
SOLUCIÓN ENCONTRADA
Estado actual: [MMMCCC]  B ~~~~    [   ]
Acción: 0M2C ->
Estado actual: [MMMC]    ~~~~ B  [CC ]
Acción: 0M1C <-
Estado actual: [MMMCC]  B ~~~~    [C  ]
Acción: 0M2C ->
Estado actual: [MMM]    ~~~~ B  [CCC]
Acción: 0M1C <-
Estado actual: [MMMC]  B ~~~~    [CC ]
Acción: 2M0C ->
Estado actual: [MC ]    ~~~~ B  [MMCC]
Acción: 1M1C <-
Estado actual: [MMCC]  B ~~~~    [MC ]
Acción: 2M0C ->
Estado actual: [CC ]    ~~~~ B  [MMMC]
Acción: 0M1C <-
Estado actual: [CCC]  B ~~~~    [MMM]
Acción: 0M2C ->
Estado actual: [C  ]    ~~~~ B  [MMMCC]
Acción: 1M0C <-
Estado actual: [MC ]  B ~~~~    [MMCC]
Acción: 1M1C ->
Estado Final:  [   ]    ~~~~ B  [MMMCCC]
====================================
https://ideone.com/VhX43D
language:
Common Lisp (sbcl 1.4.16)
created:
3 hours ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!