PolloZorro.lsp

;PROBLEMA DEL GRANJERO, EL ZORRO, EL POLLO Y EL GRANO
;==============================================================================


(setq CombinacionLegal '((zorro grano) (grano zorro) (pollo) (grano) (zorro) (grano zorro pollo) nil
      			(grano pollo zorro) (zorro grano pollo) (zorro pollo grano)
			(pollo grano zorro) (pollo zorro grano)
		)
)
(setq Izq 'Izq==>)
(setq Der 'Der==>)
(setq Mov 'Mov==>)
(setq Movimiento nil)	; Variable para almacenar al movimiento en turno

; Conocimiento
(setq OrillaIzquierda '(zorro grano pollo))
(setq OrillaDerecha nil)



;==========================================================================
; Es la funciOn principal.
; correr como:		(gzpm)
;==========================================================================
(defun gzpm ()
	(loop
		(if (= (length OrillaIzquierda) 0) (return 'fin))
		
		(print '===================)
		(Muestra Izq OrillaIzquierda)			; Muestra el estado actual del problema
		(Muestra Der OrillaDerecha)
		(sleep 1)					; Una pausa
		
		(setq Objeto (ObtenObjetoAMover Izq))		; Obtener algo que mover
		(Mover 'IzqADer Objeto)				; Intentar moverlo
		(cond	( (null OrillaDerecha) )		; Que no haga nada si estA vacio
			( (not (EsLegal? OrillaDerecha))
				(setq Objeto (ObtenObjetoAMover Der))	; Obtener algo para mover de regreso
				(Mover 'DerAIzq Objeto)
			)
		)
	)
	(print '===================)
	(Muestra Izq OrillaIzquierda)			; Muestra el estado actual del problema
	(Muestra Der OrillaDerecha)

)


;________________________________________
; Mueve un elemento de un lado a otro
;----------------------------------------
(defun Mover (Direccion Objeto)
	(case Direccion
		('IzqADer
			(cond	((EsLegal? OrillaIzquierda)
				 	(setq OrillaDerecha (append OrillaDerecha (list Objeto) ))	; Poner al final
					(setq Movimiento (FormaMovimiento Objeto 'Izq 'Der))
				)
				(t	(setq OrillaIzquierda (append OrillaIzquierda (list Objeto))); Poner al final
					(setq Movimiento (list Objeto))
					(setq Movimiento (append Movimiento '(==>)))
					(setq Movimiento (append Movimiento '(Fue Movimiento Invalido)))
				)
			)
		)
		('DerAIzq
			(cond	((EsLegal? OrillaDerecha)
				 	(setq OrillaIzquierda (append OrillaIzquierda (list Objeto) )); Poner al final
					(setq Movimiento (FormaMovimiento Objeto 'Der 'Izq))
				)
				(t	(setq OrillaDerecha (append OrillaDerecha (list Objeto)))	; Poner al final
					(setq Movimiento (list Objeto))
					(setq Movimiento (append Movimiento '(==>)))
					(setq Movimiento (append Movimiento '(Fue Movimiento Invalido)))
				)
			)
		)
	)
	(Muestra Mov (list Movimiento))		; Se convierte a lista para aprovechar la funciOn MUESTRA
)


;________________________________________
; Se obtiene un elemento para ser movido
; eliminAndolo de la lista
;----------------------------------------
(defun ObtenObjetoAMover (Orilla)
  	(setq Objeto nil)		; inicializar la variable
	(case Orilla
		('Izq==>
		 	(cond	((eql OrillaIzquierda nil) (print 'Orilla_Izquierda_Vacia))
				(t	(setq Objeto (first OrillaIzquierda))
					(setq OrillaIzquierda (cdr OrillaIzquierda))
				)
			)
		)
		('Der==>
		 	(cond	((eql OrillaDerecha nil) (print 'Orilla_Derecha_Vacia))
				(t	(setq Objeto (first OrillaDerecha))
					(setq OrillaDerecha (cdr OrillaDerecha))
				)
			)
		)
	)
	Objeto
)

;============================================
; HERRAMIENTAS DE APOYO
;============================================

;_________________________________________________
; Se revisa si lo que se queda en una orilla es
; una combinaciOn legal
;-------------------------------------------------
(defun EsLegal? (Lista)
	(setq Legal nil)		; Inicia negada
	(dolist (Combinacion CombinacionLegal)
		(if (equal Combinacion Lista) (setq Legal t))
	)
	Legal
)


;_________________________________________________
; Forma una lista con la secuencia del movimiento
;-------------------------------------------------
(defun FormaMovimiento (Objeto Dir1 Dir2)
	(setq Lista '(Mover))
	(setq Lista (append Lista (list Objeto)))
	(setq Lista (append Lista '(de)))
	(setq Lista (append Lista (list Dir1)))
	(setq Lista (append Lista '(a)))
	(setq Lista (append Lista (list Dir2)))
)

;________________________________________
; Muestra el contenido de una lista
;----------------------------------------
(defun Muestra (Lado Lista)
	(setq Lista (append (list Lado) Lista))
	(print Lista)
)

;________________________________________
; Elimina el primer elemento de la lista
;----------------------------------------
(defun EliminaPrimerElemento (Lista)
	(setq Lista (cdr Lista))
)