Page 1 of 1

Horse Solitaire

PostPosted: Wed Jun 15, 2016 1:37 am
by darkblue10
As Homework I have to do a kind of Horse Solitaire.

There is a board N x M dimensions and you have a Chest's Horse on the first cell (top-left (0,0)). You have 8 operators in order to move the horse as in chest it moves (for example move-2-1 move-1-2...)

I have to use a search algorith to find a solution.

The problem is that CLisp shows that error: ARRAY-DIMENSION: argument 'MOVER-CABALLO is not an array and I dont know why, please help

Code: Select all
;; DECLARACION DE VARIABLES GLOBALES

   ;; N indica el numero de filas del tablero
   
   (defparameter N '5)
   
   ;; M indica el numero de columnas del tablero
   
   (defparameter M '5)

   
;; REPRESENTACION DE ESTADOS

   ;; Un estado se compondra de la posicion actual del caballo dentro del tablero
   ;; y de un historial de las casillas que ya ha visitado
   
   (defun crea-estado (posicion casillas)
               (list posicion casillas))
            
   ;; Al principio, el estado inicial es aquel en el que el caballo se encuentra en
   ;; la primera fila, primera columna y no ha visitado ninguna casilla salvo en la
   ;; que se encuentra.
   
   (defparameter *estado-inicial*
      (crea-estado (list '0 '0 )
         (make-array (list N M) :initial-element 0)))
   (setf (aref (second *estado-inicial*) 0 0) 1)


   ;; Al final, el estado final es aquel en el que el caballo se encuentra en una casilla   
   ;; cualquiera, lo unico que importa es que haya visitado todas y cada una de las casillas
   
   (defparameter *estado-final*
      (crea-estado (list nil nil )
             (make-array (list N M) :initial-element 1)))
            
   ;; Comprobacion si el estado es el estado final, es decir, comprobamos si todas las casillas
   ;; han sido visitadas
   
   (defun es-estado-final (estado)
      (let ((res 1))
         (if (and (= (first (array-dimensions (second estado))) (first (array-dimensions (second *estado-final*))))
               (= (second (array-dimensions (second estado))) (second (array-dimensions (second *estado-final*)))))
            (loop for i from 0 below (first (array-dimensions (second estado))) do
               (loop for j from 0 below (second (array-dimensions (second estado))) do
                  (if (not (= (aref (second estado) i j)(aref (second *estado-final*) i j)))
                     (setf res 0))))
               (setf res 0))
         (if (= res 0)
            nil
            T)
      ))
      
;; OPERADORES
   
   ;; Declaracion de los operadores
   
   (defparameter *operadores*
   '(
      (list 'mover-caballo -2 1)
      (list 'mover-caballo -1 2)
      (list 'mover-caballo 1 2)
      (list 'mover-caballo 2 1)
      (list 'mover-caballo 2 -1)
      (list 'mover-caballo 1 -2)
      (list 'mover-caballo -1 -2)
      (list 'mover-caballo -2 -1)
   ))
   
   ;; Operador para mover el caballo tantas filas como indique VERTICAL y tantas columnas como indique HORIZONTAL, tomando como
   ;; positivo mover hacia abajo y hacia la derecha y negativo los casos contrarios.
   ;;       Se comprueba antes de nada si la casilla a la que se quiere desplazar se encuentra dentro del tablero, en caso contrarios
   ;;      devuelve el estado en el que se encontraba.
   
   (defun mover-caballo (estado vertical horizontal)
      (let ((fila-destino (+ (first (first estado)) vertical))
           (columna-destino (+ (second (first estado)) horizontal)))      
         (cond
            ((and
               (and
                  (< fila-destino N)
                  (>= fila-destino 0))
               (and   
                  (< columna-destino M)
                  (>= columna-destino 0)))               
                     (setf (aref (second estado) fila-destino columna-destino) 1)
                     (setf (first (first estado)) fila-destino)
                     (setf (second (first estado)) columna-destino)
            )
            (t estado))      
      ))
   
   ;; Funcion para aplicar un operador a un estado
   
   (defun aplica (operador estado)
      (funcall (symbol-function (first operador)) estado (second operador) (third operador)))
   
   ;; Funcion para verificar
   
   (defun verifica (plan &optional (estado *estado-inicial* ))
   (cond ((null estado)(format t "~& Movimiento no permitido ~&") nil)
      ((null plan)(cond ((es-estado-final estado)(format t "~& ~a estado final ~&" estado) t)
                     (t (format t "~& ~a no es estado final ~&" estado) nil)))
   (t (format t "~&~a ~a" estado (first plan))
      (verifica (rest plan) (aplica (first plan) estado)))))


;; BUSQUEDAS

   ;; Busqueda en profundidad
   
   ;; Estructura del nodo
   
   (defstruct (nodo
         (:constructor crea-nodo)
         (:conc-name nil))
   estado
   camino)
      
   ;; Funcion para realizar la busqueda en profundidad   
      
   (defun busqueda-en-profundidad ()
      (let ((abiertos (list (crea-nodo :estado *estado-inicial* :camino nil)))
           (cerrados nil)
             (actual nil)
           (nuevos-sucesores nil))
      (loop
         (if (null abiertos)(return nil))
         (setf actual (first abiertos))
         (setf abiertos (rest abiertos))
         (setf cerrados (cons actual cerrados))
         (cond ((es-estado-final (estado actual))(return actual))
            (t (setf nuevos-sucesores (nuevos-sucesores actual abiertos
               cerrados))
               (setf abiertos (append nuevos-sucesores abiertos)))))))
      
   ;; Funciones auxiliares (nos serviran tambien para la busqueda en anchura)
   
   ;; Funcion para encontrar nuevos sucesores
   
   (defun nuevos-sucesores (nodo abiertos cerrados)
      (elimina-duplicados (sucesores nodo) abiertos cerrados))
   
   ;;
   
   (defun sucesores (nodo)
      (let ((resultado ()))
         (dolist (operador *operadores*)
            (let ((siguiente (sucesor nodo operador)))
               (when siguiente (push siguiente resultado))))
      (reverse resultado)))


   ;;   
      
   (defun sucesor (nodo operador)
      (let ((siguiente-estado (aplica operador (estado nodo))))
         (when siguiente-estado
            (crea-nodo :estado siguiente-estado
                     :camino (cons operador (camino nodo))))))

   ;;   
      
   (defun elimina-duplicados (nodos abiertos cerrados)
      (let((lista-sin-duplicados ()))
         (dolist (nodo nodos)
            (when (and (not(esta nodo abiertos))
                     (not(esta nodo cerrados)))
                  (push nodo lista-sin-duplicados)))
            (reverse lista-sin-duplicados)))
      
   ;;   
      
   (defun esta (nodo lista-de-nodos)
      (let((estado (estado nodo))
         (esta-o-no nil))
         (dolist (n lista-de-nodos)
            (if (equal estado (estado n))(setf esta-o-no t)))
      esta-o-no))
         
   ;; Busqueda en anchura
   
   ;; Funcion para realizar la busqueda en anchura
   
   (defun busqueda-en-anchura ()
      (let ((abiertos (list (crea-nodo :estado *estado-inicial* :camino nil)))
            (cerrados nil)
            (actual nil)
            (nuevos-sucesores nil))
      (loop
      (if (null abiertos)(return nil))
      (setf actual (first abiertos))
      (setf abiertos (rest abiertos))
      (setf cerrados (cons actual cerrados))
      (cond ((es-estado-final (estado actual))(return actual))
      (t (setf nuevos-sucesores (nuevos-sucesores actual abiertos
         cerrados))
      (setf abiertos (append abiertos nuevos-sucesores)))))))

   

Re: Horse Solitaire

PostPosted: Thu Jun 16, 2016 1:48 pm
by David Mullen
In the definition and initial value form for *operadores*, it looks like it's wanting to call the LIST function, but the outer form is quoted, not evaluated.