Horse Solitaire

You have problems, and we're glad to hear them. Explain the problem, what you have tried, and where you got stuck.
Feel free to share a little info on yourself and the course.
Forum rules
Please respect your teacher's guidelines. Homework is a learning tool. If we just post answers, we aren't actually helping. When you post questions, be sure to show what you have tried or what you don't understand.
Post Reply
darkblue10
Posts: 1
Joined: Tue Jun 14, 2016 6:03 am

Horse Solitaire

Post by darkblue10 » Wed Jun 15, 2016 1:37 am

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

	

David Mullen
Posts: 78
Joined: Mon Dec 01, 2014 12:29 pm
Contact:

Re: Horse Solitaire

Post by David Mullen » Thu Jun 16, 2016 1:48 pm

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.

Post Reply