Problema del 8-puzzle

1
Problema del 8-puzzle

• Representación en LISP

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

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

4
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

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

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

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

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

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

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

11
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