I1M2014: El patrón de búsqueda por primero el mejor en Haskell

En la primera parte de la clase de hoy del curso Informática de 1º del Grado en Matemáticas hemos estudiado la técnica de resolución de problemas mediante búsqueda por primero el mejor.

La clase comenzó analizando estudiando el problema del paseo:

Una persona puede moverse en línea recta dando cada vez un paso hacia la derecha o hacia la izquierda. Podemos representarlo mediante su posición X. El valor inicial de X es 0. El problema consiste en llegar a la posición -3.

Se representó el problema como espacio de estado y se comprobó cómo no se encuentra ña solución mediante búsqueda en profundidad. Para resolverlo se introdujo una heurística y el patrón de búsqueda por primero el mejor. Finalmente, se aplicó el patrón de búsqueda para resolver el problema del 8 puzzle.

Las transparencias usadas en la clase son las páginas 28-40 del tema 23:

El código del problema del paseo es

import I1M.BusquedaEnEspaciosDeEstados
import I1M.BusquedaPrimeroElMejor

-- ---------------------------------------------------------------------
-- § El problema del paseo                                            --
-- ---------------------------------------------------------------------


type Posicion = Int

inicial :: Posicion
inicial = 0

final :: Posicion
final = -3

data Nodos = N [Posicion] deriving (Eq, Show)

-- (sucesores n) es la lista de sucesores del nodo n. Por ejemplo,
--    sucesores (N [0])     ==  [N [1,0],N [-1,0]]
--    sucesores (N [1,0])   ==  [N [2,1,0]]
--    sucesores (N [-1,0])  ==  [N [-2,-1,0]]
sucesores :: Nodos -> [Nodos]
sucesores (N (n@(p:ps))) = 
    [N (p+d:n) | d <- [1,-1], p+d `notElem` ps]

-- (esFinal n) se verifica si n es un nodo final.
esFinal :: Nodos -> Bool
esFinal (N (p:_)) = p == final

-- Búsqueda en profundidad
-- =======================

-- (buscaEE_P) es la lista de las soluciones del problema del paseo por
-- búsqueda en profundidad. 
buscaEE_P = buscaEE sucesores
                    esFinal        
                    (N [inicial])

-- Nota. Al buscar una solución con
--    ghci> head buscaEE_P
--    C-c C-cInterrupted.
-- hay que pararlo porque no la encuentra al meterse en una rama
-- infinita. Se puede resolver cambiando el orden de los sucesores

buscaEE_P2 = buscaEE (reverse . sucesores)
                     esFinal        
                     (N [inicial])

-- Ahora sí encuentra la solución
--    ghci> head buscaEE_P2
--    N [-3,-2,-1,0]

-- Búsqueda por primero el mejor
-- =============================

-- (distancia x y) es la distancia entre las posiciones x e y. Por ejemplo,
--    distancia    2    5  ==  3
--    distancia (-2)    5  ==  7
--    distancia    2 (-5)  ==  7
--    distancia (-2) (-5)  ==  3
--    distancia    5    2  ==  3
distancia :: Posicion -> Posicion -> Int
distancia x y = abs (x - y)

-- (heuristica p) la distancia de p al estado final. Por ejemplo,
--    heuristica inicial  ==  3
heuristica :: Posicion  -> Int
heuristica p = distancia p final

-- Un nodo es menor o igual que otro si tiene una heurística menor o
-- igual. 
instance Ord Nodos where 
    N (p1:_) <= N (p2:_) = heuristica p1 <= heuristica p2

-- (buscaPM_P) es la lista de las soluciones del problema del paseo por
-- búsqueda primero el mejor. Por ejemplo,
--    head buscaPM_P  ==  N [-3,-2,-1,0]
buscaPM_P = buscaPM sucesores      
                    esFinal        
                    (N [inicial])

import I1M.BusquedaEnEspaciosDeEstados

import I1M.BusquedaPrimeroElMejor

-- ---------------------------------------------------------------------

-- § El problema del paseo --

-- ---------------------------------------------------------------------

type Posicion = Int

inicial :: Posicion

inicial = 0

final :: Posicion

final = -3

data Nodos = N [Posicion] deriving (Eq, Show)

-- (sucesores n) es la lista de sucesores del nodo n. Por ejemplo,

-- sucesores (N [0]) == [N [1,0],N [-1,0]]

-- sucesores (N [1,0]) == [N [2,1,0]]

-- sucesores (N [-1,0]) == [N [-2,-1,0]]

sucesores :: Nodos -> [Nodos]

sucesores (N (n@(p:ps))) =

[N (p+d:n) | d <- [1,-1], p+d `notElem` ps]

-- (esFinal n) se verifica si n es un nodo final.

esFinal :: Nodos -> Bool

esFinal (N (p:_)) = p == final

-- Búsqueda en profundidad

-- =======================

-- (buscaEE_P) es la lista de las soluciones del problema del paseo por

-- búsqueda en profundidad.

buscaEE_P = buscaEE sucesores

esFinal

(N [inicial])

-- Nota. Al buscar una solución con

-- ghci> head buscaEE_P

-- C-c C-cInterrupted.

-- hay que pararlo porque no la encuentra al meterse en una rama

-- infinita. Se puede resolver cambiando el orden de los sucesores

buscaEE_P2 = buscaEE (reverse . sucesores)

esFinal

(N [inicial])

-- Ahora sí encuentra la solución

-- ghci> head buscaEE_P2

-- N [-3,-2,-1,0]

-- Búsqueda por primero el mejor

-- =============================

-- (distancia x y) es la distancia entre las posiciones x e y. Por ejemplo,

-- distancia 2 5 == 3

-- distancia (-2) 5 == 7

-- distancia 2 (-5) == 7

-- distancia (-2) (-5) == 3

-- distancia 5 2 == 3

distancia :: Posicion -> Posicion -> Int

distancia x y = abs (x - y)

-- (heuristica p) la distancia de p al estado final. Por ejemplo,

-- heuristica inicial == 3

heuristica :: Posicion -> Int

heuristica p = distancia p final

-- Un nodo es menor o igual que otro si tiene una heurística menor o

-- igual.

instance Ord Nodos where

N (p1:_) <= N (p2:_) = heuristica p1 <= heuristica p2

-- (buscaPM_P) es la lista de las soluciones del problema del paseo por

-- búsqueda primero el mejor. Por ejemplo,

-- head buscaPM_P == N [-3,-2,-1,0]

buscaPM_P = buscaPM sucesores

esFinal

(N [inicial])

El código del patrón de búsqueda por primero el mejor es

module BusquedaPrimeroElMejor (buscaPM)  where

-- ---------------------------------------------------------------------
-- Importaciones                                                      --
-- ---------------------------------------------------------------------

-- Nota: Hay que elegir una implementación de las colas de prioridad.
import I1M.ColaDePrioridad
-- import ColaDePrioridadConListas
-- import ColaDePrioridadConMonticulos

-- ---------------------------------------------------------------------
-- Búsqueda por primero el mejor                                      --
-- ---------------------------------------------------------------------

-- (buscaPM s o e) es la lista de soluciones del problema de espacio de
-- estado definido por la función sucesores (s), el objetivo (o) y el
-- estado inicial (e), obtenidas buscando por primero el mejor.
buscaPM :: (Ord nodo) => 
           (nodo -> [nodo])   -- sucesores
           -> (nodo -> Bool)  -- esFinal
           -> nodo            -- nodo actual
           -> [nodo]          -- solución
buscaPM sucesores esFinal x = busca' (inserta x vacia)
 where
   busca' c 
    | esVacia c = []
    | esFinal (primero c)  
        = (primero c):(busca' (resto c))
    | otherwise            
        = busca' (foldr inserta (resto c) (sucesores x))
          where x = primero c

module BusquedaPrimeroElMejor (buscaPM) where

-- ---------------------------------------------------------------------

-- Importaciones --

-- ---------------------------------------------------------------------

-- Nota: Hay que elegir una implementación de las colas de prioridad.

import I1M.ColaDePrioridad

-- import ColaDePrioridadConListas

-- import ColaDePrioridadConMonticulos

-- ---------------------------------------------------------------------

-- Búsqueda por primero el mejor --

-- ---------------------------------------------------------------------

-- (buscaPM s o e) es la lista de soluciones del problema de espacio de

-- estado definido por la función sucesores (s), el objetivo (o) y el

-- estado inicial (e), obtenidas buscando por primero el mejor.

buscaPM :: (Ord nodo) =>

(nodo -> [nodo]) -- sucesores

-> (nodo -> Bool) -- esFinal

-> nodo -- nodo actual

-> [nodo] -- solución

buscaPM sucesores esFinal x = busca' (inserta x vacia)

where

busca' c

| esVacia c = []

| esFinal (primero c)

= (primero c):(busca' (resto c))

| otherwise

= busca' (foldr inserta (resto c) (sucesores x))

where x = primero c

El código del 8 puzzle es

import I1M.BusquedaPrimeroElMejor
import Data.Array

-- ---------------------------------------------------------------------
-- El problema del 8 puzzle                                           --
-- ---------------------------------------------------------------------

-- Para el 8-puzzle se usa un cajón cuadrado en el que hay situados 8 bloques
-- cuadrados.  El cuadrado restante está sin rellenar. Cada bloque tiene un
-- número. Un bloque adyacente al hueco puede deslizarse hacia él. El juego
-- consiste en transformar la posición inicial en la posición final mediante
-- el deslizamiento de los bloques.  En particular, consideramos el estado
-- inicial y final siguientes:
--
--      +---+---+---+                   +---+---+---+
--      | 2 | 6 | 3 |                   | 1 | 2 | 3 | 
--      +---+---+---+                   +---+---+---+ 
--      | 5 |   | 4 |                   | 8 |   | 4 | 
--      +---+---+---+                   +---+---+---+ 
--      | 1 | 7 | 8 |                   | 7 | 6 | 5 | 
--      +---+---+---+                   +---+---+---+ 
--                      
--      Estado inicial                  Estado final

-- Una posición es un par de enteros.
type Posicion = (Int,Int)

-- Un tablero es un vector de posiciones, en el que el índice indica el
-- elemento que ocupa la posición.
type Tablero  = Array Int Posicion

-- inicial8P es el estado inicial del 8 puzzle. En el ejemplo es
--      +---+---+---+
--      | 2 | 6 | 3 | 
--      +---+---+---+ 
--      | 5 |   | 4 | 
--      +---+---+---+ 
--      | 1 | 7 | 8 | 
--      +---+---+---+ 
inicial8P :: Tablero 
inicial8P = array (0,8) [(2,(1,3)),(6,(2,3)),(3,(3,3)),
                         (5,(1,2)),(0,(2,2)),(4,(3,2)),
                         (1,(1,1)),(7,(2,1)),(8,(3,1))]

-- final8P es el estado final del 8 puzzle. En el ejemplo es
--      +---+---+---+
--      | 1 | 2 | 3 | 
--      +---+---+---+ 
--      | 8 |   | 4 | 
--      +---+---+---+ 
--      | 7 | 6 | 5 | 
--      +---+---+---+ 
final8P :: Tablero
final8P = array (0,8) [(1,(1,3)),(2,(2,3)),(3,(3,3)),
                       (8,(1,2)),(0,(2,2)),(4,(3,2)),
                       (7,(1,1)),(6,(2,1)),(5,(3,1))]

-- (distancia p1 p2) es la distancia Manhatan entre las posiciones p1 y
-- p2. Por ejemplo,
--    distancia (2,7) (4,1)  ==  8
distancia :: Posicion -> Posicion -> Int
distancia (x1,y1) (x2,y2) = abs (x1-x2) + abs (y1-y2)

-- (adyacente p1 p2) se verifica si las posiciones p1 y p2 son
-- adyacentes. Por ejemplo,
--    adyacente (3,2) (3,1)  ==  True
--    adyacente (3,2) (1,2)  ==  False
adyacente :: Posicion -> Posicion -> Bool
adyacente p1 p2 = distancia p1 p2 == 1

-- (todosMovimientos t) es la lista de los tableros obtenidos
-- aplicándole al tablero t todos los posibles movimientos; es decir,
-- intercambiando la posición del hueco con sus adyacentes. Por ejemplo, 
--    ghci> inicial8P
--    array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                 (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]
--    ghci> todosMovimientos inicial8P
--    [array (0,8) [(0,(3,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(2,2)),
--                  (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],
--     array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                  (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],
--     array (0,8) [(0,(2,3)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                  (5,(1,2)),(6,(2,2)),(7,(2,1)),(8,(3,1))],
--     array (0,8) [(0,(2,1)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                  (5,(1,2)),(6,(2,3)),(7,(2,2)),(8,(3,1))]]
todosMovimientos :: Tablero -> [Tablero]
todosMovimientos t = 
    [t//[(0,t!i),(i,t!0)] | i<-[1..8], adyacente (t!0) (t!i)] 

-- Los nodos del espacio de estados son listas de tableros [t_n,...,t_1]
-- tal que t_i es un sucesor de t_(i-1).
data Tableros = Est [Tablero] deriving Show

-- (sucesores8P e) es la lista de sucesores del estado e. Por ejemplo,
--    ghci> sucesores8P (Est [inicial8P])
--    [Est [array (0,8) [(0,(3,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(2,2)),
--                       (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],
--          array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],
--    Est [array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                      (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],
--         array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                      (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],
--    Est [array (0,8) [(0,(2,3)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                      (5,(1,2)),(6,(2,2)),(7,(2,1)),(8,(3,1))],
--         array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                      (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],
--    Est [array (0,8) [(0,(2,1)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                      (5,(1,2)),(6,(2,3)),(7,(2,2)),(8,(3,1))],
--         array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                      (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]]]
sucesores8P :: Tableros -> [Tableros]
sucesores8P (Est(n@(t:ts))) = 
    [Est (t':n) | t' <- todosMovimientos t, t' `notElem` ts]

-- (esFinal8P n) se verifica si n es un nodo final del 8 puzzle.
esFinal8P :: Tableros -> Bool
esFinal8P (Est (t:_)) = t == final8P

-- Heurísticas
-- ===========

-- (heur1 t) es la suma de la distancia Manhatan desde la posición de
-- cada objeto del tablero a su posición en el estado final. Por
-- ejemplo,
--    heur1 inicial8P  ==  12
heur1 :: Tablero  -> Int
heur1 t = 
    sum [distancia (t!i) (final8P!i) | i <- [0..8]]

-- Dos estados se consideran iguales si tienen la misma heurística.
instance Eq Tableros
    where Est(t1:_) == Est(t2:_) = heur1 t1 == heur1 t2

-- Un estado es menor o igual que otro si tiene una heurística menor o
-- igual. 
instance Ord Tableros where 
    Est (t1:_) <= Est (t2:_) = heur1 t1 <= heur1 t2

-- (buscaPM_8P) es la lista de las soluciones del 8 puzzle por búsqueda
-- primero el mejor. Por ejemplo,
--    ghci> head buscaPM_8P
--    (Est [array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(3,1)),(6,(2,1)),(7,(1,1)),(8,(1,2))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(3,1)),(6,(2,2)),(7,(1,1)),(8,(1,2))],
--          array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,2))],
--          array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,1))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(3,1)),(6,(1,2)),(7,(2,1)),(8,(1,1))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(3,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],
--          array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],
--          array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(2,1)),(6,(1,2)),(7,(3,2)),(8,(1,1))],
--          array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,1))],
--          array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(1,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(1,1)),(6,(2,1)),(7,(3,2)),(8,(1,2))],
--          array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))],
--          array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(1,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))],
--          array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))],
--          array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,1))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(3,1)),(7,(1,2)),(8,(1,1))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,2)),(6,(3,1)),(7,(1,2)),(8,(1,1))],
--          array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],
--          array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(3,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(1,1))],
--          array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(2,1))],
--          array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(3,2)),(6,(2,2)),(7,(1,1)),(8,(2,1))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,1))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),
--                       (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))],
--          array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),
--                       (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))],
--          array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),
--                       (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(2,2))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),
--                       (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],
--          array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),
--                       (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],
--          array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),
--                       (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],
--          array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),
--                       (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))],
--          array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))],
--          array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],
--          array (0,8) [(0,(1,3)),(1,(1,2)),(2,(2,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],
--          array (0,8) [(0,(2,3)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],
--          array (0,8) [(0,(2,2)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,1)),(6,(2,3)),(7,(1,1)),(8,(3,1))],
--          array (0,8) [(0,(2,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,2)),(6,(2,3)),(7,(1,1)),(8,(3,1))],
--          array (0,8) [(0,(1,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],
--          array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],
--          array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),
--                       (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],
--     78)
buscaPM_8P = buscaPM sucesores8P      
                     esFinal8P        
                     (Est [inicial8P])

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

import I1M.BusquedaPrimeroElMejor

import Data.Array

-- ---------------------------------------------------------------------

-- El problema del 8 puzzle --

-- ---------------------------------------------------------------------

-- Para el 8-puzzle se usa un cajón cuadrado en el que hay situados 8 bloques

-- cuadrados. El cuadrado restante está sin rellenar. Cada bloque tiene un

-- número. Un bloque adyacente al hueco puede deslizarse hacia él. El juego

-- consiste en transformar la posición inicial en la posición final mediante

-- el deslizamiento de los bloques. En particular, consideramos el estado

-- inicial y final siguientes:

-- +---+---+---+ +---+---+---+

-- | 2 | 6 | 3 | | 1 | 2 | 3 |

-- +---+---+---+ +---+---+---+

-- | 5 | | 4 | | 8 | | 4 |

-- +---+---+---+ +---+---+---+

-- | 1 | 7 | 8 | | 7 | 6 | 5 |

-- +---+---+---+ +---+---+---+

-- Estado inicial Estado final

-- Una posición es un par de enteros.

type Posicion = (Int,Int)

-- Un tablero es un vector de posiciones, en el que el índice indica el

-- elemento que ocupa la posición.

type Tablero = Array Int Posicion

-- inicial8P es el estado inicial del 8 puzzle. En el ejemplo es

-- +---+---+---+

-- | 2 | 6 | 3 |

-- +---+---+---+

-- | 5 | | 4 |

-- +---+---+---+

-- | 1 | 7 | 8 |

-- +---+---+---+

inicial8P :: Tablero

inicial8P = array (0,8) [(2,(1,3)),(6,(2,3)),(3,(3,3)),

(5,(1,2)),(0,(2,2)),(4,(3,2)),

(1,(1,1)),(7,(2,1)),(8,(3,1))]

-- final8P es el estado final del 8 puzzle. En el ejemplo es

-- +---+---+---+

-- | 1 | 2 | 3 |

-- +---+---+---+

-- | 8 | | 4 |

-- +---+---+---+

-- | 7 | 6 | 5 |

-- +---+---+---+

final8P :: Tablero

final8P = array (0,8) [(1,(1,3)),(2,(2,3)),(3,(3,3)),

(8,(1,2)),(0,(2,2)),(4,(3,2)),

(7,(1,1)),(6,(2,1)),(5,(3,1))]

-- (distancia p1 p2) es la distancia Manhatan entre las posiciones p1 y

-- p2. Por ejemplo,

-- distancia (2,7) (4,1) == 8

distancia :: Posicion -> Posicion -> Int

distancia (x1,y1) (x2,y2) = abs (x1-x2) + abs (y1-y2)

-- (adyacente p1 p2) se verifica si las posiciones p1 y p2 son

-- adyacentes. Por ejemplo,

-- adyacente (3,2) (3,1) == True

-- adyacente (3,2) (1,2) == False

adyacente :: Posicion -> Posicion -> Bool

adyacente p1 p2 = distancia p1 p2 == 1

-- (todosMovimientos t) es la lista de los tableros obtenidos

-- aplicándole al tablero t todos los posibles movimientos; es decir,

-- intercambiando la posición del hueco con sus adyacentes. Por ejemplo,

-- ghci> inicial8P

-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]

-- ghci> todosMovimientos inicial8P

-- [array (0,8) [(0,(3,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(2,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(2,3)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,2)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(2,1)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,2)),(8,(3,1))]]

todosMovimientos :: Tablero -> [Tablero]

todosMovimientos t =

[t//[(0,t!i),(i,t!0)] | i<-[1..8], adyacente (t!0) (t!i)]

-- Los nodos del espacio de estados son listas de tableros [t_n,...,t_1]

-- tal que t_i es un sucesor de t_(i-1).

data Tableros = Est [Tablero] deriving Show

-- (sucesores8P e) es la lista de sucesores del estado e. Por ejemplo,

-- ghci> sucesores8P (Est [inicial8P])

-- [Est [array (0,8) [(0,(3,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(2,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],

-- Est [array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],

-- Est [array (0,8) [(0,(2,3)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,2)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],

-- Est [array (0,8) [(0,(2,1)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,2)),(8,(3,1))],

-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]]]

sucesores8P :: Tableros -> [Tableros]

sucesores8P (Est(n@(t:ts))) =

[Est (t':n) | t' <- todosMovimientos t, t' `notElem` ts]

-- (esFinal8P n) se verifica si n es un nodo final del 8 puzzle.

esFinal8P :: Tableros -> Bool

esFinal8P (Est (t:_)) = t == final8P

-- Heurísticas

-- ===========

-- (heur1 t) es la suma de la distancia Manhatan desde la posición de

-- cada objeto del tablero a su posición en el estado final. Por

-- ejemplo,

-- heur1 inicial8P == 12

heur1 :: Tablero -> Int

heur1 t =

sum [distancia (t!i) (final8P!i) | i <- [0..8]]

-- Dos estados se consideran iguales si tienen la misma heurística.

instance Eq Tableros

where Est(t1:_) == Est(t2:_) = heur1 t1 == heur1 t2

-- Un estado es menor o igual que otro si tiene una heurística menor o

-- igual.

instance Ord Tableros where

Est (t1:_) <= Est (t2:_) = heur1 t1 <= heur1 t2

-- (buscaPM_8P) es la lista de las soluciones del 8 puzzle por búsqueda

-- primero el mejor. Por ejemplo,

-- ghci> head buscaPM_8P

-- (Est [array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(3,1)),(6,(2,1)),(7,(1,1)),(8,(1,2))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(3,1)),(6,(2,2)),(7,(1,1)),(8,(1,2))],

-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,2))],

-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(3,1)),(6,(2,2)),(7,(2,1)),(8,(1,1))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(3,1)),(6,(1,2)),(7,(2,1)),(8,(1,1))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(3,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],

-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],

-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(2,1)),(6,(1,2)),(7,(2,2)),(8,(1,1))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(2,1)),(6,(1,2)),(7,(3,2)),(8,(1,1))],

-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,1))],

-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(2,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(1,1)),(6,(2,2)),(7,(3,2)),(8,(1,2))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(1,1)),(6,(2,1)),(7,(3,2)),(8,(1,2))],

-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))],

-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,1)),(6,(2,1)),(7,(2,2)),(8,(1,2))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))],

-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,2))],

-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(3,1)),(7,(2,2)),(8,(1,1))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(3,1)),(7,(1,2)),(8,(1,1))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,2)),(6,(3,1)),(7,(1,2)),(8,(1,1))],

-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],

-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(2,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(3,2)),(6,(2,1)),(7,(1,2)),(8,(1,1))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(1,1))],

-- array (0,8) [(0,(1,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(3,2)),(6,(2,2)),(7,(1,2)),(8,(2,1))],

-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(3,2)),(6,(2,2)),(7,(1,1)),(8,(2,1))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,1))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,1)),

-- (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))],

-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),

-- (5,(3,2)),(6,(1,2)),(7,(1,1)),(8,(2,2))],

-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),

-- (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(2,2))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,1)),

-- (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],

-- array (0,8) [(0,(2,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),

-- (5,(3,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],

-- array (0,8) [(0,(3,1)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),

-- (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,2))],

-- array (0,8) [(0,(3,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(2,2)),

-- (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))],

-- array (0,8) [(0,(2,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(1,2)),(7,(1,1)),(8,(3,1))],

-- array (0,8) [(0,(1,2)),(1,(1,3)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],

-- array (0,8) [(0,(1,3)),(1,(1,2)),(2,(2,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],

-- array (0,8) [(0,(2,3)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(2,2)),(7,(1,1)),(8,(3,1))],

-- array (0,8) [(0,(2,2)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,1)),(6,(2,3)),(7,(1,1)),(8,(3,1))],

-- array (0,8) [(0,(2,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,2)),(6,(2,3)),(7,(1,1)),(8,(3,1))],

-- array (0,8) [(0,(1,1)),(1,(1,2)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(1,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(2,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))],

-- array (0,8) [(0,(2,2)),(1,(1,1)),(2,(1,3)),(3,(3,3)),(4,(3,2)),

-- (5,(1,2)),(6,(2,3)),(7,(2,1)),(8,(3,1))]],

-- 78)

buscaPM_8P = buscaPM sucesores8P

esFinal8P

(Est [inicial8P])

Se puede imprimir o compartir con