Problema Del 8

Transcript

Problema del 8-puzzle Representación en LISP 1 Ejemplo A, (1/4) ;;; EJEMPLO DE REPRESENTACION DE UN PROBLEMA (sin variables) (setf *estado0* '((0 1) (1 2) (2 3) (3 4) (4 NIL) (5 5) (6 6) (7 7) (8 8))) (setf *problema-8-puzle* '(:8-puzle (:estado-inicial *estado0*) (:operadores (:mueve-arriba (:accion #'mueve-arriba)) (:mueve-abajo (:accion #'mueve-abajo)) (:mueve-izquierda (:accion #'mueve-izquierda)) (:mueve-derecha (:accion #'mueve-derecha))) (:estados-objetivo #'reconoce))) 2 1 Ejemplo A, (2/4) (defun reconoce (estado) (equal estado '((0 1) (1 2) (2 3) (3 4) (4 8) (5 5) (6 6) (7 7) (8 NIL)))) (defun posible-mover-arriba-p (estado) (let ((posicion (posicion NIL estado))) (not (member posicion '(0 1 2))))) (defun posible-mover-abajo-p (estado) (let ((posicion (posicion NIL estado))) (not (member posicion '(6 7 8))))) (defun posible-mover-izquierda-p (estado) (let ((posicion (posicion NIL estado))) (not (member posicion '(0 3 6))))) (defun posible-mover-derecha-p (estado) (let ((posicion (posicion NIL estado))) (not (member posicion '(2 5 8))))) 3 Ejemplo A, (3/4) (defun mueve-arriba (estado) (if (posible-mover-arriba-p estado) (let* ((nuevo-estado (copy-tree estado)) (posicion-vacia (posicion NIL nuevo-estado)) (posicion-arriba (- posicion-vacia 3)) (ficha-arriba (ficha posicion-arriba nuevo-estado))) (coloca posicion-arriba NIL nuevo-estado) (coloca posicion-vacia ficha-arriba nuevo-estado) nuevo-estado))) ;;; Análogos mueve-abajo, mueve-izquierda ;;; y mueve-derecha 4 2 Ejemplo A, (4/4) (defun posicion (ficha estado) (first (first (member ficha estado :test #'(lambda (x y) (eql x (second y))))))) (defun coloca (posicion ficha estado) (setf (second (nth posicion estado)) ficha)) (defun ficha (posicion estado) (second (nth posicion estado))) 5 Ejemplo B, (1/6) ;;; EJEMPLO DE REPRESENTACION DE UN ;;; PROBLEMA (con variables) (setf *estado0* '((0 1) (1 2) (2 3) (3 4) (4 NIL) (5 5) (6 6) (7 7) (8 8))) (setf *problema-8-puzle* '(:8-puzle (:estado-inicial *estado0*) (:operadores (:mueve (:variables (direccion '(arriba abajo derecha izquierda))) (:accion #'mueve))) (:estados-objetivo #'reconoce))) 6 3 Ejemplo B, (2/6) (defun reconoce (estado) (equal estado '((0 1) (1 2) (2 3) (3 4) (4 8) (5 5) (6 6) (7 7) (8 NIL)))) (defun posible-mover-p (direccion estado) (cond ((eql direccion 'arriba) (posible-mover-arriba-p estado)) ((eql direccion 'abajo) (posible-mover-abajo-p estado)) ((eql direccion 'izquierda) (posible-mover-izquierda-p estado)) ((eql direccion 'derecha) (posible-mover-derecha-p estado)))) (defun posible-mover-arriba-p (estado) (let ((posicion (posicion NIL estado))) (not (member posicion '(0 1 2))))) ;;; Análogo para posible-mover-abajo-p, ;;; posible-mover-izquierda-p y posible-moverderecha-p 7 Ejemplo B, (3/6) (defun mueve (direccion estado) (if (posible-mover-p direccion estado) (let* ((nuevo-estado (copy-tree estado)) (posicion-vacia (posicion NIL nuevo-estado)) (posicion-nueva (nueva-posicion direccion posicion-vacia)) (ficha-nueva (ficha posicion-nueva nuevo-estado))) (coloca posicion-nueva NIL nuevo-estado) (coloca posicion-vacia ficha-nueva nuevo-estado) nuevo-estado))) 8 4 Ejemplo B, (4/6) (defun nueva-posicion (direccion posicion-vacia) (cond ((eql direccion 'arriba) (- posicion-vacia 3)) ((eql direccion 'abajo) (+ posicion-vacia 3)) ((eql direccion 'izquierda) (- posicion-vacia 1)) ((eql direccion 'derecha) (+ posicion-vacia 1)))) (defun posicion (ficha estado) (first (first (member ficha estado :test #'(lambda (x y) (eql x (second y))))))) 9 Ejemplo B, (5/6) (defun coloca (posicion ficha estado) (setf (second (nth posicion estado)) ficha)) (defun ficha (posicion estado) (second (nth posicion estado))) ;;; REPRESENTACION CON ESTRUCTURAS DE LISP (defstruct problema nombre estado-inicial operadores test-objetivo) (defstruct operador nombre accion (variables nil)) 10 5 Ejemplo B, (6/6) (setf *operadores* (list (make-operador :nombre 'mueve-arriba :accion #'mueve-arriba) (make-operador :nombre 'mueve-abajo :accion #'mueve-abajo) (make-operador :nombre 'mueve-derecha :accion #'mueve-derecha) (make-operador :nombre 'mueve-izquierda :accion #'mueve-izquierda))) (setf *problema-8-puzle* (make-problema :nombre '8-puzle :estado-inicial *estado0* :operadores *operadores* :estados-objetivo #'reconoce)) 11 6