Implementación en CLIPS de un Sistema Basado en Reglas para el Juego del 8-Puzzle

Daniel Rueda Macías (559207)

18/11/2016

MÓDULO MAIN Y HEURÍSTICA

(defmodule MAIN (export deftemplate nodo)
(export deffunction heuristica))

(deftemplate MAIN::nodo
  ; Definimos la estructura que tendrá un nodo
  (multislot estado)
  (multislot camino)
  (slot heuristica)
  (slot coste)
  (slot clase (default abierto)))

(defglobal MAIN
  ; Definimos estado inicial y final
  ?*estado-inicial* = (create$ B B B H V V V)
  ?*estado-final* = (create$ V V V H B B B))

(deffunction MAIN::heuristica ($?estado)
  (bind ?res 0)
  (loop-for-count (?i 1 7)
    ; Si estado inicial de (i) no es igual a estado final de (i) entonces
    ; se suma uno al resultado. Número de fichas descolocadas
    (if (neq (nth ?i ?estado)
             ; NTH accede a posición enésima de un vector
             (nth ?i ?*estado-final*))
      then (bind ?res (+ ?res 1))))
  ?res)

MÓDULO MAIN::INICIAL

(defrule MAIN::inicial
  =>
  (assert (nodo
    (estado ?*estado-inicial*)
    (camino)
    ; Se añade un coste de inicio = 0
    (coste 0)
    (heuristica (heuristica ?*estado-inicial*)))))

MÓDULO MAIN::CONTROL

(defrule MAIN::pasa-el-mejor-a-cerrado-A*
  ?nodo <- (nodo (heuristica ?h1)
               (coste ?c1) (clase abierto))
  (not (nodo (clase abierto)
             (heuristica ?h2)
             (coste ?c2&:(< (+ ?c2 ?h2) (+ ?c1 ?h1)))))
  =>
  (modify ?nodo (clase cerrado))
  (focus OPERADORES))

MÓDULO MAIN::OPERADORES

(defmodule OPERADORES
  (import MAIN deftemplate nodo)
  (import MAIN deffunction heuristica))

(defrule OPERADORES::mover_izquierda
  ?n <- (nodo (estado $?a ?b $?y&:(<= (length ?y) 2) H $?d)
             (camino $?movimientos)
             (coste ?coste)
             (clase cerrado))
  =>
  (bind ?nuevo-estado (create$ $?a H $?y ?b $?d))
  (assert (nodo (estado $?nuevo-estado)
                 (coste (+ ?coste 1))
                 (heuristica (heuristica $?nuevo-estado))
                 (camino ?movimientos(implode$ ?nuevo-estado)))))

(defrule OPERADORES::mover_derecha
  ?n <- (nodo (estado $?a H $?y&:(<= (length ?y) 2) ?b $?d)
             (camino $?movimientos)
             (clase cerrado)
             (coste ?coste))
  =>
  (bind ?nuevo-estado (create$ $?a ?b $?y H $?d))
  (assert (nodo (estado $?nuevo-estado)
                 (coste (+ ?coste 1))
                 (heuristica (heuristica $?nuevo-estado))
                 (camino ?movimientos(implode$ ?nuevo-estado)))))

MÓDULO RESTRICCIONES

(defmodule RESTRICCIONES
  (import MAIN deftemplate nodo)
  (import MAIN deffunction heuristica))

(defrule RESTRICCIONES::repeticiones-de-nodo
  (declare (auto-focus TRUE))
  ; Evitamos repeticiones comparando las longitudes de los
  ; diferentes caminos posibles
  ?nodoUno <- (nodo (estado $?actual) (camino $?caminoUno))
  ?nodoDos <- (nodo (estado $?actual) (camino $?caminoDos))
  (test (> (length ?caminoUno) (length ?caminoDos)))
  =>
  (retract ?nodoUno))

MÓDULO MAIN::SOLUCION

(defmodule SOLUCION
  (import MAIN deftemplate nodo)
  (import MAIN deffunction heuristica))

(defrule SOLUCION::reconoce-solucion
  (declare (auto-focus TRUE))
  ?nodo <- (nodo (estado V V V H B B B)
               (camino $?caminoUno) (heuristica 0))
  =>
  (retract ?nodo)
  (assert (solucion $?caminoUno)))

(defrule SOLUCION::escribe-solucion
  (solucion $?camino)
  =>
  (printout t"La solución tiene" (length ?camino)" pasos" crlf)
  (loop-for-count (?i 1 (length ?camino))
    (printout t (nth ?i $?camino) crlf))
  (halt))