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)))))))