Page 1 of 1

Horse Solitaire

Posted: 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

Posted: 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.