Espacio de estados

Problema de las jarras (con espacios de estados)

PorJosé A. Alonso 9-septiembre-202317-mayo-2024

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en la jarra de A litros de capacidad.

Usando el procedimiento de búsqueda en anchura, definir la función

   jarras :: (Int,Int,Int) -> [[(Int,Int)]]

1	jarras :: (Int,Int,Int) -> [[(Int,Int)]]

tal jarras (a,b,c) es la lista de las soluciones del problema de las jarras (a,b,c). Por ejemplo,

   λ> take 3 (jarras (4,3,2))
   [[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],
    [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)],
    [(0,0),(0,3),(3,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

λ> take 3 (jarras (4,3,2))

[[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],

[(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)],

[(0,0),(0,3),(3,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

La interpretación [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)] es:

(0,0) se inicia con las dos jarras vacías,
(4,0) se llena la jarra de 4 con el grifo,
(1,3) se llena la de 3 con la de 4,
(1,0) se vacía la de 3,
(0,1) se pasa el contenido de la primera a la segunda,
(4,1) se llena la primera con el grifo,
(2,3) se llena la segunda con la primera.

Otros ejemplos

   λ> length (jarras (15,10,5))
   8
   λ> map length (jarras (15,10,5))
   [3,5,5,7,7,7,8,9]
   λ> jarras (15,10,4)
   []

λ> length (jarras (15,10,5))

λ> map length (jarras (15,10,5))

[3,5,5,7,7,7,8,9]

λ> jarras (15,10,4)

[]

Problema de suma cero (con espacios de estados)

PorJosé A. Alonso 4-septiembre-202317-mayo-2024

El problema de suma cero consiste en, dado el conjunto de enteros, encontrar sus subconjuntos no vacío cuyos elementos sumen cero.

Usando el procedimiento de búsqueda en profundidad, definir la función

   suma0 :: [Int] -> [[Int]]

1	suma0 :: [Int] -> [[Int]]

tal que suma0 ns es la lista de las soluciones del problema de suma cero para ns. Por ejemplo,

   λ> suma0 [-7,-3,-2,5,8]
   [[-3,-2,5]]
   λ> suma0 [-7,-3,-2,5,8,-1]
   [[-7,-3,-2,-1,5,8],[-7,-1,8],[-3,-2,5]]
   λ> suma0 [-7,-3,1,5,8]
   []

λ> suma0 [-7,-3,-2,5,8]

[[-3,-2,5]]

λ> suma0 [-7,-3,-2,5,8,-1]

[[-7,-3,-2,-1,5,8],[-7,-1,8],[-3,-2,5]]

λ> suma0 [-7,-3,1,5,8]

[]

El problema del dominó (con espacios de estados)

PorJosé A. Alonso 29-agosto-20231-octubre-2023

Las fichas del dominó se pueden representar por pares de enteros. El problema del dominó consiste en colocar todas las fichas de una lista dada de forma que el segundo número de cada ficha coincida con el primero de la siguiente.

Usando el procedimiento de búsqueda en profundidad, definir la función

   domino :: [(Int,Int)] -> [[(Int,Int)]]

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que domino fs es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   λ> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   λ> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   λ> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)],[(4,3),(3,2),(2,1)]]
   λ> domino [(1,2),(2,3),(5,4)]
   []

λ> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

λ> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

λ> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)],[(4,3),(3,2),(2,1)]]

λ> domino [(1,2),(2,3),(5,4)]

[]

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module El_problema_del_domino where

import BusquedaEnProfundidad (buscaProfundidad)
import Data.List (delete)
import Test.Hspec (Spec, hspec, it, shouldBe)

-- Las fichas son pares de números enteros.
type Ficha  = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar
type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas.
type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p. Por ejemplo,
--    λ> inicial [(1,2),(2,3),(1,4)]
--    ([(1,2),(2,3),(1,4)],[])
inicial :: Problema -> Estado
inicial p = (p,[])

-- (esFinal e) se verifica si e es un estado final. Por ejemplo,
--    λ> esFinal ([], [(4,1),(1,2),(2,3)])
--    True
--    λ> esFinal ([(2,3)], [(4,1),(1,2)])
--    False
esFinal :: Estado -> Bool
esFinal = null . fst

-- (sucesores e) es la lista de los sucesores del estado e. Por ejemplo,
--    λ> sucesores ([(1,2),(2,3),(1,4)],[])
--    [([(2,3),(1,4)],[(1,2)]),
--     ([(1,2),(1,4)],[(2,3)]),
--     ([(1,2),(2,3)],[(1,4)]),
--     ([(2,3),(1,4)],[(2,1)]),
--     ([(1,2),(1,4)],[(3,2)]),
--     ([(1,2),(2,3)],[(4,1)])]
--    λ> sucesores ([(2,3),(1,4)],[(1,2)])
--    [([(2,3)],[(4,1),(1,2)])]
--    λ> sucesores ([(2,3),(1,4)],[(2,1)])
--    [([(1,4)],[(3,2),(2,1)])]
sucesores :: Estado -> [Estado]
sucesores (fs,[]) =
  [(delete (a,b) fs, [(a,b)]) | (a,b) <- fs, a /= b] ++
  [(delete (a,b) fs, [(b,a)]) | (a,b) <- fs]
sucesores (fs,e@((x,_):_)) =
  [(delete (u,v) fs,(u,v):e) | (u,v) <- fs, u /= v, v == x] ++
  [(delete (u,v) fs,(v,u):e) | (u,v) <- fs, u /= v, u == x] ++
  [(delete (u,v) fs,(u,v):e) | (u,v) <- fs, u == v, u == x]

-- (soluciones p) es la lista de las soluciones del problema p. Por
-- ejemplo,
--    λ> soluciones [(1,2),(2,3),(1,4)]
--    [([],[(4,1),(1,2),(2,3)]),([],[(3,2),(2,1),(1,4)])]
soluciones :: Problema -> [Estado]
soluciones p = buscaProfundidad sucesores esFinal (inicial p)

domino :: Problema -> [[Ficha]]
domino p = map snd (soluciones p)

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    domino [(1,2),(2,3),(1,4)] `shouldBe`
    [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
  it "e2" $
    domino [(1,2),(1,1),(1,4)] `shouldBe`
    [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
  it "e3" $
    domino [(1,2),(3,4),(2,3)] `shouldBe`
    [[(1,2),(2,3),(3,4)],[(4,3),(3,2),(2,1)]]
  it "e4" $
    domino [(1,2),(2,3),(5,4)] `shouldBe`
    []

-- La verificación es
--    λ> verifica
--
--    e1
--    e2
--    e3
--    e4
--
--    Finished in 0.0013 seconds
--    4 examples, 0 failures

module El_problema_del_domino where

import BusquedaEnProfundidad (buscaProfundidad)

import Data.List (delete)

import Test.Hspec (Spec, hspec, it, shouldBe)

-- Las fichas son pares de números enteros.

type Ficha = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar

type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p. Por ejemplo,

-- λ> inicial [(1,2),(2,3),(1,4)]

-- ([(1,2),(2,3),(1,4)],[])

inicial :: Problema -> Estado

inicial p = (p,[])

-- (esFinal e) se verifica si e es un estado final. Por ejemplo,

-- λ> esFinal ([], [(4,1),(1,2),(2,3)])

-- True

-- λ> esFinal ([(2,3)], [(4,1),(1,2)])

-- False

esFinal :: Estado -> Bool

esFinal = null . fst

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

-- λ> sucesores ([(1,2),(2,3),(1,4)],[])

-- [([(2,3),(1,4)],[(1,2)]),

-- ([(1,2),(1,4)],[(2,3)]),

-- ([(1,2),(2,3)],[(1,4)]),

-- ([(2,3),(1,4)],[(2,1)]),

-- ([(1,2),(1,4)],[(3,2)]),

-- ([(1,2),(2,3)],[(4,1)])]

-- λ> sucesores ([(2,3),(1,4)],[(1,2)])

-- [([(2,3)],[(4,1),(1,2)])]

-- λ> sucesores ([(2,3),(1,4)],[(2,1)])

-- [([(1,4)],[(3,2),(2,1)])]

sucesores :: Estado -> [Estado]

sucesores (fs,[]) =

[(delete (a,b) fs, [(a,b)]) | (a,b) <- fs, a /= b] ++

[(delete (a,b) fs, [(b,a)]) | (a,b) <- fs]

sucesores (fs,e@((x,_):_)) =

[(delete (u,v) fs,(u,v):e) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):e) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):e) | (u,v) <- fs, u == v, u == x]

-- (soluciones p) es la lista de las soluciones del problema p. Por

-- ejemplo,

-- λ> soluciones [(1,2),(2,3),(1,4)]

-- [([],[(4,1),(1,2),(2,3)]),([],[(3,2),(2,1),(1,4)])]

soluciones :: Problema -> [Estado]

soluciones p = buscaProfundidad sucesores esFinal (inicial p)

domino :: Problema -> [[Ficha]]

domino p = map snd (soluciones p)

-- Verificación

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

verifica :: IO ()

verifica = hspec spec

spec :: Spec

spec = do

it "e1" $

domino [(1,2),(2,3),(1,4)] `shouldBe`

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

it "e2" $

domino [(1,2),(1,1),(1,4)] `shouldBe`

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

it "e3" $

domino [(1,2),(3,4),(2,3)] `shouldBe`

[[(1,2),(2,3),(3,4)],[(4,3),(3,2),(2,1)]]

it "e4" $

domino [(1,2),(2,3),(5,4)] `shouldBe`

[]

-- La verificación es

-- λ> verifica

-- e1

-- e2

-- e3

-- e4

-- Finished in 0.0013 seconds

-- 4 examples, 0 failures

Soluciones en Python

from src.BusquedaEnProfundidad import buscaProfundidad

# Las fichas son pares de números enteros.
Ficha  = tuple[int, int]

# Un problema está definido por la lista de fichas que hay que colocar
Problema = list[Ficha]

# Los estados son los pares formados por la listas sin colocar y las
# colocadas.
Estado = tuple[list[Ficha], list[Ficha]]

# inicial(p) es el estado inicial del problema p. Por ejemplo,
#    >>> inicial([(1,2),(2,3),(1,4)])
#    ([(1, 2), (2, 3), (1, 4)], [])
def inicial(p: Problema) -> Estado:
    return (p, [])

# esFinal(e) se verifica si e es un estado final. Por ejemplo,
#    >>> esFinal(([], [(4,1),(1,2),(2,3)]))
#    True
#    >>> esFinal(([(2,3)], [(4,1),(1,2)]))
#    False
def esFinal(e: Estado) -> bool:
    return not e[0]

# elimina(f, fs) es la lista obtenida eliminando la ficha f de la lista
# fs. Por ejemplo,
#    >>> elimina((1,2),[(4,1),(1,2),(2,3)])
#    [(4, 1), (2, 3)]
def elimina(f: Ficha, fs: list[Ficha]) -> list[Ficha]:
    return [g for g in fs if g != f]

# sucesores(e) es la lista de los sucesores del estado e. Por ejemplo,
#    >>> sucesores(([(1,2),(2,3),(1,4)],[]))
#    [([(2,3),(1,4)],[(1,2)]),
#     ([(1,2),(1,4)],[(2,3)]),
#     ([(1,2),(2,3)],[(1,4)]),
#     ([(2,3),(1,4)],[(2,1)]),
#     ([(1,2),(1,4)],[(3,2)]),
#     ([(1,2),(2,3)],[(4,1)])]
#    >>> sucesores(([(2,3),(1,4)],[(1,2)]))
#    [([(2,3)],[(4,1),(1,2)])]
#    >>> sucesores(([(2,3),(1,4)],[(2,1)]))
#    [([(1,4)],[(3,2),(2,1)])]
def sucesores(e: Estado) -> list[Estado]:
    if not e[1]:
        return [(elimina((a,b), e[0]), [(a,b)]) for (a,b) in e[0] if a != b] + \
               [(elimina((a,b), e[0]), [(b,a)]) for (a,b) in e[0]]
    return [(elimina((u,v),e[0]),[(u,v)]+e[1]) for (u,v) in e[0] if u != v and v == e[1][0][0]] +\
           [(elimina((u,v),e[0]),[(v,u)]+e[1]) for (u,v) in e[0] if u != v and u == e[1][0][0]] +\
           [(elimina((u,v),e[0]),[(u,v)]+e[1]) for (u,v) in e[0] if u == v and u == e[1][0][0]]

# soluciones(p) es la lista de las soluciones del problema p. Por
# ejemplo,
#    >>> soluciones([(1,2),(2,3),(1,4)])
#    [([], [(3, 2), (2, 1), (1, 4)]), ([], [(4, 1), (1, 2), (2, 3)])]
def soluciones(p: Problema) -> list[Estado]:
    return buscaProfundidad(sucesores, esFinal, inicial(p))

def domino(p: Problema) -> list[list[Ficha]]:
    return [s[1] for s in soluciones(p)]

# # Verificación
# # ============

def test_domino() -> None:
    assert domino([(1,2),(2,3),(1,4)]) == \
        [[(3, 2), (2, 1), (1, 4)], [(4, 1), (1, 2), (2, 3)]]
    assert domino([(1,2),(1,1),(1,4)]) == \
        [[(2, 1), (1, 1), (1, 4)], [(4, 1), (1, 1), (1, 2)]]
    assert domino([(1,2),(3,4),(2,3)]) == \
        [[(4, 3), (3, 2), (2, 1)], [(1, 2), (2, 3), (3, 4)]]
    assert domino([(1,2),(2,3),(5,4)]) == \
        []
    print("Verificado")

# La verificación es
#    >>> test_domino()
#    Verificado

from src.BusquedaEnProfundidad import buscaProfundidad

# Las fichas son pares de números enteros.

Ficha = tuple[int, int]

# Un problema está definido por la lista de fichas que hay que colocar

Problema = list[Ficha]

# Los estados son los pares formados por la listas sin colocar y las

# colocadas.

Estado = tuple[list[Ficha], list[Ficha]]

# inicial(p) es el estado inicial del problema p. Por ejemplo,

# >>> inicial([(1,2),(2,3),(1,4)])

# ([(1, 2), (2, 3), (1, 4)], [])

def inicial(p: Problema) -> Estado:

return (p, [])

# esFinal(e) se verifica si e es un estado final. Por ejemplo,

# >>> esFinal(([], [(4,1),(1,2),(2,3)]))

# True

# >>> esFinal(([(2,3)], [(4,1),(1,2)]))

# False

def esFinal(e: Estado) -> bool:

return not e[0]

# elimina(f, fs) es la lista obtenida eliminando la ficha f de la lista

# fs. Por ejemplo,

# >>> elimina((1,2),[(4,1),(1,2),(2,3)])

# [(4, 1), (2, 3)]

def elimina(f: Ficha, fs: list[Ficha]) -> list[Ficha]:

return [g for g in fs if g != f]

# sucesores(e) es la lista de los sucesores del estado e. Por ejemplo,

# >>> sucesores(([(1,2),(2,3),(1,4)],[]))

# [([(2,3),(1,4)],[(1,2)]),

# ([(1,2),(1,4)],[(2,3)]),

# ([(1,2),(2,3)],[(1,4)]),

# ([(2,3),(1,4)],[(2,1)]),

# ([(1,2),(1,4)],[(3,2)]),

# ([(1,2),(2,3)],[(4,1)])]

# >>> sucesores(([(2,3),(1,4)],[(1,2)]))

# [([(2,3)],[(4,1),(1,2)])]

# >>> sucesores(([(2,3),(1,4)],[(2,1)]))

# [([(1,4)],[(3,2),(2,1)])]

def sucesores(e: Estado) -> list[Estado]:

if not e[1]:

return [(elimina((a,b), e[0]), [(a,b)]) for (a,b) in e[0] if a != b] + \

[(elimina((a,b), e[0]), [(b,a)]) for (a,b) in e[0]]

return [(elimina((u,v),e[0]),[(u,v)]+e[1]) for (u,v) in e[0] if u != v and v == e[1][0][0]] +\

[(elimina((u,v),e[0]),[(v,u)]+e[1]) for (u,v) in e[0] if u != v and u == e[1][0][0]] +\

[(elimina((u,v),e[0]),[(u,v)]+e[1]) for (u,v) in e[0] if u == v and u == e[1][0][0]]

# soluciones(p) es la lista de las soluciones del problema p. Por

# ejemplo,

# >>> soluciones([(1,2),(2,3),(1,4)])

# [([], [(3, 2), (2, 1), (1, 4)]), ([], [(4, 1), (1, 2), (2, 3)])]

def soluciones(p: Problema) -> list[Estado]:

return buscaProfundidad(sucesores, esFinal, inicial(p))

def domino(p: Problema) -> list[list[Ficha]]:

return [s[1] for s in soluciones(p)]

# # Verificación

# # ============

def test_domino() -> None:

assert domino([(1,2),(2,3),(1,4)]) == \

[[(3, 2), (2, 1), (1, 4)], [(4, 1), (1, 2), (2, 3)]]

assert domino([(1,2),(1,1),(1,4)]) == \

[[(2, 1), (1, 1), (1, 4)], [(4, 1), (1, 1), (1, 2)]]

assert domino([(1,2),(3,4),(2,3)]) == \

[[(4, 3), (3, 2), (2, 1)], [(1, 2), (2, 3), (3, 4)]]

assert domino([(1,2),(2,3),(5,4)]) == \

[]

print("Verificado")

# La verificación es

# >>> test_domino()

# Verificado

El problema del calendario mediante búsqueda en espacio de estado

PorJosé A. Alonso 24-agosto-20239-agosto-2023

El problema del calendario, para una competición deportiva en la que se enfrentan n participantes, consiste en elaborar un calendario de forma que:

el campeonato dure n-1 días,
cada participante juegue exactamente un partido diario y
cada participante juegue exactamente una vez con cada adversario.

Por ejemplo, con 8 participantes una posible solución es

     | 1 2 3 4 5 6 7
   --+--------------
   1 | 2 3 4 5 6 7 8
   2 | 1 4 3 6 5 8 7
   3 | 4 1 2 7 8 5 6
   4 | 3 2 1 8 7 6 5
   5 | 6 7 8 1 2 3 4
   6 | 5 8 7 2 1 4 3
   7 | 8 5 6 3 4 1 2
   8 | 7 6 5 4 3 2 1

| 1 2 3 4 5 6 7

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

1 | 2 3 4 5 6 7 8

2 | 1 4 3 6 5 8 7

3 | 4 1 2 7 8 5 6

4 | 3 2 1 8 7 6 5

5 | 6 7 8 1 2 3 4

6 | 5 8 7 2 1 4 3

7 | 8 5 6 3 4 1 2

8 | 7 6 5 4 3 2 1

donde las filas indican los jugadores y las columnas los días; es decir, el elemento (i,j) indica el adversario del jugador i el día j; por ejemplo, el adversario del jugador 2 el 4ª día es el jugador 6.

Para representar el problema se define el tipo Calendario como matrices de enteros,

Usando el procedimiento de búsqueda en profundidad, definir la función

   calendario :: Int -> [Calendario]

1	calendario :: Int -> [Calendario]

tal que calendario n son las soluciones del problema del calendario, con n participantes, mediante el patrón de búsqueda em profundidad. Por ejemplo,

   λ> head (calendario 6)
   ┌           ┐
   │ 2 3 4 5 6 │
   │ 1 4 5 6 3 │
   │ 5 1 6 4 2 │
   │ 6 2 1 3 5 │
   │ 3 6 2 1 4 │
   │ 4 5 3 2 1 │
   └           ┘

   λ> length (calendario 6)
   720
   λ> length (calendario 5)
   0

λ> head (calendario 6)

┌ ┐

│ 2 3 4 5 6 │

│ 1 4 5 6 3 │

│ 5 1 6 4 2 │

│ 6 2 1 3 5 │

│ 3 6 2 1 4 │

│ 4 5 3 2 1 │

└ ┘

λ> length (calendario 6)

720

λ> length (calendario 5)

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module El_problema_del_calendario_mediante_busqueda_en_espacio_de_estado where

import BusquedaEnProfundidad (buscaProfundidad)
import Data.Matrix (Matrix, (!), nrows, zero, setElem, toLists)
import Data.List ((\\))
import Test.Hspec (Spec, hspec, it, shouldBe)

type Calendario = Matrix Int

-- (inicial n) es el estado inicial para el problema del calendario con
-- n participantes; es decir, una matriz de n fila y n-1 columnas con
-- todos sus elementos iguales a 0. Por ejemplo,
--    λ> inicial 4
--    ┌       ┐
--    │ 0 0 0 │
--    │ 0 0 0 │
--    │ 0 0 0 │
--    │ 0 0 0 │
--    └       ┘
inicial :: Int -> Calendario
inicial n = zero n (n-1)

-- (huecos c) es la lista de las posiciones de c cuyo valor es 0.
huecos :: Calendario -> [(Int, Int)]
huecos c = [(i,j) | i <- [1..n], j <- [1..n-1], c!(i,j) == 0]
  where n = nrows c

-- (sucesores c) es la lista de calendarios obtenidos poniendo en el
-- lugar del primer elemento nulo de c uno de los posibles jugadores de
-- forma que se cumplan las condiciones del problema. Por ejemplo,
--    λ> sucesores (inicial 4)
--    [┌       ┐  ┌       ┐  ┌       ┐
--     │ 2 0 0 │  │ 3 0 0 │  │ 4 0 0 │
--     │ 1 0 0 │  │ 0 0 0 │  │ 0 0 0 │
--     │ 0 0 0 │  │ 1 0 0 │  │ 0 0 0 │
--     │ 0 0 0 │  │ 0 0 0 │  │ 1 0 0 │
--     └       ┘, └       ┘, └       ┘]
--    λ> sucesores (fromLists [[2,3,0],[1,0,0],[0,1,0],[0,0,0]])
--    [┌       ┐
--     │ 2 3 4 │
--     │ 1 0 0 │
--     │ 0 1 0 │
--     │ 0 0 1 │
--     └       ┘]
--    λ> sucesores (fromLists [[2,3,4],[1,0,0],[0,1,0],[0,0,1]])
--    [┌       ┐
--     │ 2 3 4 │
--     │ 1 4 0 │
--     │ 0 1 0 │
--     │ 0 2 1 │
--     └       ┘]
sucesores :: Calendario -> [Calendario]
sucesores c =
  [setElem i (k,j) (setElem k (i,j) c) |
   k <- [1..n] \\ (i : [c!(k,j) | k <- [1..i-1]] ++
                       [c!(i,k) | k <- [1..j-1]]),
   c!(k,j) == 0]
  where
    n = nrows c
    (i,j) = head (huecos c)

-- (esFinal c) se verifica si c un estado final para el problema
-- del calendario con n participantes; es decir, no queda en c ningún
-- elemento igual a 0. Por ejemplo,
--    λ> esFinal (fromLists [[2,3,4],[1,4,3],[4,1,2],[3,2,1]])
--    True
--    λ> esFinal (fromLists [[2,3,4],[1,4,3],[4,1,2],[3,2,0]])
--    False
esFinal :: Calendario -> Bool
esFinal c = null (huecos c)

calendario :: Int -> [Calendario]
calendario n = buscaProfundidad sucesores esFinal (inicial n)

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    toLists (head (calendario 6)) `shouldBe`
    [[2,3,4,5,6],[1,4,5,6,3],[5,1,6,4,2],[6,2,1,3,5],[3,6,2,1,4],[4,5,3,2,1]]
  it "e2" $
    length (calendario 6) `shouldBe` 720
  it "e3" $
    length (calendario 5) `shouldBe` 0

-- La verificación es
--    λ> verifica
--
--    e1
--    e2
--    e3
--
--    Finished in 0.2580 seconds
--    3 examples, 0 failures

module El_problema_del_calendario_mediante_busqueda_en_espacio_de_estado where

import BusquedaEnProfundidad (buscaProfundidad)

import Data.Matrix (Matrix, (!), nrows, zero, setElem, toLists)

import Data.List ((\\))

import Test.Hspec (Spec, hspec, it, shouldBe)

type Calendario = Matrix Int

-- (inicial n) es el estado inicial para el problema del calendario con

-- n participantes; es decir, una matriz de n fila y n-1 columnas con

-- todos sus elementos iguales a 0. Por ejemplo,

-- λ> inicial 4

-- ┌ ┐

-- │ 0 0 0 │

-- └ ┘

inicial :: Int -> Calendario

inicial n = zero n (n-1)

-- (huecos c) es la lista de las posiciones de c cuyo valor es 0.

huecos :: Calendario -> [(Int, Int)]

huecos c = [(i,j) | i <- [1..n], j <- [1..n-1], c!(i,j) == 0]

where n = nrows c

-- (sucesores c) es la lista de calendarios obtenidos poniendo en el

-- lugar del primer elemento nulo de c uno de los posibles jugadores de

-- forma que se cumplan las condiciones del problema. Por ejemplo,

-- λ> sucesores (inicial 4)

-- [┌ ┐ ┌ ┐ ┌ ┐

-- │ 2 0 0 │ │ 3 0 0 │ │ 4 0 0 │

-- │ 1 0 0 │ │ 0 0 0 │ │ 0 0 0 │

-- │ 0 0 0 │ │ 1 0 0 │ │ 0 0 0 │

-- │ 0 0 0 │ │ 0 0 0 │ │ 1 0 0 │

-- └ ┘, └ ┘, └ ┘]

-- λ> sucesores (fromLists [[2,3,0],[1,0,0],[0,1,0],[0,0,0]])

-- [┌ ┐

-- │ 2 3 4 │

-- │ 1 0 0 │

-- │ 0 1 0 │

-- │ 0 0 1 │

-- └ ┘]

-- λ> sucesores (fromLists [[2,3,4],[1,0,0],[0,1,0],[0,0,1]])

-- [┌ ┐

-- │ 2 3 4 │

-- │ 1 4 0 │

-- │ 0 1 0 │

-- │ 0 2 1 │

-- └ ┘]

sucesores :: Calendario -> [Calendario]

sucesores c =

[setElem i (k,j) (setElem k (i,j) c) |

k <- [1..n] \\ (i : [c!(k,j) | k <- [1..i-1]] ++

[c!(i,k) | k <- [1..j-1]]),

c!(k,j) == 0]

where

n = nrows c

(i,j) = head (huecos c)

-- (esFinal c) se verifica si c un estado final para el problema

-- del calendario con n participantes; es decir, no queda en c ningún

-- elemento igual a 0. Por ejemplo,

-- λ> esFinal (fromLists [[2,3,4],[1,4,3],[4,1,2],[3,2,1]])

-- True

-- λ> esFinal (fromLists [[2,3,4],[1,4,3],[4,1,2],[3,2,0]])

-- False

esFinal :: Calendario -> Bool

esFinal c = null (huecos c)

calendario :: Int -> [Calendario]

calendario n = buscaProfundidad sucesores esFinal (inicial n)

-- Verificación

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

verifica :: IO ()

verifica = hspec spec

spec :: Spec

spec = do

it "e1" $

toLists (head (calendario 6)) `shouldBe`

[[2,3,4,5,6],[1,4,5,6,3],[5,1,6,4,2],[6,2,1,3,5],[3,6,2,1,4],[4,5,3,2,1]]

it "e2" $

length (calendario 6) `shouldBe` 720

it "e3" $

length (calendario 5) `shouldBe` 0

-- La verificación es

-- λ> verifica

-- e1

-- e2

-- e3

-- Finished in 0.2580 seconds

-- 3 examples, 0 failures

Soluciones en Python

from copy import deepcopy
from typing import Optional

import numpy as np
import numpy.typing as npt

from src.BusquedaEnProfundidad import buscaProfundidad

Calendario = npt.NDArray[np.complex64]

# inicial(n) es el estado inicial para el problema del calendario con
# n participantes; es decir, una matriz de n fila y n-1 columnas con
# todos sus elementos iguales a 0. Por ejemplo,
#    >>> inicial(4)
#    array([[0, 0, 0],
#           [0, 0, 0],
#           [0, 0, 0],
#           [0, 0, 0]])
def inicial(n: int) -> Calendario:
    return np.zeros((n, n - 1), dtype=int)

# primerHueco(c) es la posición del primer elemento cuyo valor es 0. Si
# todos los valores son distintos de 0, devuelve (-1,-1). Por ejemplo,
#    primerHueco(np.array([[1,2,3],[4,5,0],[7,0,0]])) == (1, 2)
#    primerHueco(np.array([[1,2,3],[4,5,6],[7,8,0]])) == (2, 2)
#    primerHueco(np.array([[1,2,3],[4,5,6],[7,8,9]])) == (-1, -1)
def primerHueco(c: Calendario) -> tuple[int, int]:
    (n, m) = c.shape
    for i in range(0, n):
        for j in range(0, m):
            if c[i,j] == 0:
                return (i, j)
    return (-1, -1)

# libres(c, i, j) es la lista de valores que que pueden poner en la
# posición (i,j) del calendario c. Por ejemplo,
#    libres(np.array([[0,0,0],[0,0,0],[0,0,0],[0,0,0]]),0,0) == [2, 3, 4]
#    libres(np.array([[2,0,0],[1,0,0],[0,0,0],[0,0,0]]),0,1) == [3, 4]
#    libres(np.array([[2,3,0],[1,0,0],[0,1,0],[0,0,0]]),0,2) == [4]
#    libres(np.array([[2,3,4],[1,0,0],[0,1,0],[0,0,1]]),1,1) == [4]
#    libres(np.array([[2,3,4],[1,4,0],[0,1,0],[0,2,1]]),1,2) == [3]
def libres(c: Calendario, i: int, j: int) -> list[int]:
    n = c.shape[0]
    return list(set(range(1, n + 1))
                - {i + 1}
                - set(c[i])
                - set(c[:,j]))

# setElem(k, i, j, c) es el calendario obtenido colocando en c el valor
# k en la posición (i,j).
#    >>> setElem(7,1,2,np.array([[1,2,3],[4,5,0],[0,0,0]]))
#    array([[1, 2, 3],
#           [4, 5, 7],
#           [0, 0, 0]])
def setElem(k: int, i: int, j: int, c: Calendario) -> Calendario:
    _c = deepcopy(c)
    _c[i, j] = k
    return _c

# sucesores(c) es la lista de calendarios obtenidos poniendo en el
# lugar del primer elemento nulo de c uno de los posibles jugadores de
# forma que se cumplan las condiciones del problema. Por ejemplo,
#    >>> sucesores(np.array([[0,0,0],[0,0,0],[0,0,0],[0,0,0]]))
#    [array([[2,0,0], [1,0,0], [0,0,0], [0,0,0]]),
#     array([[3,0,0], [0,0,0], [1,0,0], [0,0,0]]),
#     array([[4,0,0], [0,0,0], [0,0,0], [1,0,0]])]
#    >>> sucesores(np.array([[2,0,0],[1,0,0],[0,0,0],[0,0,0]]))
#    [array([[2,3,0], [1,0,0], [0,1,0], [0,0,0]]),
#     array([[2,4,0], [1,0,0], [0,0,0], [0,1,0]])]
#    >>> sucesores(np.array([[2,3,0],[1,0,0],[0,1,0],[0,0,0]]))
#    [array([[2,3,4], [1,0,0], [0,1,0], [0,0,1]])]
#    >>> sucesores(np.array([[2,3,4],[1,0,0],[0,1,0],[0,0,1]]))
#    [array([[2,3,4], [1,4,0], [0,1,0], [0,2,1]])]
#    >>> sucesores(np.array([[2,3,4],[1,4,0],[0,1,0],[0,2,1]]))
#    [array([[2,3,4], [1,4,3], [0,1,2], [0,2,1]])]
#    >>> sucesores(np.array([[2,3,4],[1,4,3],[0,1,2],[0,2,1]]))
#    [array([[2,3,4], [1,4,3], [4,1,2], [3,2,1]])]
#    >>> sucesores(np.array([[2,3,4],[1,4,3],[4,1,2],[3,2,1]]))
#    []
def sucesores(c: Calendario) -> list[Calendario]:
    n = c.shape[0]
    (i, j) = primerHueco(c)
    return [setElem(i+1, k-1, j, setElem(k, i, j, c))
            for k in libres(c, i, j)]

# esFinal(c) se verifica si c un estado final para el problema
# del calendario con n participantes; es decir, no queda en c ningún
# elemento igual a 0. Por ejemplo,
#    >>> esFinal(np.array([[2,3,4],[1,4,3],[4,1,2],[3,2,1]]))
#    True
#    >>> esFinal(np.array([[2,3,4],[1,4,3],[4,1,2],[3,2,0]]))
#    False
def esFinal(c: Calendario) -> bool:
    return primerHueco(c) == (-1, -1)

def calendario(n: int) -> list[Calendario]:
    return buscaProfundidad(sucesores, esFinal, inicial(n))

# Verificación
# ============

def test_calendario() -> None:
    def filas(p: Calendario) -> list[list[int]]:
        return p.tolist()

    assert filas(calendario(6)[0]) == \
        [[6, 5, 4, 3, 2],
         [5, 4, 3, 6, 1],
         [4, 6, 2, 1, 5],
         [3, 2, 1, 5, 6],
         [2, 1, 6, 4, 3],
         [1, 3, 5, 2, 4]]
    assert len(calendario(6)) == 720
    assert len(calendario(5)) == 0
    print("Verificado")

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

from copy import deepcopy

from typing import Optional

import numpy as np

import numpy.typing as npt

from src.BusquedaEnProfundidad import buscaProfundidad

Calendario = npt.NDArray[np.complex64]

# inicial(n) es el estado inicial para el problema del calendario con

# n participantes; es decir, una matriz de n fila y n-1 columnas con

# todos sus elementos iguales a 0. Por ejemplo,

# >>> inicial(4)

# array([[0, 0, 0],

# [0, 0, 0],

# [0, 0, 0]])

def inicial(n: int) -> Calendario:

return np.zeros((n, n - 1), dtype=int)

# primerHueco(c) es la posición del primer elemento cuyo valor es 0. Si

# todos los valores son distintos de 0, devuelve (-1,-1). Por ejemplo,

# primerHueco(np.array([[1,2,3],[4,5,0],[7,0,0]])) == (1, 2)

# primerHueco(np.array([[1,2,3],[4,5,6],[7,8,0]])) == (2, 2)

# primerHueco(np.array([[1,2,3],[4,5,6],[7,8,9]])) == (-1, -1)

def primerHueco(c: Calendario) -> tuple[int, int]:

(n, m) = c.shape

for i in range(0, n):

for j in range(0, m):

if c[i,j] == 0:

return (i, j)

return (-1, -1)

# libres(c, i, j) es la lista de valores que que pueden poner en la

# posición (i,j) del calendario c. Por ejemplo,

# libres(np.array([[0,0,0],[0,0,0],[0,0,0],[0,0,0]]),0,0) == [2, 3, 4]

# libres(np.array([[2,0,0],[1,0,0],[0,0,0],[0,0,0]]),0,1) == [3, 4]

# libres(np.array([[2,3,0],[1,0,0],[0,1,0],[0,0,0]]),0,2) == [4]

# libres(np.array([[2,3,4],[1,0,0],[0,1,0],[0,0,1]]),1,1) == [4]

# libres(np.array([[2,3,4],[1,4,0],[0,1,0],[0,2,1]]),1,2) == [3]

def libres(c: Calendario, i: int, j: int) -> list[int]:

n = c.shape[0]

return list(set(range(1, n + 1))

- {i + 1}

- set(c[i])

- set(c[:,j]))

# setElem(k, i, j, c) es el calendario obtenido colocando en c el valor

# k en la posición (i,j).

# >>> setElem(7,1,2,np.array([[1,2,3],[4,5,0],[0,0,0]]))

# array([[1, 2, 3],

# [4, 5, 7],

# [0, 0, 0]])

def setElem(k: int, i: int, j: int, c: Calendario) -> Calendario:

_c = deepcopy(c)

_c[i, j] = k

return _c

# sucesores(c) es la lista de calendarios obtenidos poniendo en el

# lugar del primer elemento nulo de c uno de los posibles jugadores de

# forma que se cumplan las condiciones del problema. Por ejemplo,

# >>> sucesores(np.array([[0,0,0],[0,0,0],[0,0,0],[0,0,0]]))

# [array([[2,0,0], [1,0,0], [0,0,0], [0,0,0]]),

# array([[3,0,0], [0,0,0], [1,0,0], [0,0,0]]),

# array([[4,0,0], [0,0,0], [0,0,0], [1,0,0]])]

# >>> sucesores(np.array([[2,0,0],[1,0,0],[0,0,0],[0,0,0]]))

# [array([[2,3,0], [1,0,0], [0,1,0], [0,0,0]]),

# array([[2,4,0], [1,0,0], [0,0,0], [0,1,0]])]

# >>> sucesores(np.array([[2,3,0],[1,0,0],[0,1,0],[0,0,0]]))

# [array([[2,3,4], [1,0,0], [0,1,0], [0,0,1]])]

# >>> sucesores(np.array([[2,3,4],[1,0,0],[0,1,0],[0,0,1]]))

# [array([[2,3,4], [1,4,0], [0,1,0], [0,2,1]])]

# >>> sucesores(np.array([[2,3,4],[1,4,0],[0,1,0],[0,2,1]]))

# [array([[2,3,4], [1,4,3], [0,1,2], [0,2,1]])]

# >>> sucesores(np.array([[2,3,4],[1,4,3],[0,1,2],[0,2,1]]))

# [array([[2,3,4], [1,4,3], [4,1,2], [3,2,1]])]

# >>> sucesores(np.array([[2,3,4],[1,4,3],[4,1,2],[3,2,1]]))

# []

def sucesores(c: Calendario) -> list[Calendario]:

n = c.shape[0]

(i, j) = primerHueco(c)

return [setElem(i+1, k-1, j, setElem(k, i, j, c))

for k in libres(c, i, j)]

# esFinal(c) se verifica si c un estado final para el problema

# del calendario con n participantes; es decir, no queda en c ningún

# elemento igual a 0. Por ejemplo,

# >>> esFinal(np.array([[2,3,4],[1,4,3],[4,1,2],[3,2,1]]))

# True

# >>> esFinal(np.array([[2,3,4],[1,4,3],[4,1,2],[3,2,0]]))

# False

def esFinal(c: Calendario) -> bool:

return primerHueco(c) == (-1, -1)

def calendario(n: int) -> list[Calendario]:

return buscaProfundidad(sucesores, esFinal, inicial(n))

# Verificación

# ============

def test_calendario() -> None:

def filas(p: Calendario) -> list[list[int]]:

return p.tolist()

assert filas(calendario(6)[0]) == \

[[6, 5, 4, 3, 2],

[5, 4, 3, 6, 1],

[4, 6, 2, 1, 5],

[3, 2, 1, 5, 6],

[2, 1, 6, 4, 3],

[1, 3, 5, 2, 4]]

assert len(calendario(6)) == 720

assert len(calendario(5)) == 0

print("Verificado")

El problema de las fichas mediante búsqueda en espacio de estado

PorJosé A. Alonso 19-agosto-20235-agosto-2023

Para el problema de las fichas de orden (m,n) se considera un tablero con m+n+1 cuadrados consecutivos.

Inicialmente, en cada uno de los m primeros cuadrados hay una blanca, a continuación un hueco y en cada uno de los n últimos cuadrados hay una ficha verde. El objetivo consiste en tener las fichas verdes al principio y las blancas al final.

Por ejemplo, en el problema de las fichas de orden (3,3) el tablero inicial es

      +---+---+---+---+---+---+---+
      | B | B | B |   | V | V | V |
      +---+---+---+---+---+---+---+

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

| B | B | B | | V | V | V |

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

y el final es

      +---+---+---+---+---+---+---+
      | V | V | V |   | B | B | B |
      +---+---+---+---+---+---+---+

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

| V | V | V | | B | B | B |

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

Los movimientos permitidos consisten en desplazar una ficha al hueco saltando, como máximo, sobre otras dos.

Para representar el problema se definen los siguientes tipos de datos:

Ficha con tres constructores B, V y H que representan las fichas blanca, verde y hueco, respectivamente.

     data Ficha = B | V | H
       deriving (Eq, Show)

1 2	data Ficha = B \| V \| H deriving (Eq, Show)

Tablero que es una lista de fichas que representa las fichas colocadas en el tablero.

     type Tablero = [Ficha]

1	type Tablero = [Ficha]

Estado representa los estados del espacio de búsqueda, donde un estado es una lista de tableros [t(n), …, t(2), t(1)] tal que t(1) es el tablero inicial y para cada i (2 <= i <= n), t(i) es un sucesor de t(i-1).

     newtype Estado = E [Tablero]
       deriving (Eq, Show)

1 2	newtype Estado = E [Tablero] deriving (Eq, Show)

Busqueda es un procedimiento de búsqueda

     type Busqueda = (Estado -> [Estado]) ->
                     (Estado -> Bool) ->
                     Estado ->
                     [Estado]

type Busqueda = (Estado -> [Estado]) ->

(Estado -> Bool) ->

Estado ->

[Estado]

Además, se considera la heurística que para cada tablero vale la suma de piezas blancas situadas a la izquierda de cada una de las piezas verdes. Por ejemplo, para el estado

      +---+---+---+---+---+---+---+
      | B | V | B |   | V | V | B |
      +---+---+---+---+---+---+---+

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

| B | V | B | | V | V | B |

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

su valor es 1+2+2 = 5. La heurística de un estado es la del primero de sus tableros.

Usando los métodos de búsqueda estudiado en los ejercicios anteriores, definir la función

   fichas :: Busqueda -> Int -> Int -> [[Tablero]]

1	fichas :: Busqueda -> Int -> Int -> [[Tablero]]

tal que fichas b m n es la lista de las soluciones del problema de las fichas de orden (m,n) obtenidas mediante el procedimiento de búsqueda b. Por ejemplo,

   λ> head (fichas buscaProfundidad 2 2)
   [[B,B,H,V,V],[B,H,B,V,V],[H,B,B,V,V],[V,B,B,H,V],[V,B,H,B,V],[V,H,B,B,V],
    [H,V,B,B,V],[B,V,H,B,V],[B,H,V,B,V],[H,B,V,B,V],[B,B,V,H,V],[B,B,V,V,H],
    [B,H,V,V,B],[H,B,V,V,B],[V,B,H,V,B],[V,H,B,V,B],[H,V,B,V,B],[B,V,H,V,B],
    [B,V,V,H,B],[H,V,V,B,B],[V,H,V,B,B],[V,V,H,B,B]]
   λ> head (fichas buscaAnchura 2 2)
   [[B,B,H,V,V],[B,B,V,V,H],[B,H,V,V,B],[B,V,V,H,B],[H,V,V,B,B],
    [V,V,H,B,B]]
   λ> head (fichas buscaPM 2 2)
   [[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],
    [V,V,B,B,H],[V,V,B,H,B],[V,V,H,B,B]]
   λ> head (fichas buscaEscalada 2 2)
   [[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],
    [V,V,B,B,H],[V,V,B,H,B],[V,V,H,B,B]]

λ> head (fichas buscaProfundidad 2 2)

[[B,B,H,V,V],[B,H,B,V,V],[H,B,B,V,V],[V,B,B,H,V],[V,B,H,B,V],[V,H,B,B,V],

[H,V,B,B,V],[B,V,H,B,V],[B,H,V,B,V],[H,B,V,B,V],[B,B,V,H,V],[B,B,V,V,H],

[B,H,V,V,B],[H,B,V,V,B],[V,B,H,V,B],[V,H,B,V,B],[H,V,B,V,B],[B,V,H,V,B],

[B,V,V,H,B],[H,V,V,B,B],[V,H,V,B,B],[V,V,H,B,B]]

λ> head (fichas buscaAnchura 2 2)

[[B,B,H,V,V],[B,B,V,V,H],[B,H,V,V,B],[B,V,V,H,B],[H,V,V,B,B],

[V,V,H,B,B]]

λ> head (fichas buscaPM 2 2)

[[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],

[V,V,B,B,H],[V,V,B,H,B],[V,V,H,B,B]]

λ> head (fichas buscaEscalada 2 2)

[[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],

[V,V,B,B,H],[V,V,B,H,B],[V,V,H,B,B]]

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BEE_El_problema_de_las_fichas where

import BusquedaEnProfundidad (buscaProfundidad)
import BusquedaEnAnchura (buscaAnchura)
import BusquedaPrimeroElMejor (buscaPM)
import BusquedaEnEscalada (buscaEscalada)
import Test.Hspec (Spec, hspec, it, shouldBe)

-- Representación del problema
-- ===========================

data Ficha = B | V | H
  deriving (Eq, Show)

type Tablero = [Ficha]

-- (tableroInicial m n) representa el tablero inicial del problema de las fichas
-- de orden (m,n). Por ejemplo,
--    tableroInicial 2 3  ==  [B,B,H,V,V,V]
--    tableroInicial 3 2  ==  [B,B,B,H,V,V]
tableroInicial ::  Int -> Int -> Tablero
tableroInicial m n = replicate m B ++ [H] ++ replicate n V

-- (tableroFinal m n) representa el tablero final del problema de las fichas de
-- orden (m,n). Por ejemplo,
--    tableroFinal 2 3  ==  [V,V,V,H,B,B]
--    tableroFinal 3 2  ==  [V,V,H,B,B,B]
tableroFinal ::  Int -> Int -> Tablero
tableroFinal m n = replicate n V ++ [H] ++ replicate m B

-- (tablerosSucesores t) es la lista de los sucesores del tablero t. Por
-- ejemplo,
--    λ> tablerosSucesores [V,B,H,V,V,B]
--    [[V,H,B,V,V,B],[H,B,V,V,V,B],[V,B,V,H,V,B],[V,B,V,V,H,B],
--     [V,B,B,V,V,H]]
--    λ> tablerosSucesores [B,B,B,H,V,V,V]
--    [[B,B,H,B,V,V,V],[B,H,B,B,V,V,V],[H,B,B,B,V,V,V],
--     [B,B,B,V,H,V,V],[B,B,B,V,V,H,V],[B,B,B,V,V,V,H]]
tablerosSucesores :: Tablero -> [Tablero]
tablerosSucesores t =
  [intercambia i j t | i <- [j-1,j-2,j-3,j+1,j+2,j+3]
                     , 0 <= i, i < n]
  where j = posicionHueco t
        n = length t

-- (posicionHueco t) es la posición del hueco en el tablero t. Por
-- ejemplo,
--    posicionHueco (tableroInicial 3 2)  ==  3
posicionHueco :: Tablero -> Int
posicionHueco t = length (takeWhile (/=H) t)

-- (intercambia xs i j) es la lista obtenida intercambiando los
-- elementos de xs en las posiciones i y j. Por ejemplo,
--    intercambia 2 6 [0..9]  ==  [0,1,6,3,4,5,2,7,8,9]
--    intercambia 6 2 [0..9]  ==  [0,1,6,3,4,5,2,7,8,9]
intercambia :: Int -> Int -> [a] -> [a]
intercambia i j xs = concat [xs1,[x2],xs2,[x1],xs3]
  where (xs1,x1,xs2,x2,xs3) = divide (min i j) (max i j) xs

-- (divide xs i j) es la tupla (xs1,x1,xs2,x2,xs3) tal que xs1 son los
-- elementos de xs cuya posición es menor que i, x1 es el elemento de xs
-- en la posición i, xs2 son los elementos de xs cuya posición es mayor
-- que i y menor que j, x2 es el elemento de xs en la posición j y xs3
-- son los elementos de xs cuya posición es mayor que j (suponiendo que
-- i < j). Por ejemplo,
--    divide 2 6 [0..9]  ==  ([0,1],2,[3,4,5],6,[7,8,9])
divide :: Int -> Int -> [a] -> ([a],a,[a],a,[a])
divide i j xs = (xs1,x1,xs2,x2,xs3)
  where (xs1,x1:ys)  = splitAt i xs
        (xs2,x2:xs3) = splitAt (j - i - 1) ys

newtype Estado = E [Tablero]
  deriving (Eq, Show)

-- (inicial m n) representa el estado inicial del problema de las fichas
-- de orden (m,n). Por ejemplo,
--    inicial 2 3  ==  E [[B,B,H,V,V,V]]
--    inicial 3 2  ==  E [[B,B,B,H,V,V]]
inicial :: Int -> Int -> Estado
inicial m n = E [tableroInicial m n]

-- (esFinal m n e) se verifica si e es un estado final del problema de las
-- fichas de orden (m,n). Por ejemplo,
--    λ> esFinal 2 1 (E [[V,H,B,B],[V,B,B,H],[H,B,B,V],[B,B,H,V]])
--    True
--    λ> esFinal 2 1 (E [[V,B,B,H],[H,B,B,V],[B,B,H,V]])
--    False
esFinal :: Int -> Int -> Estado -> Bool
esFinal m n (E (e:_)) = e == tableroFinal m n

-- (sucesores n) es la lista de los sucesores del estado n. Por ejemplo,
--    λ> sucesores (E [[H,B,B,V],[B,B,H,V]])
--    [E [[B,H,B,V],[H,B,B,V],[B,B,H,V]],
--     E [[V,B,B,H],[H,B,B,V],[B,B,H,V]]]
--    λ> sucesores (E [[B,H,B,V],[H,B,B,V],[B,B,H,V]])
--    [E [[B,V,B,H],[B,H,B,V],[H,B,B,V],[B,B,H,V]]]
sucesores :: Estado -> [Estado]
sucesores (E e@(t:ts)) =
  [E (t':e) | t' <- tablerosSucesores t,
              t' `notElem` ts]

-- Heurística
-- ==========

-- (heuristicaT t) es la heurística del tablero t. Por ejemplo,
--    heuristicaT [B,V,B,H,V,V,B] == 5
heuristicaT :: Tablero -> Int
heuristicaT []     = 0
heuristicaT (V:xs) = heuristicaT xs
heuristicaT (H:xs) = heuristicaT xs
heuristicaT (B:xs) = heuristicaT xs + length (filter (==V) xs)

-- (heuristica e) es la heurística del primer tablero del estado e. Por
-- ejemplo,
--    heuristica (E [[H,B,B,V],[B,B,H,V]])            ==  2
--    heuristica (E [[V,B,B,H],[H,B,B,V],[B,B,H,V]])  ==  0
heuristica :: Estado -> Int
heuristica (E (t:_)) = heuristicaT t

-- Estado es un subtipo de Ord de forma que un estado es menor o igual
-- que otro si su heurística lo es.
instance Ord Estado where
  e1 <= e2 = heuristica e1 <= heuristica e2

-- Solución por búsqueda
-- =====================

type Busqueda = (Estado -> [Estado]) ->
                (Estado -> Bool) ->
                Estado ->
                [Estado]

fichas :: Busqueda -> Int -> Int -> [[Tablero]]
fichas b m n =
  [reverse es | E es <- b sucesores (esFinal m n) (inicial m n)]

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    head (fichas buscaProfundidad 2 2) `shouldBe`
    [[B,B,H,V,V],[B,H,B,V,V],[H,B,B,V,V],[V,B,B,H,V],[V,B,H,B,V],[V,H,B,B,V],
     [H,V,B,B,V],[B,V,H,B,V],[B,H,V,B,V],[H,B,V,B,V],[B,B,V,H,V],[B,B,V,V,H],
     [B,H,V,V,B],[H,B,V,V,B],[V,B,H,V,B],[V,H,B,V,B],[H,V,B,V,B],[B,V,H,V,B],
     [B,V,V,H,B],[H,V,V,B,B],[V,H,V,B,B],[V,V,H,B,B]]
  it "e2" $
    head (fichas buscaAnchura 2 2) `shouldBe`
    [[B,B,H,V,V],[B,B,V,V,H],[B,H,V,V,B],[B,V,V,H,B],[H,V,V,B,B],[V,V,H,B,B]]
  it "e3" $
    head (fichas buscaPM 2 2) `shouldBe`
    [[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],[V,V,B,B,H],
     [V,V,B,H,B],[V,V,H,B,B]]
  it "e4" $
    head (fichas buscaEscalada 2 2) `shouldBe`
    [[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],[V,V,B,B,H],
     [V,V,B,H,B],[V,V,H,B,B]]

-- La verificación es
--    λ> verifica
--
--    e1
--    e2
--    e3
--    e4
--
--    Finished in 0.0055 seconds
--    4 examples, 0 failures

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

module BEE_El_problema_de_las_fichas where

import BusquedaEnProfundidad (buscaProfundidad)

import BusquedaEnAnchura (buscaAnchura)

import BusquedaPrimeroElMejor (buscaPM)

import BusquedaEnEscalada (buscaEscalada)

import Test.Hspec (Spec, hspec, it, shouldBe)

-- Representación del problema

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

data Ficha = B | V | H

deriving (Eq, Show)

type Tablero = [Ficha]

-- (tableroInicial m n) representa el tablero inicial del problema de las fichas

-- de orden (m,n). Por ejemplo,

-- tableroInicial 2 3 == [B,B,H,V,V,V]

-- tableroInicial 3 2 == [B,B,B,H,V,V]

tableroInicial :: Int -> Int -> Tablero

tableroInicial m n = replicate m B ++ [H] ++ replicate n V

-- (tableroFinal m n) representa el tablero final del problema de las fichas de

-- orden (m,n). Por ejemplo,

-- tableroFinal 2 3 == [V,V,V,H,B,B]

-- tableroFinal 3 2 == [V,V,H,B,B,B]

tableroFinal :: Int -> Int -> Tablero

tableroFinal m n = replicate n V ++ [H] ++ replicate m B

-- (tablerosSucesores t) es la lista de los sucesores del tablero t. Por

-- ejemplo,

-- λ> tablerosSucesores [V,B,H,V,V,B]

-- [[V,H,B,V,V,B],[H,B,V,V,V,B],[V,B,V,H,V,B],[V,B,V,V,H,B],

-- [V,B,B,V,V,H]]

-- λ> tablerosSucesores [B,B,B,H,V,V,V]

-- [[B,B,H,B,V,V,V],[B,H,B,B,V,V,V],[H,B,B,B,V,V,V],

-- [B,B,B,V,H,V,V],[B,B,B,V,V,H,V],[B,B,B,V,V,V,H]]

tablerosSucesores :: Tablero -> [Tablero]

tablerosSucesores t =

[intercambia i j t | i <- [j-1,j-2,j-3,j+1,j+2,j+3]

, 0 <= i, i < n]

where j = posicionHueco t

n = length t

-- (posicionHueco t) es la posición del hueco en el tablero t. Por

-- ejemplo,

-- posicionHueco (tableroInicial 3 2) == 3

posicionHueco :: Tablero -> Int

posicionHueco t = length (takeWhile (/=H) t)

-- (intercambia xs i j) es la lista obtenida intercambiando los

-- elementos de xs en las posiciones i y j. Por ejemplo,

-- intercambia 2 6 [0..9] == [0,1,6,3,4,5,2,7,8,9]

-- intercambia 6 2 [0..9] == [0,1,6,3,4,5,2,7,8,9]

intercambia :: Int -> Int -> [a] -> [a]

intercambia i j xs = concat [xs1,[x2],xs2,[x1],xs3]

where (xs1,x1,xs2,x2,xs3) = divide (min i j) (max i j) xs

-- (divide xs i j) es la tupla (xs1,x1,xs2,x2,xs3) tal que xs1 son los

-- elementos de xs cuya posición es menor que i, x1 es el elemento de xs

-- en la posición i, xs2 son los elementos de xs cuya posición es mayor

-- que i y menor que j, x2 es el elemento de xs en la posición j y xs3

-- son los elementos de xs cuya posición es mayor que j (suponiendo que

-- i < j). Por ejemplo,

-- divide 2 6 [0..9] == ([0,1],2,[3,4,5],6,[7,8,9])

divide :: Int -> Int -> [a] -> ([a],a,[a],a,[a])

divide i j xs = (xs1,x1,xs2,x2,xs3)

where (xs1,x1:ys) = splitAt i xs

(xs2,x2:xs3) = splitAt (j - i - 1) ys

newtype Estado = E [Tablero]

deriving (Eq, Show)

-- (inicial m n) representa el estado inicial del problema de las fichas

-- de orden (m,n). Por ejemplo,

-- inicial 2 3 == E [[B,B,H,V,V,V]]

-- inicial 3 2 == E [[B,B,B,H,V,V]]

inicial :: Int -> Int -> Estado

inicial m n = E [tableroInicial m n]

-- (esFinal m n e) se verifica si e es un estado final del problema de las

-- fichas de orden (m,n). Por ejemplo,

-- λ> esFinal 2 1 (E [[V,H,B,B],[V,B,B,H],[H,B,B,V],[B,B,H,V]])

-- True

-- λ> esFinal 2 1 (E [[V,B,B,H],[H,B,B,V],[B,B,H,V]])

-- False

esFinal :: Int -> Int -> Estado -> Bool

esFinal m n (E (e:_)) = e == tableroFinal m n

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

-- λ> sucesores (E [[H,B,B,V],[B,B,H,V]])

-- [E [[B,H,B,V],[H,B,B,V],[B,B,H,V]],

-- E [[V,B,B,H],[H,B,B,V],[B,B,H,V]]]

-- λ> sucesores (E [[B,H,B,V],[H,B,B,V],[B,B,H,V]])

-- [E [[B,V,B,H],[B,H,B,V],[H,B,B,V],[B,B,H,V]]]

sucesores :: Estado -> [Estado]

sucesores (E e@(t:ts)) =

[E (t':e) | t' <- tablerosSucesores t,

t' `notElem` ts]

-- Heurística

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

-- (heuristicaT t) es la heurística del tablero t. Por ejemplo,

-- heuristicaT [B,V,B,H,V,V,B] == 5

heuristicaT :: Tablero -> Int

heuristicaT [] = 0

heuristicaT (V:xs) = heuristicaT xs

heuristicaT (H:xs) = heuristicaT xs

heuristicaT (B:xs) = heuristicaT xs + length (filter (==V) xs)

-- (heuristica e) es la heurística del primer tablero del estado e. Por

-- ejemplo,

-- heuristica (E [[H,B,B,V],[B,B,H,V]]) == 2

-- heuristica (E [[V,B,B,H],[H,B,B,V],[B,B,H,V]]) == 0

heuristica :: Estado -> Int

heuristica (E (t:_)) = heuristicaT t

-- Estado es un subtipo de Ord de forma que un estado es menor o igual

-- que otro si su heurística lo es.

instance Ord Estado where

e1 <= e2 = heuristica e1 <= heuristica e2

-- Solución por búsqueda

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

type Busqueda = (Estado -> [Estado]) ->

(Estado -> Bool) ->

Estado ->

[Estado]

fichas :: Busqueda -> Int -> Int -> [[Tablero]]

fichas b m n =

[reverse es | E es <- b sucesores (esFinal m n) (inicial m n)]

-- Verificación

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

verifica :: IO ()

verifica = hspec spec

spec :: Spec

spec = do

it "e1" $

head (fichas buscaProfundidad 2 2) `shouldBe`

[[B,B,H,V,V],[B,H,B,V,V],[H,B,B,V,V],[V,B,B,H,V],[V,B,H,B,V],[V,H,B,B,V],

[H,V,B,B,V],[B,V,H,B,V],[B,H,V,B,V],[H,B,V,B,V],[B,B,V,H,V],[B,B,V,V,H],

[B,H,V,V,B],[H,B,V,V,B],[V,B,H,V,B],[V,H,B,V,B],[H,V,B,V,B],[B,V,H,V,B],

[B,V,V,H,B],[H,V,V,B,B],[V,H,V,B,B],[V,V,H,B,B]]

it "e2" $

head (fichas buscaAnchura 2 2) `shouldBe`

[[B,B,H,V,V],[B,B,V,V,H],[B,H,V,V,B],[B,V,V,H,B],[H,V,V,B,B],[V,V,H,B,B]]

it "e3" $

head (fichas buscaPM 2 2) `shouldBe`

[[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],[V,V,B,B,H],

[V,V,B,H,B],[V,V,H,B,B]]

it "e4" $

head (fichas buscaEscalada 2 2) `shouldBe`

[[B,B,H,V,V],[B,H,B,V,V],[B,V,B,H,V],[H,V,B,B,V],[V,H,B,B,V],[V,V,B,B,H],

[V,V,B,H,B],[V,V,H,B,B]]

-- La verificación es

-- λ> verifica

-- e1

-- e2

-- e3

-- e4

-- Finished in 0.0055 seconds

-- 4 examples, 0 failures

Soluciones en Python

from enum import Enum
from functools import partial
from typing import Callable, Optional

from src.BusquedaEnAnchura import buscaAnchura1
from src.BusquedaEnEscalada import buscaEscalada
from src.BusquedaEnProfundidad import buscaProfundidad1
from src.BusquedaPrimeroElMejor import buscaPM

# Representación del problema
# ===========================

class Ficha(Enum):
    B = 0
    V = 1
    H = 2

    def __repr__(self) -> str:
        return self.name

B = Ficha.B
V = Ficha.V
H = Ficha.H

Tablero = list[Ficha]

# tableroInicial(m, n) representa el tablero inicial del problema de las fichas
# de orden (m,n). Por ejemplo,
#    tableroInicial(2, 3)  ==  [B,B,H,V,V,V]
#    tableroInicial(3, 2)  ==  [B,B,B,H,V,V]
def tableroInicial(m: int, n: int) -> Tablero:
    return [B]*m + [H] + [V]*n

# tableroFinal(m, n) representa el tablero final del problema de las fichas de
# orden (m,n). Por ejemplo,
#    tableroFinal(2, 3)  ==  [V,V,V,H,B,B]
#    tableroFinal(3, 2)  ==  [V,V,H,B,B,B]
def tableroFinal(m: int, n: int) -> Tablero:
    return [V]*n + [H] + [B]*m

# posicionHueco(t) es la posición del hueco en el tablero t. Por
# ejemplo,
#    posicionHueco(tableroInicial(3, 2))  ==  3
def posicionHueco(t: Tablero) -> int:
    return t.index(H)

# intercambia(xs, i, j) es la lista obtenida intercambiando los
# elementos de xs en las posiciones i y j. Por ejemplo,
#    intercambia(1, 3, tableroInicial(3, 2))  ==  [B, H, B, B, V, V]
def intercambia(i: int, j: int, t: Tablero) -> Tablero:
    t1 = t.copy()
    t1[i], t1[j] = t1[j], t1[i]
    return t1

# tablerosSucesores(t) es la lista de los sucesores del tablero t. Por
# ejemplo,
#    >>> tablerosSucesores([V,B,H,V,V,B])
#    [[V,H,B,V,V,B],[H,B,V,V,V,B],[V,B,V,H,V,B],[V,B,V,V,H,B],
#     [V,B,B,V,V,H]]
#    >>> tablerosSucesores([B,B,B,H,V,V,V])
#    [[B,B,H,B,V,V,V],[B,H,B,B,V,V,V],[H,B,B,B,V,V,V],
#     [B,B,B,V,H,V,V],[B,B,B,V,V,H,V],[B,B,B,V,V,V,H]]
def tablerosSucesores(t: Tablero) -> list[Tablero]:
    j = posicionHueco(t)
    n = len(t)
    return [intercambia(i, j, t)
            for i in [j-1,j-2,j-3,j+1,j+2,j+3]
            if 0 <= i < n]

# Heurística
# ==========

# heuristicaT(t) es la heurística del tablero t. Por ejemplo,
#    heuristicaT([B,V,B,H,V,V,B]) == 5
def heuristicaT(t: Tablero) -> int:
    if not t:
        return 0
    f, *fs = t
    if f in {V, H}:
        return heuristicaT(fs)
    return heuristicaT(fs) + len([x for x in fs if x == V])

class Estado(list[Tablero]):
    def __lt__(self, e: list[Tablero]) -> bool:
        return heuristicaT(self[0]) < heuristicaT(e[0])

# inicial(m, n) representa el estado inicial del problema de las fichas
# de orden (m,n). Por ejemplo,
#    inicial(2, 3)  ==  [[B,B,H,V,V,V]]
#    inicial(3, 2)  ==  [[B,B,B,H,V,V]]
def inicial(m: int, n: int) -> Estado:
    return Estado([tableroInicial(m, n)])

# esFinal(m, n, e) se verifica si e es un estado final del problema de las
# fichas de orden (m,n). Por ejemplo,
#    >>> esFinal(2, 1, [[V,H,B,B],[V,B,B,H],[H,B,B,V],[B,B,H,V]])
#    True
#    >>> esFinal(2, 1, [[V,B,B,H],[H,B,B,V],[B,B,H,V]])
#    False
def esFinal(m: int, n: int, e: Estado) -> bool:
    return e[0] == tableroFinal(m, n)

# (sucesores n) es la lista de los sucesores del estado n. Por ejemplo,
#    >>> sucesores([[H,B,B,V],[B,B,H,V]])
#    [[[B,H,B,V],[H,B,B,V],[B,B,H,V]],
#     [[V,B,B,H],[H,B,B,V],[B,B,H,V]]]
#    >>> sucesores([[B,H,B,V],[H,B,B,V],[B,B,H,V]])
#    [[[B,V,B,H],[B,H,B,V],[H,B,B,V],[B,B,H,V]]]
def sucesores(e: Estado) -> list[Estado]:
    t, *ts = e
    return [Estado([t1] + e) for t1 in tablerosSucesores(t) if t1 not in ts]

# Solución por búsqueda
# =====================

Busqueda = Callable[[Callable[[Estado], list[Estado]],
                     Callable[[Estado], bool],
                     Estado],
                    Optional[Estado]]

def fichas(b: Busqueda, m: int, n: int) -> Optional[list[Tablero]]:
    r = partial(b, sucesores, lambda e: esFinal(m, n, e), inicial(m, n))()
    if r is None:
        return None
    return [list(reversed(es)) for es in r]

# Verificación
# ============

def test_fichas() -> None:
    assert fichas(buscaProfundidad1, 1, 2) == \
        [[B, H, V, V], [B, V, V, H], [H, V, V, B], [V, V, H, B]]
    assert fichas(buscaAnchura1, 1, 2) == \
        [[B, H, V, V], [B, V, V, H], [H, V, V, B], [V, V, H, B]]
    assert fichas(buscaPM, 1, 2) == \
        [[B, H, V, V], [B, V, H, V], [H, V, B, V], [V, V, B, H],
         [V, V, H, B]]
    assert fichas(buscaEscalada, 1, 2) == \
        [[B, H, V, V], [H, B, V, V], [V, B, H, V], [V, H, B, V],
         [V, V, B, H], [V, V, H, B]]
    print("Verificado")

# La verificación es
#    >>> test_fichas()
#    Verificado

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

from enum import Enum

from functools import partial

from typing import Callable, Optional

from src.BusquedaEnAnchura import buscaAnchura1

from src.BusquedaEnEscalada import buscaEscalada

from src.BusquedaEnProfundidad import buscaProfundidad1

from src.BusquedaPrimeroElMejor import buscaPM

# Representación del problema

# ===========================

class Ficha(Enum):

B = 0

V = 1

H = 2

def __repr__(self) -> str:

return self.name

B = Ficha.B

V = Ficha.V

H = Ficha.H

Tablero = list[Ficha]

# tableroInicial(m, n) representa el tablero inicial del problema de las fichas

# de orden (m,n). Por ejemplo,

# tableroInicial(2, 3) == [B,B,H,V,V,V]

# tableroInicial(3, 2) == [B,B,B,H,V,V]

def tableroInicial(m: int, n: int) -> Tablero:

return [B]*m + [H] + [V]*n

# tableroFinal(m, n) representa el tablero final del problema de las fichas de

# orden (m,n). Por ejemplo,

# tableroFinal(2, 3) == [V,V,V,H,B,B]

# tableroFinal(3, 2) == [V,V,H,B,B,B]

def tableroFinal(m: int, n: int) -> Tablero:

return [V]*n + [H] + [B]*m

# posicionHueco(t) es la posición del hueco en el tablero t. Por

# ejemplo,

# posicionHueco(tableroInicial(3, 2)) == 3

def posicionHueco(t: Tablero) -> int:

return t.index(H)

# intercambia(xs, i, j) es la lista obtenida intercambiando los

# elementos de xs en las posiciones i y j. Por ejemplo,

# intercambia(1, 3, tableroInicial(3, 2)) == [B, H, B, B, V, V]

def intercambia(i: int, j: int, t: Tablero) -> Tablero:

t1 = t.copy()

t1[i], t1[j] = t1[j], t1[i]

return t1

# tablerosSucesores(t) es la lista de los sucesores del tablero t. Por

# ejemplo,

# >>> tablerosSucesores([V,B,H,V,V,B])

# [[V,H,B,V,V,B],[H,B,V,V,V,B],[V,B,V,H,V,B],[V,B,V,V,H,B],

# [V,B,B,V,V,H]]

# >>> tablerosSucesores([B,B,B,H,V,V,V])

# [[B,B,H,B,V,V,V],[B,H,B,B,V,V,V],[H,B,B,B,V,V,V],

# [B,B,B,V,H,V,V],[B,B,B,V,V,H,V],[B,B,B,V,V,V,H]]

def tablerosSucesores(t: Tablero) -> list[Tablero]:

j = posicionHueco(t)

n = len(t)

return [intercambia(i, j, t)

for i in [j-1,j-2,j-3,j+1,j+2,j+3]

if 0 <= i < n]

# Heurística

# ==========

# heuristicaT(t) es la heurística del tablero t. Por ejemplo,

# heuristicaT([B,V,B,H,V,V,B]) == 5

def heuristicaT(t: Tablero) -> int:

if not t:

return 0

f, *fs = t

if f in {V, H}:

return heuristicaT(fs)

return heuristicaT(fs) + len([x for x in fs if x == V])

class Estado(list[Tablero]):

def __lt__(self, e: list[Tablero]) -> bool:

return heuristicaT(self[0]) < heuristicaT(e[0])

# inicial(m, n) representa el estado inicial del problema de las fichas

# de orden (m,n). Por ejemplo,

# inicial(2, 3) == [[B,B,H,V,V,V]]

# inicial(3, 2) == [[B,B,B,H,V,V]]

def inicial(m: int, n: int) -> Estado:

return Estado([tableroInicial(m, n)])

# esFinal(m, n, e) se verifica si e es un estado final del problema de las

# fichas de orden (m,n). Por ejemplo,

# >>> esFinal(2, 1, [[V,H,B,B],[V,B,B,H],[H,B,B,V],[B,B,H,V]])

# True

# >>> esFinal(2, 1, [[V,B,B,H],[H,B,B,V],[B,B,H,V]])

# False

def esFinal(m: int, n: int, e: Estado) -> bool:

return e[0] == tableroFinal(m, n)

# (sucesores n) es la lista de los sucesores del estado n. Por ejemplo,

# >>> sucesores([[H,B,B,V],[B,B,H,V]])

# [[[B,H,B,V],[H,B,B,V],[B,B,H,V]],

# [[V,B,B,H],[H,B,B,V],[B,B,H,V]]]

# >>> sucesores([[B,H,B,V],[H,B,B,V],[B,B,H,V]])

# [[[B,V,B,H],[B,H,B,V],[H,B,B,V],[B,B,H,V]]]

def sucesores(e: Estado) -> list[Estado]:

t, *ts = e

return [Estado([t1] + e) for t1 in tablerosSucesores(t) if t1 not in ts]

# Solución por búsqueda

# =====================

Busqueda = Callable[[Callable[[Estado], list[Estado]],

Callable[[Estado], bool],

Estado],

Optional[Estado]]

def fichas(b: Busqueda, m: int, n: int) -> Optional[list[Tablero]]:

r = partial(b, sucesores, lambda e: esFinal(m, n, e), inicial(m, n))()

if r is None:

return None

return [list(reversed(es)) for es in r]

# Verificación

# ============

def test_fichas() -> None:

assert fichas(buscaProfundidad1, 1, 2) == \

[[B, H, V, V], [B, V, V, H], [H, V, V, B], [V, V, H, B]]

assert fichas(buscaAnchura1, 1, 2) == \

[[B, H, V, V], [B, V, V, H], [H, V, V, B], [V, V, H, B]]

assert fichas(buscaPM, 1, 2) == \

[[B, H, V, V], [B, V, H, V], [H, V, B, V], [V, V, B, H],

[V, V, H, B]]

assert fichas(buscaEscalada, 1, 2) == \

[[B, H, V, V], [H, B, V, V], [V, B, H, V], [V, H, B, V],

[V, V, B, H], [V, V, H, B]]

print("Verificado")

# La verificación es

# >>> test_fichas()

# Verificado

El problema del 8 puzzle

PorJosé A. Alonso 7-julio-20237-julio-2023

Para el 8-puzzle se usa un cajón cuadrado en el que hay situados 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:

   +---+---+---+                   +---+---+---+
   |   | 1 | 3 |                   | 1 | 2 | 3 |
   +---+---+---+                   +---+---+---+
   | 8 | 2 | 4 |                   | 8 |   | 4 |
   +---+---+---+                   +---+---+---+
   | 7 | 5 | 5 |                   | 7 | 6 | 5 |
   +---+---+---+                   +---+---+---+
   Estado inicial                  Estado final

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

| | 1 | 3 | | 1 | 2 | 3 |

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

| 8 | 2 | 4 | | 8 | | 4 |

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

| 7 | 5 | 5 | | 7 | 6 | 5 |

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

Estado inicial Estado final

Para solucionar el problema se definen los siguientes tipos:

Tablero es una matriz de número enteros (que representan las piezas en
cada posición y el 0 representa el hueco):

     type Tablero  = Matrix Int

1	type Tablero = Matrix Int

Estado es una listas de tableros [t_n,…,t_1] tal que t_i es un
sucesor de t_(i-1).

     newtype Estado = Est [Tablero]
       deriving Show

1 2	newtype Estado = Est [Tablero] deriving Show

Usando el procedimiento de búsqueda por primero el mejor, definir la función

   solucion_8puzzle :: Tablero -> [Tablero]

1	solucion_8puzzle :: Tablero -> [Tablero]

tal que (solucion_8puzzle t) es la solución del problema del problema del 8 puzzle a partir del tablero t. Por ejemplo,

   λ> solucion_8puzzle (fromLists [[0,1,3],[8,2,4],[7,6,5]])
   [┌       ┐  ┌       ┐  ┌       ┐
    │ 0 1 3 │  │ 1 0 3 │  │ 1 2 3 │
    │ 8 2 4 │  │ 8 2 4 │  │ 8 0 4 │
    │ 7 6 5 │  │ 7 6 5 │  │ 7 6 5 │
    └       ┘, └       ┘, └       ┘]
   λ> length (solucion_8puzzle (fromLists [[2,6,3],[5,0,4],[1,7,8]]))
   21

λ> solucion_8puzzle (fromLists [[0,1,3],[8,2,4],[7,6,5]])

[┌ ┐ ┌ ┐ ┌ ┐

│ 0 1 3 │ │ 1 0 3 │ │ 1 2 3 │

│ 8 2 4 │ │ 8 2 4 │ │ 8 0 4 │

│ 7 6 5 │ │ 7 6 5 │ │ 7 6 5 │

└ ┘, └ ┘, └ ┘]

λ> length (solucion_8puzzle (fromLists [[2,6,3],[5,0,4],[1,7,8]]))

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BPM_8Puzzle where

import BusquedaPrimeroElMejor (buscaPM)
import Data.Matrix (Matrix, (!), fromLists, setElem, toLists)
import Test.Hspec (Spec, hspec, it, shouldBe)

type Tablero  = Matrix Int

newtype Estado = Est [Tablero]
  deriving (Eq, Show)

solucion_8puzzle :: Tablero -> [Tablero]
solucion_8puzzle t = reverse ts
  where (Est ts) = head (buscaPM sucesores
                                 esFinal
                                 (inicial t))

-- Estado inicial
-- ==============

-- (inicial t) es el estado inicial del problema del 8 puzzle a partir del
-- tablero t.
inicial :: Tablero -> Estado
inicial t = Est [t]

-- Estado final
-- ============

-- (esFinal e) se verifica si e es un estado final.
esFinal :: Estado -> Bool
esFinal (Est (n:_)) = n == tableroFinal

-- tableroFinal es el estado tablero final del 8 puzzle.
tableroFinal :: Tablero
tableroFinal = fromLists [[1,2,3],
                          [8,0,4],
                          [7,6,5]]

-- Sucesores
-- =========

-- (sucesores e) es la lista de sucesores del estado e. Por ejemplo,
--    λ> sucesores (Est [fromLists [[2,1,3],[8,0,4],[7,6,5]]])
--    [Est [┌       ┐  ┌       ┐
--          │ 2 0 3 │  │ 2 1 3 │
--          │ 8 1 4 │  │ 8 0 4 │
--          │ 7 6 5 │  │ 7 6 5 │
--          └       ┘, └       ┘],
--     Est [┌       ┐  ┌       ┐
--          │ 2 1 3 │  │ 2 1 3 │
--          │ 8 6 4 │  │ 8 0 4 │
--          │ 7 0 5 │  │ 7 6 5 │
--          └       ┘, └       ┘],
--     Est [┌       ┐  ┌       ┐
--          │ 2 1 3 │  │ 2 1 3 │
--          │ 0 8 4 │  │ 8 0 4 │
--          │ 7 6 5 │  │ 7 6 5 │
--          └       ┘, └       ┘],
--     Est [┌       ┐  ┌       ┐
--          │ 2 1 3 │  │ 2 1 3 │
--          │ 8 4 0 │  │ 8 0 4 │
--          │ 7 6 5 │  │ 7 6 5 │
--          └       ┘, └       ┘]]
sucesores :: Estado -> [Estado]
sucesores (Est e@(t:_)) =
  [Est (t':e) | t' <- tablerosSucesores t,
                t' `notElem` e]

-- (tablerosSucesores t) es la lista de los tableros sucesores del
-- tablero t. Por ejemplo,
--    λ> tablerosSucesores (fromLists [[2,1,3],[8,0,4],[7,6,5]])
--    [┌       ┐  ┌       ┐  ┌       ┐  ┌       ┐
--     │ 2 0 3 │  │ 2 1 3 │  │ 2 1 3 │  │ 2 1 3 │
--     │ 8 1 4 │  │ 8 6 4 │  │ 0 8 4 │  │ 8 4 0 │
--     │ 7 6 5 │  │ 7 0 5 │  │ 7 6 5 │  │ 7 6 5 │
--     └       ┘, └       ┘, └       ┘, └       ┘]
tablerosSucesores :: Tablero -> [Tablero]
tablerosSucesores t =
  [intercambia t p q | q <- posicionesVecinas p]
  where p = posicionHueco t

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

-- (posicionesVecinas p) son las posiciones de la matriz cuadrada de
-- dimensión 3 que se encuentran encima, abajo, a la izquierda y a la
-- derecha de los posición p. Por ejemplo,
--    λ> posicionesVecinas (2,2)
--    [(1,2),(3,2),(2,1),(2,3)]
--    λ> posicionesVecinas (1,2)
--    [(2,2),(1,1),(1,3)]
--    λ> posicionesVecinas (1,1)
--    [(2,1),(1,2)]
posicionesVecinas :: Posicion -> [Posicion]
posicionesVecinas (i,j) =
  [(i-1,j) | i > 1] ++
  [(i+1,j) | i < 3] ++
  [(i,j-1) | j > 1] ++
  [(i,j+1) | j < 3]

-- (posicionHueco t) es la posición del hueco en el tablero t. Por
-- ejemplo,
--    λ> posicionHueco (fromLists [[2,1,3],[8,0,4],[7,6,5]])
--    (2,2)
posicionHueco :: Tablero -> Posicion
posicionHueco t =
  posicionElemento t 0

-- (posicionElemento t a) es la posición de elemento a en el tablero
-- t. Por ejemplo,
--    λ> posicionElemento (fromLists [[2,1,3],[8,0,4],[7,6,5]]) 4
--    (2,3)
posicionElemento :: Tablero -> Int -> Posicion
posicionElemento t a =
  head [(i,j) | i <- [1..3],
                j <- [1..3],
                t ! (i,j) == a]

-- (intercambia t p1 p2) es el tablero obtenido intercambiando en t los
-- elementos que se encuentran en las posiciones p1 y p2. Por ejemplo,
--    λ> intercambia (fromLists [[2,1,3],[8,0,4],[7,6,5]]) (1,2) (2,2)
--    ┌       ┐
--    │ 2 0 3 │
--    │ 8 1 4 │
--    │ 7 6 5 │
--    └       ┘
intercambia :: Tablero -> Posicion -> Posicion -> Tablero
intercambia t p1 p2 =
  setElem a2 p1 (setElem a1 p2 t)
  where a1 = t ! p1
        a2 = t ! p2

-- Heurística
-- ==========

-- (heuristica t) es la suma de la distancia Manhatan desde la posición de
-- cada objeto del tablero a su posición en el tablero final. Por
-- ejemplo,
--    λ> heuristica (fromLists [[0,1,3],[8,2,4],[7,6,5]])
--    4
heuristica :: Tablero  -> Int
heuristica t =
  sum [distancia (posicionElemento t i)
                 (posicionElemento tableroFinal i)
      | i <- [0..8]]

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

-- Comparación de estados
-- ======================

-- Un estado es menor o igual que otro si tiene la heurística de su
-- primer tablero es menor o que la del segundo o so iguales y el
-- primero es más corto.
instance Ord Estado where
  Est (t1:ts1) <= Est (t2:ts2) = (heuristica t1 < heuristica t2) ||
                                 ((heuristica t1 == heuristica t2) &&
                                  (length ts1 <= length ts2))

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    map toLists (solucion_8puzzle (fromLists [[0,1,3],[8,2,4],[7,6,5]]))
   `shouldBe` [[[0,1,3],
                [8,2,4],
                [7,6,5]],
               [[1,0,3],
                [8,2,4],
                [7,6,5]],
               [[1,2,3],
                [8,0,4],
                [7,6,5]]]
  it "e2" $
    length (solucion_8puzzle (fromLists [[2,6,3],[5,0,4],[1,7,8]]))
    `shouldBe` 21

-- La verificación es
--    λ> verifica
--
--    e1
--    e2
--
--    Finished in 0.1361 seconds
--    2 examples, 0 failures

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

module BPM_8Puzzle where

import BusquedaPrimeroElMejor (buscaPM)

import Data.Matrix (Matrix, (!), fromLists, setElem, toLists)

import Test.Hspec (Spec, hspec, it, shouldBe)

type Tablero = Matrix Int

newtype Estado = Est [Tablero]

deriving (Eq, Show)

solucion_8puzzle :: Tablero -> [Tablero]

solucion_8puzzle t = reverse ts

where (Est ts) = head (buscaPM sucesores

esFinal

(inicial t))

-- Estado inicial

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

-- (inicial t) es el estado inicial del problema del 8 puzzle a partir del

-- tablero t.

inicial :: Tablero -> Estado

inicial t = Est [t]

-- Estado final

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

-- (esFinal e) se verifica si e es un estado final.

esFinal :: Estado -> Bool

esFinal (Est (n:_)) = n == tableroFinal

-- tableroFinal es el estado tablero final del 8 puzzle.

tableroFinal :: Tablero

tableroFinal = fromLists [[1,2,3],

[8,0,4],

[7,6,5]]

-- Sucesores

-- =========

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

-- λ> sucesores (Est [fromLists [[2,1,3],[8,0,4],[7,6,5]]])

-- [Est [┌ ┐ ┌ ┐

-- │ 2 0 3 │ │ 2 1 3 │

-- │ 8 1 4 │ │ 8 0 4 │

-- │ 7 6 5 │ │ 7 6 5 │

-- └ ┘, └ ┘],

-- Est [┌ ┐ ┌ ┐

-- │ 2 1 3 │ │ 2 1 3 │

-- │ 8 6 4 │ │ 8 0 4 │

-- │ 7 0 5 │ │ 7 6 5 │

-- └ ┘, └ ┘],

-- Est [┌ ┐ ┌ ┐

-- │ 2 1 3 │ │ 2 1 3 │

-- │ 0 8 4 │ │ 8 0 4 │

-- │ 7 6 5 │ │ 7 6 5 │

-- └ ┘, └ ┘],

-- Est [┌ ┐ ┌ ┐

-- │ 2 1 3 │ │ 2 1 3 │

-- │ 8 4 0 │ │ 8 0 4 │

-- │ 7 6 5 │ │ 7 6 5 │

-- └ ┘, └ ┘]]

sucesores :: Estado -> [Estado]

sucesores (Est e@(t:_)) =

[Est (t':e) | t' <- tablerosSucesores t,

t' `notElem` e]

-- (tablerosSucesores t) es la lista de los tableros sucesores del

-- tablero t. Por ejemplo,

-- λ> tablerosSucesores (fromLists [[2,1,3],[8,0,4],[7,6,5]])

-- [┌ ┐ ┌ ┐ ┌ ┐ ┌ ┐

-- │ 2 0 3 │ │ 2 1 3 │ │ 2 1 3 │ │ 2 1 3 │

-- │ 8 1 4 │ │ 8 6 4 │ │ 0 8 4 │ │ 8 4 0 │

-- │ 7 6 5 │ │ 7 0 5 │ │ 7 6 5 │ │ 7 6 5 │

-- └ ┘, └ ┘, └ ┘, └ ┘]

tablerosSucesores :: Tablero -> [Tablero]

tablerosSucesores t =

[intercambia t p q | q <- posicionesVecinas p]

where p = posicionHueco t

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

type Posicion = (Int,Int)

-- (posicionesVecinas p) son las posiciones de la matriz cuadrada de

-- dimensión 3 que se encuentran encima, abajo, a la izquierda y a la

-- derecha de los posición p. Por ejemplo,

-- λ> posicionesVecinas (2,2)

-- [(1,2),(3,2),(2,1),(2,3)]

-- λ> posicionesVecinas (1,2)

-- [(2,2),(1,1),(1,3)]

-- λ> posicionesVecinas (1,1)

-- [(2,1),(1,2)]

posicionesVecinas :: Posicion -> [Posicion]

posicionesVecinas (i,j) =

[(i-1,j) | i > 1] ++

[(i+1,j) | i < 3] ++

[(i,j-1) | j > 1] ++

[(i,j+1) | j < 3]

-- (posicionHueco t) es la posición del hueco en el tablero t. Por

-- ejemplo,

-- λ> posicionHueco (fromLists [[2,1,3],[8,0,4],[7,6,5]])

-- (2,2)

posicionHueco :: Tablero -> Posicion

posicionHueco t =

posicionElemento t 0

-- (posicionElemento t a) es la posición de elemento a en el tablero

-- t. Por ejemplo,

-- λ> posicionElemento (fromLists [[2,1,3],[8,0,4],[7,6,5]]) 4

-- (2,3)

posicionElemento :: Tablero -> Int -> Posicion

posicionElemento t a =

head [(i,j) | i <- [1..3],

j <- [1..3],

t ! (i,j) == a]

-- (intercambia t p1 p2) es el tablero obtenido intercambiando en t los

-- elementos que se encuentran en las posiciones p1 y p2. Por ejemplo,

-- λ> intercambia (fromLists [[2,1,3],[8,0,4],[7,6,5]]) (1,2) (2,2)

-- ┌ ┐

-- │ 2 0 3 │

-- │ 8 1 4 │

-- │ 7 6 5 │

-- └ ┘

intercambia :: Tablero -> Posicion -> Posicion -> Tablero

intercambia t p1 p2 =

setElem a2 p1 (setElem a1 p2 t)

where a1 = t ! p1

a2 = t ! p2

-- Heurística

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

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

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

-- ejemplo,

-- λ> heuristica (fromLists [[0,1,3],[8,2,4],[7,6,5]])

-- 4

heuristica :: Tablero -> Int

heuristica t =

sum [distancia (posicionElemento t i)

(posicionElemento tableroFinal i)

| i <- [0..8]]

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

-- Comparación de estados

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

-- Un estado es menor o igual que otro si tiene la heurística de su

-- primer tablero es menor o que la del segundo o so iguales y el

-- primero es más corto.

instance Ord Estado where

Est (t1:ts1) <= Est (t2:ts2) = (heuristica t1 < heuristica t2) ||

((heuristica t1 == heuristica t2) &&

(length ts1 <= length ts2))

-- Verificación

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

verifica :: IO ()

verifica = hspec spec

spec :: Spec

spec = do

it "e1" $

map toLists (solucion_8puzzle (fromLists [[0,1,3],[8,2,4],[7,6,5]]))

`shouldBe` [[[0,1,3],

[8,2,4],

[7,6,5]],

[[1,0,3],

[8,2,4],

[7,6,5]],

[[1,2,3],

[8,0,4],

[7,6,5]]]

it "e2" $

length (solucion_8puzzle (fromLists [[2,6,3],[5,0,4],[1,7,8]]))

`shouldBe` 21

-- La verificación es

-- λ> verifica

-- e1

-- e2

-- Finished in 0.1361 seconds

-- 2 examples, 0 failures

Soluciones en Python

from copy import deepcopy
from typing import Optional

from src.BusquedaPrimeroElMejor import buscaPM

Tablero = list[list[int]]

# Tablero final
# =============

# tableroFinal es el tablero final del 8 puzzle.
tableroFinal: Tablero = [[1,2,3],
                         [8,0,4],
                         [7,6,5]]

# Posiciones
# ==========

# Una posición es un par de enteros.
Posicion = tuple[int,int]

# Heurística
# ==========

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

# posicionElemento(t, a) es la posición de elemento a en el tablero
# t. Por ejemplo,
#    λ> posicionElemento([[2,1,3],[8,0,4],[7,6,5]], 4)
#    (1, 2)
def posicionElemento(t: Tablero, a: int) -> Posicion:
    for i in range(0, 3):
        for j in range(0, 3):
            if t[i][j] == a:
                return (i, j)
    return (4, 4)

# posicionHueco(t) es la posición del hueco en el tablero t. Por
# ejemplo,
#    >>> posicionHueco([[2,1,3],[8,0,4],[7,6,5]])
#    (1, 1)
def posicionHueco(t: Tablero) -> Posicion:
    return posicionElemento(t, 0)

# heuristica(t) es la suma de la distancia Manhatan desde la posición de
# cada objeto del tablero a su posición en el tablero final. Por
# ejemplo,
#    >>> heuristica([[0,1,3],[8,2,4],[7,6,5]])
#    4
def heuristica(t: Tablero) -> int:
    return sum((distancia(posicionElemento(t, i),
                          posicionElemento(tableroFinal, i))
                for i in range(0, 10)))

# Estados
# =======

# Un estado es una tupla (h, n, ts), donde ts es una listas de tableros
# [t_n,...,t_1] tal que t_i es un sucesor de t_(i-1) y h es la
# heurística de t_n.
Estado = tuple[int, int, list[Tablero]]

# Estado inicial
# ==============

# inicial(t) es el estado inicial del problema del 8 puzzle a partir del
# tablero t.
def inicial(t: Tablero) -> Estado:
    return (heuristica(t), 1, [t])

# Estado final
# ============

# esFinal(e) se verifica si e es un estado final.
def esFinal(e: Estado) -> bool:
    (_, _, ts) = e
    return ts[0] == tableroFinal

# Sucesores
# =========

# posicionesVecinas(p) son las posiciones de la matriz cuadrada de
# dimensión 3 que se encuentran encima, abajo, a la izquierda y a la
# derecha de los posición p. Por ejemplo,
#    >>> posicionesVecinas((1,1))
#    [(0, 1), (2, 1), (1, 0), (1, 2)]
#    >>> posicionesVecinas((0,1))
#    [(1, 1), (0, 0), (0, 2)]
#    >>> posicionesVecinas((0,0))
#    [(1, 0), (0, 1)]
def posicionesVecinas(p: Posicion) -> list[Posicion]:
    (i, j) = p
    vecinas = []
    if i > 0:
        vecinas.append((i - 1, j))
    if i < 2:
        vecinas.append((i + 1, j))
    if j > 0:
        vecinas.append((i, j - 1))
    if j < 2:
        vecinas.append((i, j + 1))
    return vecinas

# intercambia(t,p1, p2) es el tablero obtenido intercambiando en t los
# elementos que se encuentran en las posiciones p1 y p2. Por ejemplo,
#    >>> intercambia([[2,1,3],[8,0,4],[7,6,5]], (0,1), (1,1))
#    [[2, 0, 3], [8, 1, 4], [7, 6, 5]]
def intercambia(t: Tablero, p1: Posicion, p2: Posicion) -> Tablero:
    (i1, j1) = p1
    (i2, j2) = p2
    t1 = deepcopy(t)
    a1 = t1[i1][j1]
    a2 = t1[i2][j2]
    t1[i1][j1] = a2
    t1[i2][j2] = a1
    return t1

# tablerosSucesores(t) es la lista de los tablrtos sucesores del
# tablero t. Por ejemplo,
#    >>> tablerosSucesores([[2,1,3],[8,0,4],[7,6,5]])
#    [[[2, 0, 3], [8, 1, 4], [7, 6, 5]],
#     [[2, 1, 3], [8, 6, 4], [7, 0, 5]],
#     [[2, 1, 3], [0, 8, 4], [7, 6, 5]],
#     [[2, 1, 3], [8, 4, 0], [7, 6, 5]]]
def tablerosSucesores(t: Tablero) -> list[Tablero]:
    p = posicionHueco(t)
    return [intercambia(t, p, q) for q in posicionesVecinas(p)]

# (sucesores e) es la lista de sucesores del estado e. Por ejemplo,
#    >>> t1 = [[0,1,3],[8,2,4],[7,6,5]]
#    >>> es = sucesores((heuristica(t1), 1, [t1]))
#    >>> es
#    [(4, 2, [[[8, 1, 3],
#              [0, 2, 4],
#              [7, 6, 5]],
#             [[0, 1, 3],
#              [8, 2, 4],
#              [7, 6, 5]]]),
#     (2, 2, [[[1, 0, 3],
#              [8, 2, 4],
#              [7, 6, 5]],
#             [[0, 1, 3],
#              [8, 2, 4],
#              [7, 6, 5]]])]
#    >>> sucesores(es[1])
#    [(0, 3, [[[1, 2, 3],
#              [8, 0, 4],
#              [7, 6, 5]],
#             [[1, 0, 3],
#              [8, 2, 4],
#              [7, 6, 5]],
#             [[0, 1, 3],
#              [8, 2, 4],
#              [7, 6, 5]]]),
#     (4, 3, [[[1, 3, 0],
#              [8, 2, 4],
#              [7, 6, 5]],
#             [[1, 0, 3],
#              [8, 2, 4],
#              [7, 6, 5]],
#             [[0, 1, 3],
#              [8, 2, 4],
#              [7, 6, 5]]])]
def sucesores(e: Estado) -> list[Estado]:
    (_, n, ts) = e
    return [(heuristica(t1), n+1, [t1] + ts)
            for t1 in tablerosSucesores(ts[0])
            if t1 not in ts]

# Solución
# ========

def solucion_8puzzle(t: Tablero) -> Optional[list[Tablero]]:
    r = buscaPM(sucesores, esFinal, inicial(t))
    if r is None:
        return None
    (_, _, ts) = r
    ts.reverse()
    return ts

# Verificación
# ============

def test_8puzzle() -> None:
    assert solucion_8puzzle([[8,1,3],[0,2,4],[7,6,5]]) == \
        [[[8, 1, 3], [0, 2, 4], [7, 6, 5]],
         [[0, 1, 3], [8, 2, 4], [7, 6, 5]],
         [[1, 0, 3], [8, 2, 4], [7, 6, 5]],
         [[1, 2, 3], [8, 0, 4], [7, 6, 5]]]

# La verificación es
#    src> poetry run pytest -q BPM_8Puzzle.py
#    1 passed in 0.10s

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

from copy import deepcopy

from typing import Optional

from src.BusquedaPrimeroElMejor import buscaPM

Tablero = list[list[int]]

# Tablero final

# =============

# tableroFinal es el tablero final del 8 puzzle.

tableroFinal: Tablero = [[1,2,3],

[8,0,4],

[7,6,5]]

# Posiciones

# ==========

# Una posición es un par de enteros.

Posicion = tuple[int,int]

# Heurística

# ==========

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

# p2. Por ejemplo,

# >>> distancia((2,7), (4,1))

# 8

def distancia(p1: Posicion, p2: Posicion) -> int:

(x1, y1) = p1

(x2, y2) = p2

return abs(x1-x2) + abs (y1-y2)

# posicionElemento(t, a) es la posición de elemento a en el tablero

# t. Por ejemplo,

# λ> posicionElemento([[2,1,3],[8,0,4],[7,6,5]], 4)

# (1, 2)

def posicionElemento(t: Tablero, a: int) -> Posicion:

for i in range(0, 3):

for j in range(0, 3):

if t[i][j] == a:

return (i, j)

return (4, 4)

# posicionHueco(t) es la posición del hueco en el tablero t. Por

# ejemplo,

# >>> posicionHueco([[2,1,3],[8,0,4],[7,6,5]])

# (1, 1)

def posicionHueco(t: Tablero) -> Posicion:

return posicionElemento(t, 0)

# heuristica(t) es la suma de la distancia Manhatan desde la posición de

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

# ejemplo,

# >>> heuristica([[0,1,3],[8,2,4],[7,6,5]])

# 4

def heuristica(t: Tablero) -> int:

return sum((distancia(posicionElemento(t, i),

posicionElemento(tableroFinal, i))

for i in range(0, 10)))

# Estados

# =======

# Un estado es una tupla (h, n, ts), donde ts es una listas de tableros

# [t_n,...,t_1] tal que t_i es un sucesor de t_(i-1) y h es la

# heurística de t_n.

Estado = tuple[int, int, list[Tablero]]

# Estado inicial

# ==============

# inicial(t) es el estado inicial del problema del 8 puzzle a partir del

# tablero t.

def inicial(t: Tablero) -> Estado:

return (heuristica(t), 1, [t])

# Estado final

# ============

# esFinal(e) se verifica si e es un estado final.

def esFinal(e: Estado) -> bool:

(_, _, ts) = e

return ts[0] == tableroFinal

# Sucesores

# =========

# posicionesVecinas(p) son las posiciones de la matriz cuadrada de

# dimensión 3 que se encuentran encima, abajo, a la izquierda y a la

# derecha de los posición p. Por ejemplo,

# >>> posicionesVecinas((1,1))

# [(0, 1), (2, 1), (1, 0), (1, 2)]

# >>> posicionesVecinas((0,1))

# [(1, 1), (0, 0), (0, 2)]

# >>> posicionesVecinas((0,0))

# [(1, 0), (0, 1)]

def posicionesVecinas(p: Posicion) -> list[Posicion]:

(i, j) = p

vecinas = []

if i > 0:

vecinas.append((i - 1, j))

if i < 2:

vecinas.append((i + 1, j))

if j > 0:

vecinas.append((i, j - 1))

if j < 2:

vecinas.append((i, j + 1))

return vecinas

# intercambia(t,p1, p2) es el tablero obtenido intercambiando en t los

# elementos que se encuentran en las posiciones p1 y p2. Por ejemplo,

# >>> intercambia([[2,1,3],[8,0,4],[7,6,5]], (0,1), (1,1))

# [[2, 0, 3], [8, 1, 4], [7, 6, 5]]

def intercambia(t: Tablero, p1: Posicion, p2: Posicion) -> Tablero:

(i1, j1) = p1

(i2, j2) = p2

t1 = deepcopy(t)

a1 = t1[i1][j1]

a2 = t1[i2][j2]

t1[i1][j1] = a2

t1[i2][j2] = a1

return t1

# tablerosSucesores(t) es la lista de los tablrtos sucesores del

# tablero t. Por ejemplo,

# >>> tablerosSucesores([[2,1,3],[8,0,4],[7,6,5]])

# [[[2, 0, 3], [8, 1, 4], [7, 6, 5]],

# [[2, 1, 3], [8, 6, 4], [7, 0, 5]],

# [[2, 1, 3], [0, 8, 4], [7, 6, 5]],

# [[2, 1, 3], [8, 4, 0], [7, 6, 5]]]

def tablerosSucesores(t: Tablero) -> list[Tablero]:

p = posicionHueco(t)

return [intercambia(t, p, q) for q in posicionesVecinas(p)]

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

# >>> t1 = [[0,1,3],[8,2,4],[7,6,5]]

# >>> es = sucesores((heuristica(t1), 1, [t1]))

# >>> es

# [(4, 2, [[[8, 1, 3],

# [0, 2, 4],

# [7, 6, 5]],

# [[0, 1, 3],

# [8, 2, 4],

# [7, 6, 5]]]),

# (2, 2, [[[1, 0, 3],

# [8, 2, 4],

# [7, 6, 5]],

# [[0, 1, 3],

# [8, 2, 4],

# [7, 6, 5]]])]

# >>> sucesores(es[1])

# [(0, 3, [[[1, 2, 3],

# [8, 0, 4],

# [7, 6, 5]],

# [[1, 0, 3],

# [8, 2, 4],

# [7, 6, 5]],

# [[0, 1, 3],

# [8, 2, 4],

# [7, 6, 5]]]),

# (4, 3, [[[1, 3, 0],

# [8, 2, 4],

# [7, 6, 5]],

# [[1, 0, 3],

# [8, 2, 4],

# [7, 6, 5]],

# [[0, 1, 3],

# [8, 2, 4],

# [7, 6, 5]]])]

def sucesores(e: Estado) -> list[Estado]:

(_, n, ts) = e

return [(heuristica(t1), n+1, [t1] + ts)

for t1 in tablerosSucesores(ts[0])

if t1 not in ts]

# Solución

# ========

def solucion_8puzzle(t: Tablero) -> Optional[list[Tablero]]:

r = buscaPM(sucesores, esFinal, inicial(t))

if r is None:

return None

(_, _, ts) = r

ts.reverse()

return ts

# Verificación

# ============

def test_8puzzle() -> None:

assert solucion_8puzzle([[8,1,3],[0,2,4],[7,6,5]]) == \

[[[8, 1, 3], [0, 2, 4], [7, 6, 5]],

[[0, 1, 3], [8, 2, 4], [7, 6, 5]],

[[1, 0, 3], [8, 2, 4], [7, 6, 5]],

[[1, 2, 3], [8, 0, 4], [7, 6, 5]]]

# La verificación es

# src> poetry run pytest -q BPM_8Puzzle.py

# 1 passed in 0.10s

Búsqueda por primero el mejor

PorJosé A. Alonso 6-julio-20237-julio-2023

En la búsqueda por primero el mejor se supone que los estados están ordenados mediante una función, la heurística, que es una estimación de su coste para llegar a un estado final.

Definir la función

   buscaPM :: Ord n => (n -> [n]) -> (n -> Bool) -> n -> [n]

1	buscaPM :: Ord n => (n -> [n]) -> (n -> Bool) -> n -> [n]

tal que 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 estado inicial e, obtenidas buscando por primero el mejor.

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BusquedaPrimeroElMejor (buscaPM)  where

import TAD.ColaDePrioridad (esVacia, inserta, primero, resto, vacia)

buscaPM :: Ord n => (n -> [n]) -> (n -> Bool) -> n -> [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 (primero c)))

module BusquedaPrimeroElMejor (buscaPM) where

import TAD.ColaDePrioridad (esVacia, inserta, primero, resto, vacia)

buscaPM :: Ord n => (n -> [n]) -> (n -> Bool) -> n -> [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 (primero c)))

Soluciones en Python

from __future__ import annotations

from abc import abstractmethod
from functools import reduce
from typing import Callable, Optional, Protocol, TypeVar

from src.TAD.ColaDePrioridad import (CPrioridad, esVacia, inserta, primero,
                                     resto, vacia)


class Comparable(Protocol):
    @abstractmethod
    def __lt__(self: A, otro: A) -> bool:
        pass

A = TypeVar('A', bound=Comparable)

def buscaPM(sucesores: Callable[[A], list[A]],
            esFinal: Callable[[A], bool],
            inicial: A) -> Optional[A]:
    c: CPrioridad[A] = inserta(inicial, vacia())

    while not esVacia(c):
        if esFinal(primero(c)):
            return primero(c)

        es = sucesores(primero(c))
        c = reduce(lambda x, y: inserta(y, x), es, resto(c))

    return None

from __future__ import annotations

from abc import abstractmethod

from functools import reduce

from typing import Callable, Optional, Protocol, TypeVar

from src.TAD.ColaDePrioridad import (CPrioridad, esVacia, inserta, primero,

resto, vacia)

class Comparable(Protocol):

@abstractmethod

def __lt__(self: A, otro: A) -> bool:

pass

A = TypeVar('A', bound=Comparable)

def buscaPM(sucesores: Callable[[A], list[A]],

esFinal: Callable[[A], bool],

inicial: A) -> Optional[A]:

c: CPrioridad[A] = inserta(inicial, vacia())

while not esVacia(c):

if esFinal(primero(c)):

return primero(c)

es = sucesores(primero(c))

c = reduce(lambda x, y: inserta(y, x), es, resto(c))

return None

El problema de la mochila (mediante espacio de estados)

PorJosé A. Alonso 4-julio-20231-julio-2023

Se tiene una mochila de capacidad de peso p y una lista de n para colocar en la mochila. Cada objeto i tiene un peso w(i) y un valor v(i). Considerando la posibilidad de colocar el mismo objeto varias veces en la mochila, el problema consiste en determinar la forma de colocar los objetos en la mochila sin sobrepasar la capacidad de la mochila colocando el máximo valor posible.

Para solucionar el problema se definen los siguientes tipos:

Una solución del problema de la mochila es una lista de objetos.

     type SolMoch = [Objeto]

1	type SolMoch = [Objeto]

Los objetos son pares formado por un peso y un valor

     type Objeto = (Peso,Valor)

1	type Objeto = (Peso,Valor)

Los pesos son número enteros

     type Peso = Int

1	type Peso = Int

Los valores son números reales.

     type Valor = Float

1	type Valor = Float

Los estados del problema de la mochila son 5-tupla de la (v,p,l,o,s) donde v es el valor de los objetos colocados, p es el peso de los objetos colocados, l es el límite de la capacidad de la mochila, o es la lista de los objetos colocados (ordenados de forma creciente según sus pesos) y s es la solución parcial.

     type NodoMoch = (Valor,Peso,Peso,[Objeto],SolMoch)

1	type NodoMoch = (Valor,Peso,Peso,[Objeto],SolMoch)

Usando el procedimiento de búsqueda en profundidad, definir la función

   mochila :: [Objeto] -> Peso -> (SolMoch,Valor)

1	mochila :: [Objeto] -> Peso -> (SolMoch,Valor)

tal que mochila os l es la solución del problema de la mochila para la lista de objetos os y el límite de capacidad l. Por ejemplo,

   > mochila [(2,3),(3,5),(4,6),(5,10)] 8
   ([(5,10.0),(3,5.0)],15.0)
   > mochila [(2,3),(3,5),(5,6)] 10
   ([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)
   > mochila [(8,15),(15,10),(3,6),(6,13),(2,4),(4,8),(5,6),(7,7)] 35
   ([(6,13.0),(6,13.0),(6,13.0),(6,13.0),(6,13.0),(3,6.0),(2,4.0)],75.0)
   > mochila [(2,2.8),(3,4.4),(5,6.1)] 10
   ([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)

> mochila [(2,3),(3,5),(4,6),(5,10)] 8

([(5,10.0),(3,5.0)],15.0)

> mochila [(2,3),(3,5),(5,6)] 10

([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)

> mochila [(8,15),(15,10),(3,6),(6,13),(2,4),(4,8),(5,6),(7,7)] 35

([(6,13.0),(6,13.0),(6,13.0),(6,13.0),(6,13.0),(3,6.0),(2,4.0)],75.0)

> mochila [(2,2.8),(3,4.4),(5,6.1)] 10

([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BEE_Mochila where

import BusquedaEnProfundidad (buscaProfundidad)
import Data.List (sort)
import Test.Hspec (Spec, hspec, it, shouldBe)

type Peso     = Int
type Valor    = Float
type Objeto   = (Peso,Valor)
type SolMoch  = [Objeto]
type NodoMoch = (Valor,Peso,Peso,[Objeto],SolMoch)

mochila :: [Objeto] -> Peso -> (SolMoch,Valor)
mochila os l = (sol,v)
  where
    (v,_,_,_,sol) =
      maximum (buscaProfundidad sucesoresMoch
                                esObjetivoMoch
                                (inicial os l))

-- (inicial os l) es el estado inicial del problema de la mochila
-- para la lista de objetos os y el límite de capacidad l
inicial :: [Objeto] -> Peso -> NodoMoch
inicial os l =
  (0,0,l,sort os,[])

-- (sucesoresMoch e) es la lista de los sucesores del estado e en el
-- problema de la mochila para la lista de objetos os y el límite de
-- capacidad l.
sucesoresMoch :: NodoMoch -> [NodoMoch]
sucesoresMoch (v,p,l,os,solp) =
  [( v+v',
     p+p',
     l,
     [o | o@(p'',_) <- os, p''>=p'],
     (p',v'):solp )
  | (p',v') <- os,
    p+p' <= l]

-- (esObjetivoMoch e) se verifica si e es un estado final el problema de
-- la mochila para la lista de objetos os y el límite de capacidad l .
esObjetivoMoch :: NodoMoch -> Bool
esObjetivoMoch (_,p,l,(p',_):_,_) = p+p'>l

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    mochila [(2,3),(3,5),(4,6),(5,10)] 8
    `shouldBe` ([(5,10.0),(3,5.0)],15.0)
  it "e2" $
    mochila [(2,3),(3,5),(5,6)] 10
    `shouldBe` ([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)
  it "e3" $
    mochila [(8,15),(15,10),(3,6),(6,13),(2,4),(4,8),(5,6),(7,7)] 35
    `shouldBe` ([(6,13.0),(6,13.0),(6,13.0),(6,13.0),(6,13.0),(3,6.0),(2,4.0)],75.0)
  it "e4" $
    mochila [(2,2.8),(3,4.4),(5,6.1)] 10
    `shouldBe` ([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)

-- La verificación es
--    λ> verifica
--
--    e1
--    e2
--    e3
--    e4
--
--    Finished in 0.0424 seconds
--    4 examples, 0 failures

module BEE_Mochila where

import BusquedaEnProfundidad (buscaProfundidad)

import Data.List (sort)

import Test.Hspec (Spec, hspec, it, shouldBe)

type Peso = Int

type Valor = Float

type Objeto = (Peso,Valor)

type SolMoch = [Objeto]

type NodoMoch = (Valor,Peso,Peso,[Objeto],SolMoch)

mochila :: [Objeto] -> Peso -> (SolMoch,Valor)

mochila os l = (sol,v)

where

(v,_,_,_,sol) =

maximum (buscaProfundidad sucesoresMoch

esObjetivoMoch

(inicial os l))

-- (inicial os l) es el estado inicial del problema de la mochila

-- para la lista de objetos os y el límite de capacidad l

inicial :: [Objeto] -> Peso -> NodoMoch

inicial os l =

(0,0,l,sort os,[])

-- (sucesoresMoch e) es la lista de los sucesores del estado e en el

-- problema de la mochila para la lista de objetos os y el límite de

-- capacidad l.

sucesoresMoch :: NodoMoch -> [NodoMoch]

sucesoresMoch (v,p,l,os,solp) =

[( v+v',

p+p',

[o | o@(p'',_) <- os, p''>=p'],

(p',v'):solp )

| (p',v') <- os,

p+p' <= l]

-- (esObjetivoMoch e) se verifica si e es un estado final el problema de

-- la mochila para la lista de objetos os y el límite de capacidad l .

esObjetivoMoch :: NodoMoch -> Bool

esObjetivoMoch (_,p,l,(p',_):_,_) = p+p'>l

-- Verificación

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

verifica :: IO ()

verifica = hspec spec

spec :: Spec

spec = do

it "e1" $

mochila [(2,3),(3,5),(4,6),(5,10)] 8

`shouldBe` ([(5,10.0),(3,5.0)],15.0)

it "e2" $

mochila [(2,3),(3,5),(5,6)] 10

`shouldBe` ([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)

it "e3" $

mochila [(8,15),(15,10),(3,6),(6,13),(2,4),(4,8),(5,6),(7,7)] 35

`shouldBe` ([(6,13.0),(6,13.0),(6,13.0),(6,13.0),(6,13.0),(3,6.0),(2,4.0)],75.0)

it "e4" $

mochila [(2,2.8),(3,4.4),(5,6.1)] 10

`shouldBe` ([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)

-- La verificación es

-- λ> verifica

-- e1

-- e2

-- e3

-- e4

-- Finished in 0.0424 seconds

-- 4 examples, 0 failures

Soluciones en Python

from src.BusquedaEnProfundidad import buscaProfundidad

Peso = int
Valor = float
Objeto = tuple[Peso, Valor]
SolMoch = list[Objeto]
NodoMoch = tuple[Valor, Peso, Peso, list[Objeto], SolMoch]

# inicial(os, l) es el estado inicial del problema de la mochila
# para la lista de objetos os y el límite de capacidad l
def inicial(os: list[Objeto], l: Peso) -> NodoMoch:
    return (0,0,l,sorted(os),[])

# sucesoresMoch(e) es la lista de los sucesores del estado e en el
# problema de la mochila para la lista de objetos os y el límite de
# capacidad l.
def sucesoresMoch(n: NodoMoch) -> list[NodoMoch]:
    (v,p,l,os,solp) = n
    return [( v+v1,
              p+p1,
              l,
              [(p2,v2) for (p2,v2) in os if p2 >= p1],
              [(p1,v1)] + solp )
            for (p1,v1) in os if p + p1 <= l]

# esObjetivoMoch(e) se verifica si e es un estado final el problema de
# la mochila para la lista de objetos os y el límite de capacidad l .
def esObjetivoMoch(e: NodoMoch) -> bool:
    (_, p, l, os, _) = e
    (p_, _) = os[0]
    return p + p_ > l

def mochila(os: list[Objeto], l: Peso) -> tuple[SolMoch, Valor]:
    (v,_,_,_,sol) = max(buscaProfundidad(sucesoresMoch,
                                         esObjetivoMoch,
                                         inicial(os, l)))
    return (sol, v)

# Verificación
# ============

def test_Mochila() -> None:
    assert mochila([(2,3),(3,5),(4,6),(5,10)], 8) == \
        ([(5,10.0),(3,5.0)],15.0)
    assert mochila([(2,3),(3,5),(5,6)], 10) == \
        ([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)
    assert mochila([(2,2.8),(3,4.4),(5,6.1)], 10) == \
        ([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)
    print("Verificado")

# La verificación es
#    >>> test_Mochila()
#    Verificado

from src.BusquedaEnProfundidad import buscaProfundidad

Peso = int

Valor = float

Objeto = tuple[Peso, Valor]

SolMoch = list[Objeto]

NodoMoch = tuple[Valor, Peso, Peso, list[Objeto], SolMoch]

# inicial(os, l) es el estado inicial del problema de la mochila

# para la lista de objetos os y el límite de capacidad l

def inicial(os: list[Objeto], l: Peso) -> NodoMoch:

return (0,0,l,sorted(os),[])

# sucesoresMoch(e) es la lista de los sucesores del estado e en el

# problema de la mochila para la lista de objetos os y el límite de

# capacidad l.

def sucesoresMoch(n: NodoMoch) -> list[NodoMoch]:

(v,p,l,os,solp) = n

return [( v+v1,

p+p1,

[(p2,v2) for (p2,v2) in os if p2 >= p1],

[(p1,v1)] + solp )

for (p1,v1) in os if p + p1 <= l]

# esObjetivoMoch(e) se verifica si e es un estado final el problema de

# la mochila para la lista de objetos os y el límite de capacidad l .

def esObjetivoMoch(e: NodoMoch) -> bool:

(_, p, l, os, _) = e

(p_, _) = os[0]

return p + p_ > l

def mochila(os: list[Objeto], l: Peso) -> tuple[SolMoch, Valor]:

(v,_,_,_,sol) = max(buscaProfundidad(sucesoresMoch,

esObjetivoMoch,

inicial(os, l)))

return (sol, v)

# Verificación

# ============

def test_Mochila() -> None:

assert mochila([(2,3),(3,5),(4,6),(5,10)], 8) == \

([(5,10.0),(3,5.0)],15.0)

assert mochila([(2,3),(3,5),(5,6)], 10) == \

([(3,5.0),(3,5.0),(2,3.0),(2,3.0)],16.0)

assert mochila([(2,2.8),(3,4.4),(5,6.1)], 10) == \

([(3,4.4),(3,4.4),(2,2.8),(2,2.8)],14.4)

print("Verificado")

# La verificación es

# >>> test_Mochila()

# Verificado

El problema de las n reinas (mediante búsqueda por anchura en espacios de estados)

PorJosé A. Alonso 3-julio-202328-junio-2023

El problema de las n reinas consiste en colocar n reinas en un tablero cuadrado de dimensiones n por n de forma que no se encuentren más de una en la misma línea: horizontal, vertical o diagonal.

Las posiciones de las reinas en el tablero se representan por su columna y su fila.

   type Columna = Int
   type Fila    = Int

1 2	type Columna = Int type Fila = Int

Una solución del problema de las n reinas es una lista de posiciones.

   type SolNR = [(Columna,Fila)]

1	type SolNR = [(Columna,Fila)]

Usando el procedimiento de búsqueda en anchura, definir las funciones

   solucionesNR      :: Columna -> [SolNR]
   primeraSolucionNR :: Columna -> SolNR
   nSolucionesNR     :: Columna -> Int

solucionesNR :: Columna -> [SolNR]

primeraSolucionNR :: Columna -> SolNR

nSolucionesNR :: Columna -> Int

tales que

solucionesNR n es la lista de las soluciones del problema de las n reinas, por búsqueda de espacio de estados en anchura. Por ejemplo,

     take 3 (solucionesNR 8)
     [[(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)],
      [(1,8),(2,3),(3,1),(4,6),(5,2),(6,5),(7,7),(8,4)],
      [(1,8),(2,2),(3,5),(4,3),(5,1),(6,7),(7,4),(8,6)]]

take 3 (solucionesNR 8)

[[(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)],

[(1,8),(2,3),(3,1),(4,6),(5,2),(6,5),(7,7),(8,4)],

[(1,8),(2,2),(3,5),(4,3),(5,1),(6,7),(7,4),(8,6)]]

primeraSolucionNR n es la primera solución del problema de las n reinas, por búsqueda en espacio de estados por anchura. Por ejemplo,

     λ> primeraSolucionNR 8
     [(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)]

1 2	λ> primeraSolucionNR 8 [(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)]

nSolucionesNR n es el número de soluciones del problema de las n reinas, por búsqueda en espacio de estados. Por ejemplo,

     nSolucionesNR 8  ==  92

1	nSolucionesNR 8 == 92

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BEE_Reinas_Anchura where

import BusquedaEnAnchura (buscaAnchura)
import Test.Hspec (Spec, hspec, it, shouldBe)

type Columna = Int
type Fila    = Int
type SolNR = [(Columna,Fila)]

-- Los nodos del problema de las n reinas son ternas formadas por la
-- columna de la última reina colocada, el número de columnas del
-- tablero y la solución parcial de las reinas colocadas anteriormente.
type NodoNR = (Columna,Columna,SolNR)

solucionesNR :: Columna -> [SolNR]
solucionesNR n =
  map estado (buscaAnchura sucesoresNR esFinalNR (1,n,[]))
  where
    estado (_,_,e) = e

primeraSolucionNR :: Columna -> SolNR
primeraSolucionNR =
  head . solucionesNR

nSolucionesNR :: Columna -> Int
nSolucionesNR =
  length . solucionesNR

-- (valida sp p) se verifica si la posición p es válida respecto de la
-- solución parcial sp; es decir, la reina en la posición p no amenaza a
-- ninguna de las reinas de la sp (se supone que están en distintas
-- columnas). Por ejemplo,
--    valida [(1,1)] (2,2)  ==  False
--    valida [(1,1)] (2,3)  ==  True
valida :: SolNR -> (Columna,Fila) -> Bool
valida solp (c,r) = and [test s | s <- solp]
  where test (c',r') = c'+r'/=c+r && c'-r'/=c-r && r'/=r

-- (sucesoresNR e) es la lista de los sucesores del estado e en el
-- problema de las n reinas. Por ejemplo,
--    λ> sucesoresNR (1,4,[])
--    [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]
sucesoresNR :: NodoNR -> [NodoNR]
sucesoresNR (c,n,solp) =
  [(c+1,n,solp ++ [(c,r)]) | r <- [1..n] , valida solp (c,r)]

-- (esFinalNR e) se verifica si e es un estado final del problema de las
-- n reinas.
esFinalNR :: NodoNR -> Bool
esFinalNR (c,n,_) = c > n

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    take 3 (solucionesNR 8) `shouldBe`
    [[(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)],
     [(1,8),(2,3),(3,1),(4,6),(5,2),(6,5),(7,7),(8,4)],
     [(1,8),(2,2),(3,5),(4,3),(5,1),(6,7),(7,4),(8,6)]]
  it "e2" $
    nSolucionesNR 8 `shouldBe` 92

-- La verificación es
--    λ> verifica
--
--    e1
--    e2
--
--    Finished in 0.2116 seconds
--    2 examples, 0 failures

module BEE_Reinas_Anchura where

import BusquedaEnAnchura (buscaAnchura)

import Test.Hspec (Spec, hspec, it, shouldBe)

type Columna = Int

type Fila = Int

type SolNR = [(Columna,Fila)]

-- Los nodos del problema de las n reinas son ternas formadas por la

-- columna de la última reina colocada, el número de columnas del

-- tablero y la solución parcial de las reinas colocadas anteriormente.

type NodoNR = (Columna,Columna,SolNR)

solucionesNR :: Columna -> [SolNR]

solucionesNR n =

map estado (buscaAnchura sucesoresNR esFinalNR (1,n,[]))

where

estado (_,_,e) = e

primeraSolucionNR :: Columna -> SolNR

primeraSolucionNR =

head . solucionesNR

nSolucionesNR :: Columna -> Int

nSolucionesNR =

length . solucionesNR

-- (valida sp p) se verifica si la posición p es válida respecto de la

-- solución parcial sp; es decir, la reina en la posición p no amenaza a

-- ninguna de las reinas de la sp (se supone que están en distintas

-- columnas). Por ejemplo,

-- valida [(1,1)] (2,2) == False

-- valida [(1,1)] (2,3) == True

valida :: SolNR -> (Columna,Fila) -> Bool

valida solp (c,r) = and [test s | s <- solp]

where test (c',r') = c'+r'/=c+r && c'-r'/=c-r && r'/=r

-- (sucesoresNR e) es la lista de los sucesores del estado e en el

-- problema de las n reinas. Por ejemplo,

-- λ> sucesoresNR (1,4,[])

-- [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]

sucesoresNR :: NodoNR -> [NodoNR]

sucesoresNR (c,n,solp) =

[(c+1,n,solp ++ [(c,r)]) | r <- [1..n] , valida solp (c,r)]

-- (esFinalNR e) se verifica si e es un estado final del problema de las

-- n reinas.

esFinalNR :: NodoNR -> Bool

esFinalNR (c,n,_) = c > n

-- Verificación

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

verifica :: IO ()

verifica = hspec spec

spec :: Spec

spec = do

it "e1" $

take 3 (solucionesNR 8) `shouldBe`

[[(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)],

[(1,8),(2,3),(3,1),(4,6),(5,2),(6,5),(7,7),(8,4)],

[(1,8),(2,2),(3,5),(4,3),(5,1),(6,7),(7,4),(8,6)]]

it "e2" $

nSolucionesNR 8 `shouldBe` 92

-- La verificación es

-- λ> verifica

-- e1

-- e2

-- Finished in 0.2116 seconds

-- 2 examples, 0 failures

Soluciones en Python

from src.BusquedaEnAnchura import buscaAnchura

Columna = int
Fila = int
SolNR = list[tuple[Columna, Fila]]

# Los nodos del problema de las n reinas son ternas formadas por la
# columna de la última reina colocada, el número de columnas del
# tablero y la solución parcial de las reinas colocadas anteriormente.
NodoNR = tuple[Columna, Columna, SolNR]

# valida(sp, p) se verifica si la posición p es válida respecto de la
# solución parcial sp; es decir, la reina en la posición p no amenaza a
# ninguna de las reinas de la sp (se supone que están en distintas
# columnas). Por ejemplo,
#    valida([(1,1)], (2,2))  ==  False
#    valida([(1,1)], (2,3))  ==  True
def valida(sp: SolNR, p: tuple[Columna, Fila]) -> bool:
    c, r = p
    def test(s: tuple[Columna, Fila]) -> bool:
        c1, r1 = s
        return c1 + r1 != c + r and c1 - r1 != c - r and r1 != r

    return all(test(s) for s in sp)

# sucesoresNR(e) es la lista de los sucesores del estado e en el
# problema de las n reinas. Por ejemplo,
#    >>> sucesoresNR((1,4,[]))
#    [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]
def sucesoresNR (nd: NodoNR) -> list[NodoNR]:
    c,n,solp = nd
    return [(c+1,n,solp + [(c,r)]) for r in range(1, n+1) if valida(solp, (c,r))]

# esFinalNR(e) se verifica si e es un estado final del problema de las
# n reinas.
def esFinalNR(nd: NodoNR) -> bool:
    c, n, _ = nd
    return c > n

def solucionesNR(n: int) -> list[SolNR]:
    nInicial: NodoNR = (1,n,[])
    return [e for (_, _, e) in buscaAnchura(sucesoresNR,
                                            esFinalNR,
                                            nInicial)]

def primeraSolucionNR(n: int) -> SolNR:
    return solucionesNR(n)[0]

def nSolucionesNR(n: int) -> int:
    return len(solucionesNR(n))

# Verificación
# ============

def test_nReinas() -> None:
    assert solucionesNR(5)[:3] == \
        [[(1,1),(2,3),(3,5),(4,2),(5,4)],
         [(1,1),(2,4),(3,2),(4,5),(5,3)],
         [(1,2),(2,4),(3,1),(4,3),(5,5)]]
    assert nSolucionesNR(5) == 10
    print("Verificado")

# La verificación es
#    >>> test_nReinas()
#    Verificado

from src.BusquedaEnAnchura import buscaAnchura

Columna = int

Fila = int

SolNR = list[tuple[Columna, Fila]]

# Los nodos del problema de las n reinas son ternas formadas por la

# columna de la última reina colocada, el número de columnas del

# tablero y la solución parcial de las reinas colocadas anteriormente.

NodoNR = tuple[Columna, Columna, SolNR]

# valida(sp, p) se verifica si la posición p es válida respecto de la

# solución parcial sp; es decir, la reina en la posición p no amenaza a

# ninguna de las reinas de la sp (se supone que están en distintas

# columnas). Por ejemplo,

# valida([(1,1)], (2,2)) == False

# valida([(1,1)], (2,3)) == True

def valida(sp: SolNR, p: tuple[Columna, Fila]) -> bool:

c, r = p

def test(s: tuple[Columna, Fila]) -> bool:

c1, r1 = s

return c1 + r1 != c + r and c1 - r1 != c - r and r1 != r

return all(test(s) for s in sp)

# sucesoresNR(e) es la lista de los sucesores del estado e en el

# problema de las n reinas. Por ejemplo,

# >>> sucesoresNR((1,4,[]))

# [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]

def sucesoresNR (nd: NodoNR) -> list[NodoNR]:

c,n,solp = nd

return [(c+1,n,solp + [(c,r)]) for r in range(1, n+1) if valida(solp, (c,r))]

# esFinalNR(e) se verifica si e es un estado final del problema de las

# n reinas.

def esFinalNR(nd: NodoNR) -> bool:

c, n, _ = nd

return c > n

def solucionesNR(n: int) -> list[SolNR]:

nInicial: NodoNR = (1,n,[])

return [e for (_, _, e) in buscaAnchura(sucesoresNR,

esFinalNR,

nInicial)]

def primeraSolucionNR(n: int) -> SolNR:

return solucionesNR(n)[0]

def nSolucionesNR(n: int) -> int:

return len(solucionesNR(n))

# Verificación

# ============

def test_nReinas() -> None:

assert solucionesNR(5)[:3] == \

[[(1,1),(2,3),(3,5),(4,2),(5,4)],

[(1,1),(2,4),(3,2),(4,5),(5,3)],

[(1,2),(2,4),(3,1),(4,3),(5,5)]]

assert nSolucionesNR(5) == 10

print("Verificado")

# La verificación es

# >>> test_nReinas()

# Verificado

Búsqueda por anchura en espacios de estados

PorJosé A. Alonso 30-junio-202328-junio-2023

Las características de los problemas de espacios de estados son:

un conjunto de las posibles situaciones o nodos que constituye el espacio de estados (estos son las potenciales soluciones que se necesitan explorar),
un conjunto de movimientos de un nodo a otros nodos, llamados los sucesores del nodo,
un nodo inicial y
un nodo objetivo que es la solución.

Definir la función

   buscaAnchura :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool)
                              -> nodo -> [nodo]

1 2	buscaAnchura :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool) -> nodo -> [nodo]

tal que buscaAnchura 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 estado inicial e obtenidas mediante búsqueda en anchura.

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BusquedaEnAnchura (buscaAnchura) where

import TAD.Cola (esVacia, inserta, primero, resto, vacia)

buscaAnchura :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool)
                               -> nodo -> [nodo]
buscaAnchura sucesores esFinal inicial =
  aux (inserta inicial vacia)
  where
    aux p
      | esVacia p        = []
      | esFinal (primero p) = primero p : aux (resto p)
      | otherwise        = aux (foldr
                                inserta
                                (resto p)
                                (sucesores (primero p)))

module BusquedaEnAnchura (buscaAnchura) where

import TAD.Cola (esVacia, inserta, primero, resto, vacia)

buscaAnchura :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool)

-> nodo -> [nodo]

buscaAnchura sucesores esFinal inicial =

aux (inserta inicial vacia)

where

aux p

| esVacia p = []

| esFinal (primero p) = primero p : aux (resto p)

| otherwise = aux (foldr

inserta

(resto p)

(sucesores (primero p)))

Soluciones en Python

from functools import reduce
from sys import setrecursionlimit
from typing import Callable, TypeVar

from src.TAD.cola import Cola, esVacia, inserta, primero, resto, vacia

A = TypeVar('A')

setrecursionlimit(10**6)

def buscaAnchura(sucesores: Callable[[A], list[A]],
                  esFinal: Callable[[A], bool],
                  inicial: A) -> list[A]:
    def aux(p: Cola[A]) -> list[A]:
        if esVacia(p):
            return []
        if esFinal(primero(p)):
            return [primero(p)] + aux(resto(p))
        return aux(reduce(lambda x, y: inserta(y, x),
                          sucesores(primero(p)),
                          resto(p)))

    return aux (inserta(inicial, vacia()))

from functools import reduce

from sys import setrecursionlimit

from typing import Callable, TypeVar

from src.TAD.cola import Cola, esVacia, inserta, primero, resto, vacia

A = TypeVar('A')

setrecursionlimit(10**6)

def buscaAnchura(sucesores: Callable[[A], list[A]],

esFinal: Callable[[A], bool],

inicial: A) -> list[A]:

def aux(p: Cola[A]) -> list[A]:

if esVacia(p):

return []

if esFinal(primero(p)):

return [primero(p)] + aux(resto(p))

return aux(reduce(lambda x, y: inserta(y, x),

sucesores(primero(p)),

resto(p)))

return aux (inserta(inicial, vacia()))

El problema de las n reinas (mediante búsqueda por profundidad en espacios de estados)

PorJosé A. Alonso 29-junio-202328-junio-2023

El problema de las n reinas consiste en colocar n reinas en un tablero cuadrado de dimensiones n por n de forma que no se encuentren más de una en la misma línea: horizontal, vertical o diagonal.

Las posiciones de las reinas en el tablero se representan por su columna y su fila.

   type Columna = Int
   type Fila    = Int

1 2	type Columna = Int type Fila = Int

Una solución del problema de las n reinas es una lista de posiciones.

   type SolNR = [(Columna,Fila)]

1	type SolNR = [(Columna,Fila)]

Usando el procedimiento de búsqueda en profundidad, definir las funciones

   solucionesNR      :: Columna -> [SolNR]
   primeraSolucionNR :: Columna -> SolNR
   nSolucionesNR     :: Columna -> Int

solucionesNR :: Columna -> [SolNR]

primeraSolucionNR :: Columna -> SolNR

nSolucionesNR :: Columna -> Int

tales que

solucionesNR n es la lista de las soluciones del problema de las n reinas, por búsqueda de espacio de estados en profundidad. Por ejemplo,

     take 3 (solucionesNR 8)
     [[(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)],
      [(1,1),(2,6),(3,8),(4,3),(5,7),(6,4),(7,2),(8,5)],
      [(1,1),(2,7),(3,4),(4,6),(5,8),(6,2),(7,5),(8,3)]]

take 3 (solucionesNR 8)

[[(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)],

[(1,1),(2,6),(3,8),(4,3),(5,7),(6,4),(7,2),(8,5)],

[(1,1),(2,7),(3,4),(4,6),(5,8),(6,2),(7,5),(8,3)]]

primeraSolucionNR n es la primera solución del problema de las n reinas, por búsqueda en espacio de estados por profundidad. Por ejemplo,

     λ> primeraSolucionNR 8
     [(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)]

1 2	λ> primeraSolucionNR 8 [(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)]

nSolucionesNR n es el número de soluciones del problema de las n reinas, por búsqueda en espacio de estados. Por ejemplo,

     nSolucionesNR 8  ==  92

1	nSolucionesNR 8 == 92

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BEE_Reinas_Profundidad where

import BusquedaEnProfundidad (buscaProfundidad)
import Test.Hspec (Spec, hspec, it, shouldBe)

type Columna = Int
type Fila    = Int
type SolNR = [(Columna,Fila)]

-- Los nodos del problema de las n reinas son ternas formadas por la
-- columna de la última reina colocada, el número de columnas del
-- tablero y la solución parcial de las reinas colocadas anteriormente.
type NodoNR = (Columna,Columna,SolNR)

solucionesNR :: Columna -> [SolNR]
solucionesNR n =
  map estado (buscaProfundidad sucesoresNR esFinalNR (1,n,[]))
  where
    estado (_,_,e) = e

primeraSolucionNR :: Columna -> SolNR
primeraSolucionNR =
  head . solucionesNR

nSolucionesNR :: Columna -> Int
nSolucionesNR =
  length . solucionesNR

-- (valida sp p) se verifica si la posición p es válida respecto de la
-- solución parcial sp; es decir, la reina en la posición p no amenaza a
-- ninguna de las reinas de la sp (se supone que están en distintas
-- columnas). Por ejemplo,
--    valida [(1,1)] (2,2)  ==  False
--    valida [(1,1)] (2,3)  ==  True
valida :: SolNR -> (Columna,Fila) -> Bool
valida solp (c,r) = and [test s | s <- solp]
  where test (c',r') = c'+r'/=c+r && c'-r'/=c-r && r'/=r

-- (sucesoresNR e) es la lista de los sucesores del estado e en el
-- problema de las n reinas. Por ejemplo,
--    λ> sucesoresNR (1,4,[])
--    [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]
sucesoresNR :: NodoNR -> [NodoNR]
sucesoresNR (c,n,solp) =
  [(c+1,n,solp ++ [(c,r)]) | r <- [1..n] , valida solp (c,r)]

-- (esFinalNR e) se verifica si e es un estado final del problema de las
-- n reinas.
esFinalNR :: NodoNR -> Bool
esFinalNR (c,n,_) = c > n

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    take 3 (solucionesNR 8) `shouldBe`
    [[(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)],
     [(1,1),(2,6),(3,8),(4,3),(5,7),(6,4),(7,2),(8,5)],
     [(1,1),(2,7),(3,4),(4,6),(5,8),(6,2),(7,5),(8,3)]]
  it "e2" $
    nSolucionesNR 8 `shouldBe` 92

-- La verificación es
--    λ> verifica
--
--    e1
--    e2
--
--    Finished in 0.1173 seconds
--    2 examples, 0 failures

module BEE_Reinas_Profundidad where

import BusquedaEnProfundidad (buscaProfundidad)

import Test.Hspec (Spec, hspec, it, shouldBe)

type Columna = Int

type Fila = Int

type SolNR = [(Columna,Fila)]

-- Los nodos del problema de las n reinas son ternas formadas por la

-- columna de la última reina colocada, el número de columnas del

-- tablero y la solución parcial de las reinas colocadas anteriormente.

type NodoNR = (Columna,Columna,SolNR)

solucionesNR :: Columna -> [SolNR]

solucionesNR n =

map estado (buscaProfundidad sucesoresNR esFinalNR (1,n,[]))

where

estado (_,_,e) = e

primeraSolucionNR :: Columna -> SolNR

primeraSolucionNR =

head . solucionesNR

nSolucionesNR :: Columna -> Int

nSolucionesNR =

length . solucionesNR

-- (valida sp p) se verifica si la posición p es válida respecto de la

-- solución parcial sp; es decir, la reina en la posición p no amenaza a

-- ninguna de las reinas de la sp (se supone que están en distintas

-- columnas). Por ejemplo,

-- valida [(1,1)] (2,2) == False

-- valida [(1,1)] (2,3) == True

valida :: SolNR -> (Columna,Fila) -> Bool

valida solp (c,r) = and [test s | s <- solp]

where test (c',r') = c'+r'/=c+r && c'-r'/=c-r && r'/=r

-- (sucesoresNR e) es la lista de los sucesores del estado e en el

-- problema de las n reinas. Por ejemplo,

-- λ> sucesoresNR (1,4,[])

-- [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]

sucesoresNR :: NodoNR -> [NodoNR]

sucesoresNR (c,n,solp) =

[(c+1,n,solp ++ [(c,r)]) | r <- [1..n] , valida solp (c,r)]

-- (esFinalNR e) se verifica si e es un estado final del problema de las

-- n reinas.

esFinalNR :: NodoNR -> Bool

esFinalNR (c,n,_) = c > n

-- Verificación

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

verifica :: IO ()

verifica = hspec spec

spec :: Spec

spec = do

it "e1" $

take 3 (solucionesNR 8) `shouldBe`

[[(1,1),(2,5),(3,8),(4,6),(5,3),(6,7),(7,2),(8,4)],

[(1,1),(2,6),(3,8),(4,3),(5,7),(6,4),(7,2),(8,5)],

[(1,1),(2,7),(3,4),(4,6),(5,8),(6,2),(7,5),(8,3)]]

it "e2" $

nSolucionesNR 8 `shouldBe` 92

-- La verificación es

-- λ> verifica

-- e1

-- e2

-- Finished in 0.1173 seconds

-- 2 examples, 0 failures

Soluciones en Python

from src.BusquedaEnProfundidad import buscaProfundidad

Columna = int
Fila = int
SolNR = list[tuple[Columna, Fila]]

# Los nodos del problema de las n reinas son ternas formadas por la
# columna de la última reina colocada, el número de columnas del
# tablero y la solución parcial de las reinas colocadas anteriormente.
NodoNR = tuple[Columna, Columna, SolNR]

# valida(sp, p) se verifica si la posición p es válida respecto de la
# solución parcial sp; es decir, la reina en la posición p no amenaza a
# ninguna de las reinas de la sp (se supone que están en distintas
# columnas). Por ejemplo,
#    valida([(1,1)], (2,2))  ==  False
#    valida([(1,1)], (2,3))  ==  True
def valida(sp: SolNR, p: tuple[Columna, Fila]) -> bool:
    c, r = p
    def test(s: tuple[Columna, Fila]) -> bool:
        c1, r1 = s
        return c1 + r1 != c + r and c1 - r1 != c - r and r1 != r

    return all(test(s) for s in sp)

# sucesoresNR(e) es la lista de los sucesores del estado e en el
# problema de las n reinas. Por ejemplo,
#    >>> sucesoresNR((1,4,[]))
#    [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]
def sucesoresNR (nd: NodoNR) -> list[NodoNR]:
    c,n,solp = nd
    return [(c+1,n,solp + [(c,r)]) for r in range(1, n+1) if valida(solp, (c,r))]

# esFinalNR(e) se verifica si e es un estado final del problema de las
# n reinas.
def esFinalNR(nd: NodoNR) -> bool:
    c, n, _ = nd
    return c > n

def solucionesNR(n: int) -> list[SolNR]:
    nInicial: NodoNR = (1,n,[])
    return [e for (_, _, e) in buscaProfundidad(sucesoresNR,
                                                esFinalNR,
                                                nInicial)]

def primeraSolucionNR(n: int) -> SolNR:
    return solucionesNR(n)[0]

def nSolucionesNR(n: int) -> int:
    return len(solucionesNR(n))

# Verificación
# ============

def test_nReinas() -> None:
    assert solucionesNR(8)[:3] == \
        [[(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)],
         [(1,8),(2,3),(3,1),(4,6),(5,2),(6,5),(7,7),(8,4)],
         [(1,8),(2,2),(3,5),(4,3),(5,1),(6,7),(7,4),(8,6)]]
    assert nSolucionesNR(8) == 92
    print("Verificado")

# La verificación es
#    >>> test_nReinas()
#    Verificado

from src.BusquedaEnProfundidad import buscaProfundidad

Columna = int

Fila = int

SolNR = list[tuple[Columna, Fila]]

# Los nodos del problema de las n reinas son ternas formadas por la

# columna de la última reina colocada, el número de columnas del

# tablero y la solución parcial de las reinas colocadas anteriormente.

NodoNR = tuple[Columna, Columna, SolNR]

# valida(sp, p) se verifica si la posición p es válida respecto de la

# solución parcial sp; es decir, la reina en la posición p no amenaza a

# ninguna de las reinas de la sp (se supone que están en distintas

# columnas). Por ejemplo,

# valida([(1,1)], (2,2)) == False

# valida([(1,1)], (2,3)) == True

def valida(sp: SolNR, p: tuple[Columna, Fila]) -> bool:

c, r = p

def test(s: tuple[Columna, Fila]) -> bool:

c1, r1 = s

return c1 + r1 != c + r and c1 - r1 != c - r and r1 != r

return all(test(s) for s in sp)

# sucesoresNR(e) es la lista de los sucesores del estado e en el

# problema de las n reinas. Por ejemplo,

# >>> sucesoresNR((1,4,[]))

# [(2,4,[(1,1)]),(2,4,[(1,2)]),(2,4,[(1,3)]),(2,4,[(1,4)])]

def sucesoresNR (nd: NodoNR) -> list[NodoNR]:

c,n,solp = nd

return [(c+1,n,solp + [(c,r)]) for r in range(1, n+1) if valida(solp, (c,r))]

# esFinalNR(e) se verifica si e es un estado final del problema de las

# n reinas.

def esFinalNR(nd: NodoNR) -> bool:

c, n, _ = nd

return c > n

def solucionesNR(n: int) -> list[SolNR]:

nInicial: NodoNR = (1,n,[])

return [e for (_, _, e) in buscaProfundidad(sucesoresNR,

esFinalNR,

nInicial)]

def primeraSolucionNR(n: int) -> SolNR:

return solucionesNR(n)[0]

def nSolucionesNR(n: int) -> int:

return len(solucionesNR(n))

# Verificación

# ============

def test_nReinas() -> None:

assert solucionesNR(8)[:3] == \

[[(1,8),(2,4),(3,1),(4,3),(5,6),(6,2),(7,7),(8,5)],

[(1,8),(2,3),(3,1),(4,6),(5,2),(6,5),(7,7),(8,4)],

[(1,8),(2,2),(3,5),(4,3),(5,1),(6,7),(7,4),(8,6)]]

assert nSolucionesNR(8) == 92

print("Verificado")

# La verificación es

# >>> test_nReinas()

# Verificado

Búsqueda en espacios de estados por profundidad

PorJosé A. Alonso 28-junio-202327-junio-2023

Las características de los problemas de espacios de estados son:

un conjunto de las posibles situaciones o nodos que constituye el espacio de estados (estos son las potenciales soluciones que se necesitan explorar),
un conjunto de movimientos de un nodo a otros nodos, llamados los sucesores del nodo,
un nodo inicial y
un nodo objetivo que es la solución.

Definir la función

   buscaProfundidad :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool)
                                  -> nodo -> [nodo]

1 2	buscaProfundidad :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool) -> nodo -> [nodo]

tal que buscaProfundidad 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 estado inicial e obtenidas mediante búsqueda en profundidad.

Soluciones

A continuación se muestran las soluciones en Haskell y las soluciones en Python.

Soluciones en Haskell

module BusquedaEnProfundidad (buscaProfundidad) where

import TAD.Pila (apila, cima, desapila, esVacia, vacia)

buscaProfundidad :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool)
                               -> nodo -> [nodo]
buscaProfundidad sucesores esFinal inicial =
  aux (apila inicial vacia)
  where
    aux p
      | esVacia p        = []
      | esFinal (cima p) = cima p : aux (desapila p)
      | otherwise        = aux (foldr
                                apila
                                (desapila p)
                                (sucesores (cima p)))

module BusquedaEnProfundidad (buscaProfundidad) where

import TAD.Pila (apila, cima, desapila, esVacia, vacia)

buscaProfundidad :: Eq nodo => (nodo -> [nodo]) -> (nodo -> Bool)

-> nodo -> [nodo]

buscaProfundidad sucesores esFinal inicial =

aux (apila inicial vacia)

where

aux p

| esVacia p = []

| esFinal (cima p) = cima p : aux (desapila p)

| otherwise = aux (foldr

apila

(desapila p)

(sucesores (cima p)))

Soluciones en Python

from functools import reduce
from sys import setrecursionlimit
from typing import Callable, TypeVar

from src.TAD.pila import Pila, apila, cima, desapila, esVacia, vacia

A = TypeVar('A')

setrecursionlimit(10**6)

def buscaProfundidad1(sucesores: Callable[[A], list[A]],
                      esFinal: Callable[[A], bool],
                      inicial: A) -> list[A]:
    def aux(p: Pila[A]) -> list[A]:
        if esVacia(p):
            return []
        if esFinal(cima(p)):
            return [cima(p)] + aux(desapila(p))
        return aux(reduce(lambda x, y: apila(y, x),
                          sucesores(cima(p)),
                          desapila(p)))

    return aux(apila(inicial, vacia()))

from functools import reduce

from sys import setrecursionlimit

from typing import Callable, TypeVar

from src.TAD.pila import Pila, apila, cima, desapila, esVacia, vacia

A = TypeVar('A')

setrecursionlimit(10**6)

def buscaProfundidad1(sucesores: Callable[[A], list[A]],

esFinal: Callable[[A], bool],

inicial: A) -> list[A]:

def aux(p: Pila[A]) -> list[A]:

if esVacia(p):

return []

if esFinal(cima(p)):

return [cima(p)] + aux(desapila(p))

return aux(reduce(lambda x, y: apila(y, x),

sucesores(cima(p)),

desapila(p)))

return aux(apila(inicial, vacia()))

Caminos en un grafo

PorJosé A. Alonso 28-mayo-20204-junio-2020

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

[[1,3,5,2],[1,3,7,5,2]]

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
  where ns = map fst as ++ map snd as
        m  = minimum ns
        n  = maximum ns

-- 1ª solución
-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
  aux [] = []
  aux ((x:xs):yss)
    | x == a    = (x:xs) : aux yss
    | otherwise = aux ([z:x:xs | z <- adyacentes g x
                               , z `notElem` (x:xs)] 
                       ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
  where inicial          = [b]
        sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
        esFinal (x:xs)   = x == a

-- Comparación de eficiencia
-- =========================

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

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

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

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

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Sucesiones de listas de números

PorJosé A. Alonso 31-mayo-201926-marzo-2022

En la Olimpiada Internacional de Matemáticas del 2012 se propuso el siguiente problema:

Varios enteros positivos se escriben en una lista. Iterativamente, Alicia elige dos números adyacentes x e y tales que x > y y x está a la izquierda de y y reemplaza el par (x,y) por (y+1,x) o (x-1,x). Demostrar que sólo puede aplicar un número finito de dichas iteraciones.

Por ejemplo, las transformadas de la lista [1,3,2] son [1,2,3] y [1,3,3] y las dos obtenidas son finales (es decir, no se les puede aplicar ninguna transformación).

Definir las funciones

   soluciones :: [Int] -> [Estado]
   finales :: [Int] -> [[Int]]
   finalesMaximales :: [Int] -> (Int,[[Int]])

soluciones :: [Int] -> [Estado]

finales :: [Int] -> [[Int]]

finalesMaximales :: [Int] -> (Int,[[Int]])

tales que

(soluciones xs) es la lista de pares (n,ys) tales que ys es una lista final obtenida aplicándole n transformaciones a xs. Por ejemplo,

     λ> soluciones [1,3,2]
     [(1,[1,3,3]),(1,[1,2,3])]
     λ> sort (nub (soluciones [3,3,2]))
     [(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]
     λ> sort (nub (soluciones [3,2,1]))
     [(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

λ> soluciones [1,3,2]

[(1,[1,3,3]),(1,[1,2,3])]

λ> sort (nub (soluciones [3,3,2]))

[(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]

λ> sort (nub (soluciones [3,2,1]))

[(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

(finales xs) son las listas obtenidas transformando xs y a las que no se les puede aplicar más transformaciones. Por ejemplo,

     finales [1,2,3]               ==  [[1,2,3]]
     finales [1,3,2]               ==  [[1,2,3],[1,3,3]]
     finales [3,2,1]               ==  [[2,2,3],[2,3,3],[3,3,3]]
     finales [1,3,2,4]             ==  [[1,2,3,4],[1,3,3,4]]
     finales [1,3,2,3]             ==  [[1,2,3,3],[1,3,3,3]]
     length (finales [9,6,0,7,2])  ==  19
     length (finales [80,60..0])   ==  420

finales [1,2,3] == [[1,2,3]]

finales [1,3,2] == [[1,2,3],[1,3,3]]

finales [3,2,1] == [[2,2,3],[2,3,3],[3,3,3]]

finales [1,3,2,4] == [[1,2,3,4],[1,3,3,4]]

finales [1,3,2,3] == [[1,2,3,3],[1,3,3,3]]

length (finales [9,6,0,7,2]) == 19

length (finales [80,60..0]) == 420

(finalesMaximales xs) es el par (n,yss) tal que la longitud de las cadenas más largas de transformaciones a partir de xs e yss es la lista de los estados finales a partir de xs con n transformaciones. Por ejemplo,

     finalesMaximales [9,5,7]   ==  (2,[[6,8,9],[8,8,9]])
     finalesMaximales [3,2,1]   ==  (4,[[2,3,3],[3,3,3]])
     finalesMaximales [3,2..0]  ==  (10,[[2,3,3,3],[3,3,3,3]])
     finalesMaximales [4,3..0]  ==  (20,[[3,4,4,4,4],[4,4,4,4,4]])

finalesMaximales [9,5,7] == (2,[[6,8,9],[8,8,9]])

finalesMaximales [3,2,1] == (4,[[2,3,3],[3,3,3]])

finalesMaximales [3,2..0] == (10,[[2,3,3,3],[3,3,3,3]])

finalesMaximales [4,3..0] == (20,[[3,4,4,4,4],[4,4,4,4,4]])

Soluciones

[schedule expon=’2019-06-07′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 07 de junio.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

Siempre que nos vemos
es cita para mañana.
Nunca nos encontraremos.

Antonio Machado

[/schedule]

[schedule on=’2019-06-07′ at=»06:00″]

import Data.List (nub, sort)
import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado
inicial xs = (0,xs)

esFinal :: Estado -> Bool
esFinal e = null (sucesores e)

--    λ> sucesores [9,6,0,7,2]
--    [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]
sucesores :: Estado -> [Estado]
sucesores (_,[])  = []
sucesores (_,[_]) = []
sucesores (n,x:y:xs)
  | x > y     = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss
  | otherwise = yss
  where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]
                       
soluciones :: [Int] -> [Estado]
soluciones xs =
  buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]
finales xs =
  sort (nub (map snd (soluciones xs)))
            
finalesMaximales :: [Int] -> (Int,[[Int]])
finalesMaximales xs =
  (m, [xs | (n,xs) <- es, n == m])
  where es    = sort (nub (soluciones xs))
        (m,_) = maximum es

import Data.List (nub, sort)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado

inicial xs = (0,xs)

esFinal :: Estado -> Bool

esFinal e = null (sucesores e)

-- λ> sucesores [9,6,0,7,2]

-- [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]

sucesores :: Estado -> [Estado]

sucesores (_,[]) = []

sucesores (_,[_]) = []

sucesores (n,x:y:xs)

| x > y = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss

| otherwise = yss

where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]

soluciones :: [Int] -> [Estado]

soluciones xs =

buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]

finales xs =

sort (nub (map snd (soluciones xs)))

finalesMaximales :: [Int] -> (Int,[[Int]])

finalesMaximales xs =

(m, [xs | (n,xs) <- es, n == m])

where es = sort (nub (soluciones xs))

(m,_) = maximum es

[/schedule]

Descomposiciones de N como sumas de 1, 3 ó 4.

PorJosé A. Alonso 24-mayo-201831-mayo-2018

El número 5 se puede descomponer en 6 formas distintas como sumas cuyos sumandos sean 1, 3 ó 4:

   5 = 1 + 1 + 1 + 1 + 1
   5 = 1 + 1 + 3
   5 = 1 + 3 + 1
   5 = 3 + 1 + 1
   5 = 1 + 4
   5 = 4 + 1

5 = 1 + 1 + 1 + 1 + 1

5 = 1 + 1 + 3

5 = 1 + 3 + 1

5 = 3 + 1 + 1

5 = 1 + 4

5 = 4 + 1

Definir las funciones

   descomposiciones  :: Integer -> [[Integer]]
   nDescomposiciones :: Integer -> Integer

1 2	descomposiciones :: Integer -> [[Integer]] nDescomposiciones :: Integer -> Integer

tales que

(descomposiciones n) es la lista de las descomposiciones de n como sumas cuyos sumandos sean 1, 3 ó 4. Por ejemplo,

      λ> descomposiciones1 4
      [[4],[3,1],[1,3],[1,1,1,1]]
      λ> descomposiciones1 5
      [[4,1],[1,4],[3,1,1],[1,3,1],[1,1,3],[1,1,1,1,1]]
      λ> descomposiciones1 6
      [[3,3],[4,1,1],[1,4,1],[1,1,4],[3,1,1,1],[1,3,1,1],[1,1,3,1],
       [1,1,1,3],[1,1,1,1,1,1]]

λ> descomposiciones1 4

[[4],[3,1],[1,3],[1,1,1,1]]

λ> descomposiciones1 5

[[4,1],[1,4],[3,1,1],[1,3,1],[1,1,3],[1,1,1,1,1]]

λ> descomposiciones1 6

[[3,3],[4,1,1],[1,4,1],[1,1,4],[3,1,1,1],[1,3,1,1],[1,1,3,1],

[1,1,1,3],[1,1,1,1,1,1]]

(nDescomposiciones n) es el número de descomposiciones de n como sumas cuyos sumandos sean 1, 3 ó 4. Por ejemplo,

     nDescomposiciones 5                       ==  6
     nDescomposiciones 10                      ==  64
     nDescomposiciones 20                      ==  7921
     nDescomposiciones 30                      ==  974169
     length (show (nDescomposiciones (10^5)))  ==  20899

nDescomposiciones 5 == 6

nDescomposiciones 10 == 64

nDescomposiciones 20 == 7921

nDescomposiciones 30 == 974169

length (show (nDescomposiciones (10^5))) == 20899

Nota: Se puede usar programación dinámica.

Soluciones

import Data.List (genericLength)
import Data.Array

-- 1ª definición de descomposiciones (espacios de estado)
-- ======================================================

descomposiciones1 :: Integer -> [[Integer]]
descomposiciones1 n = busca [inicial]
  where
    busca []        = []
    busca (e:es)  
      | esFinal n e = e : busca es
      | otherwise   = busca (es ++ sucesores n e)

-- Un estado es la lista de monedas usadas hasta ahora.
type Estado = [Integer] 

-- inicial es el estado inicial del problema; es decir, cuando no se
-- ha usado ninguna moneda.
inicial :: Estado
inicial = []

-- (esFinal n e) es verifica si e es un estado final del problema n. Por
-- ejemplo, 
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal :: Integer -> Estado -> Bool
esFinal n xs = sum xs == n

-- (sucesores n e) es la lista de los sucesores del estado e en el
-- problema n. Por ejemplo, 
--    sucesores (8,5,3) (8,0,0)  ==  [(3,5,0),(5,0,3)]
--    sucesores (8,5,3) (3,5,0)  ==  [(0,5,3),(8,0,0),(3,2,3)]
sucesores :: Integer -> Estado -> [Estado]
sucesores n xs =
     [1:xs | 1 + k <= n]
  ++ [3:xs | 3 + k <= n]
  ++ [4:xs | 4 + k <= n]
  where k = sum xs

-- 2ª definición de descomposiciones (espacios de estado)
-- ======================================================

descomposiciones2 :: Integer -> [[Integer]]
descomposiciones2 n = busca [inicial2 n]
  where
    busca []       = []
    busca (e:es)  
      | esFinal2 e = snd e : busca es
      | otherwise  = busca (es ++ sucesores2 n e)

-- Un estado es una par formado por la cantidad a conseguir y la lista
-- de monedas usadas hasta ahora.
type Estado2 = (Integer,[Integer]) 

-- (inicial2 n) es el estado inicial del problema; es decir, cuando no se
-- ha usado ninguna moneda.
inicial2 :: Integer -> Estado2
inicial2 n = (n,[])

-- (esFinal2 e) es verifica si e es un estado final del problema. Por
-- ejemplo, 
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal2 :: Estado2 -> Bool
esFinal2 (k,_) = k == 0

-- (sucesores2 n e) es la lista de los sucesores del estado e en el
-- problema n. Por ejemplo, 
--    sucesores (8,5,3) (8,0,0)  ==  [(3,5,0),(5,0,3)]
--    sucesores (8,5,3) (3,5,0)  ==  [(0,5,3),(8,0,0),(3,2,3)]
sucesores2 :: Integer -> Estado2 -> [Estado2]
sucesores2 n (k,xs) =
     [(k-1, 1:xs) | k >= 1]
  ++ [(k-3, 3:xs) | k >= 3]
  ++ [(k-4, 4:xs) | k >= 4]

-- 3ª definición de descomposiciones
-- =================================

descomposiciones3 :: Integer -> [[Integer]]
descomposiciones3 0 = [[]]
descomposiciones3 1 = [[1]]
descomposiciones3 2 = [[1,1]]
descomposiciones3 3 = [[1,1,1],[3]]
descomposiciones3 n =
     [1:xs | xs <- descomposiciones3 (n-1)]
  ++ [3:xs | xs <- descomposiciones3 (n-3)]
  ++ [4:xs | xs <- descomposiciones3 (n-4)]  

-- 4ª definición de descomposiciones (dinámica)
-- ============================================

descomposiciones4 :: Integer -> [[Integer]]
descomposiciones4 n = v!n
  where v = array (0,n) [(i,aux v i) | i <- [0..n]] 
        aux v 0 = [[]]
        aux v 1 = [[1]]
        aux v 2 = [[1,1]]
        aux v 3 = [[1,1,1],[3]]
        aux v k =    map (1:) (v!(k-1))
                  ++ map (3:) (v!(k-3))
                  ++ map (4:) (v!(k-4))

-- 1ª definición de nDescomposiciones
-- ==================================

nDescomposiciones1 :: Integer -> Integer
nDescomposiciones1 =
  genericLength . descomposiciones1

-- 2ª definición de nDescomposiciones
-- ==================================

nDescomposiciones2 :: Integer -> Integer
nDescomposiciones2 =
  genericLength . descomposiciones2

-- 3ª definición de nDescomposiciones
-- ==================================

nDescomposiciones3 :: Integer -> Integer
nDescomposiciones3 =
  genericLength . descomposiciones3

-- 4ª definición de nDescomposiciones
-- ==================================

nDescomposiciones4 :: Integer -> Integer
nDescomposiciones4 =
  genericLength . descomposiciones4

-- 5ª definición de nDescomposiciones (dinámica)
-- =============================================

nDescomposiciones5 :: Integer -> Integer
nDescomposiciones5 n = v!n
  where v = array (0,n) [(i,aux v i) | i <- [0..n]] 
        aux v 0 = 1
        aux v 1 = 1
        aux v 2 = 1
        aux v 3 = 2
        aux v k = v!(k-1) + v!(k-3) + v!(k-4)

-- Comparación de eficiencia
-- =========================

--    λ> nDescomposiciones1 20
--    7921
--    (3.21 secs, 3,199,383,064 bytes)
--    λ> nDescomposiciones2 20
--    7921
--    (3.17 secs, 3,176,666,880 bytes)
--    λ> nDescomposiciones3 20
--    7921
--    (0.08 secs, 17,714,152 bytes)
--    
--    λ> nDescomposiciones3 27
--    229970
--    (3.73 secs, 628,730,968 bytes)
--    λ> nDescomposiciones4 27
--    229970
--    (0.45 secs, 111,518,016 bytes)
--    
--    λ> nDescomposiciones4 30
--    974169
--    (2.02 secs, 454,484,992 bytes)
--    λ> nDescomposiciones5 30
--    974169
--    (0.00 secs, 0 bytes)

--    λ> nDescomposiciones2 30
--    974169
--    (2.10 secs, 441,965,208 bytes)
--    λ> nDescomposiciones3 30
--    974169
--    (0.00 secs, 0 bytes)
--    
--    λ> length (show (nDescomposiciones5 (10^5)))
--    20899
--    (3.00 secs, 1,050,991,880 bytes)

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

import Data.List (genericLength)

import Data.Array

-- 1ª definición de descomposiciones (espacios de estado)

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

descomposiciones1 :: Integer -> [[Integer]]

descomposiciones1 n = busca [inicial]

where

busca [] = []

busca (e:es)

| esFinal n e = e : busca es

| otherwise = busca (es ++ sucesores n e)

-- Un estado es la lista de monedas usadas hasta ahora.

type Estado = [Integer]

-- inicial es el estado inicial del problema; es decir, cuando no se

-- ha usado ninguna moneda.

inicial :: Estado

inicial = []

-- (esFinal n e) es verifica si e es un estado final del problema n. Por

-- ejemplo,

-- esFinal (8,5,3) (4,4,0) == True

-- esFinal (8,5,3) (4,0,4) == False

esFinal :: Integer -> Estado -> Bool

esFinal n xs = sum xs == n

-- (sucesores n e) es la lista de los sucesores del estado e en el

-- problema n. Por ejemplo,

-- sucesores (8,5,3) (8,0,0) == [(3,5,0),(5,0,3)]

-- sucesores (8,5,3) (3,5,0) == [(0,5,3),(8,0,0),(3,2,3)]

sucesores :: Integer -> Estado -> [Estado]

sucesores n xs =

[1:xs | 1 + k <= n]

++ [3:xs | 3 + k <= n]

++ [4:xs | 4 + k <= n]

where k = sum xs

-- 2ª definición de descomposiciones (espacios de estado)

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

descomposiciones2 :: Integer -> [[Integer]]

descomposiciones2 n = busca [inicial2 n]

where

busca [] = []

busca (e:es)

| esFinal2 e = snd e : busca es

| otherwise = busca (es ++ sucesores2 n e)

-- Un estado es una par formado por la cantidad a conseguir y la lista

-- de monedas usadas hasta ahora.

type Estado2 = (Integer,[Integer])

-- (inicial2 n) es el estado inicial del problema; es decir, cuando no se

-- ha usado ninguna moneda.

inicial2 :: Integer -> Estado2

inicial2 n = (n,[])

-- (esFinal2 e) es verifica si e es un estado final del problema. Por

-- ejemplo,

-- esFinal (8,5,3) (4,4,0) == True

-- esFinal (8,5,3) (4,0,4) == False

esFinal2 :: Estado2 -> Bool

esFinal2 (k,_) = k == 0

-- (sucesores2 n e) es la lista de los sucesores del estado e en el

-- problema n. Por ejemplo,

-- sucesores (8,5,3) (8,0,0) == [(3,5,0),(5,0,3)]

-- sucesores (8,5,3) (3,5,0) == [(0,5,3),(8,0,0),(3,2,3)]

sucesores2 :: Integer -> Estado2 -> [Estado2]

sucesores2 n (k,xs) =

[(k-1, 1:xs) | k >= 1]

++ [(k-3, 3:xs) | k >= 3]

++ [(k-4, 4:xs) | k >= 4]

-- 3ª definición de descomposiciones

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

descomposiciones3 :: Integer -> [[Integer]]

descomposiciones3 0 = [[]]

descomposiciones3 1 = [[1]]

descomposiciones3 2 = [[1,1]]

descomposiciones3 3 = [[1,1,1],[3]]

descomposiciones3 n =

[1:xs | xs <- descomposiciones3 (n-1)]

++ [3:xs | xs <- descomposiciones3 (n-3)]

++ [4:xs | xs <- descomposiciones3 (n-4)]

-- 4ª definición de descomposiciones (dinámica)

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

descomposiciones4 :: Integer -> [[Integer]]

descomposiciones4 n = v!n

where v = array (0,n) [(i,aux v i) | i <- [0..n]]

aux v 0 = [[]]

aux v 1 = [[1]]

aux v 2 = [[1,1]]

aux v 3 = [[1,1,1],[3]]

aux v k = map (1:) (v!(k-1))

++ map (3:) (v!(k-3))

++ map (4:) (v!(k-4))

-- 1ª definición de nDescomposiciones

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

nDescomposiciones1 :: Integer -> Integer

nDescomposiciones1 =

genericLength . descomposiciones1

-- 2ª definición de nDescomposiciones

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

nDescomposiciones2 :: Integer -> Integer

nDescomposiciones2 =

genericLength . descomposiciones2

-- 3ª definición de nDescomposiciones

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

nDescomposiciones3 :: Integer -> Integer

nDescomposiciones3 =

genericLength . descomposiciones3

-- 4ª definición de nDescomposiciones

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

nDescomposiciones4 :: Integer -> Integer

nDescomposiciones4 =

genericLength . descomposiciones4

-- 5ª definición de nDescomposiciones (dinámica)

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

nDescomposiciones5 :: Integer -> Integer

nDescomposiciones5 n = v!n

where v = array (0,n) [(i,aux v i) | i <- [0..n]]

aux v 0 = 1

aux v 1 = 1

aux v 2 = 1

aux v 3 = 2

aux v k = v!(k-1) + v!(k-3) + v!(k-4)

-- Comparación de eficiencia

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

-- λ> nDescomposiciones1 20

-- 7921

-- (3.21 secs, 3,199,383,064 bytes)

-- λ> nDescomposiciones2 20

-- 7921

-- (3.17 secs, 3,176,666,880 bytes)

-- λ> nDescomposiciones3 20

-- 7921

-- (0.08 secs, 17,714,152 bytes)

-- λ> nDescomposiciones3 27

-- 229970

-- (3.73 secs, 628,730,968 bytes)

-- λ> nDescomposiciones4 27

-- 229970

-- (0.45 secs, 111,518,016 bytes)

-- λ> nDescomposiciones4 30

-- 974169

-- (2.02 secs, 454,484,992 bytes)

-- λ> nDescomposiciones5 30

-- 974169

-- (0.00 secs, 0 bytes)

-- λ> nDescomposiciones2 30

-- 974169

-- (2.10 secs, 441,965,208 bytes)

-- λ> nDescomposiciones3 30

-- 974169

-- (0.00 secs, 0 bytes)

-- λ> length (show (nDescomposiciones5 (10^5)))

-- 20899

-- (3.00 secs, 1,050,991,880 bytes)

Caminos en un grafo

PorJosé A. Alonso 18-mayo-201825-abril-2021

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

[[1,3,5,2],[1,3,7,5,2]]

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
    where ns = map fst as ++ map snd as
          m  = minimum ns
          n  = maximum ns

-- 1ª solución
-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
    aux [] = []
    aux ((x:xs):yss)
        | x == a    = (x:xs) : aux yss
        | otherwise = aux ([z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
                           ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
    where inicial          = [b]
          sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                     , z `notElem` (x:xs)] 
          esFinal (x:xs)   = x == a

-- Comparación de eficiencia
-- =========================

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

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

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

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

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Sucesiones de listas de números

PorJosé A. Alonso 31-mayo-201726-marzo-2022

En la Olimpiada Internacional de Matemáticas del 2012 se propuso el siguiente problema:

Varios enteros positivos se escriben en una lista. Iterativamente, Alicia elige dos números adyacentes x e y tales que x > y y x está a la izquierda de y y reemplaza el par (x,y) por (y+1,x) o (x-1,x). Demostrar que sólo puede aplicar un número finito de dichas iteraciones.

Por ejemplo, las transformadas de la lista [1,3,2] son [1,2,3] y [1,3,3] y las dos obtenidas son finales (es decir, no se les puede aplicar ninguna transformación).

Definir las funciones

   soluciones :: [Int] -> [Estado]
   finales :: [Int] -> [[Int]]
   finalesMaximales :: [Int] -> (Int,[[Int]])

soluciones :: [Int] -> [Estado]

finales :: [Int] -> [[Int]]

finalesMaximales :: [Int] -> (Int,[[Int]])

tales que

(soluciones xs) es la lista de pares (n,ys) tales que ys es una lista final obtenida aplicándole n transformaciones a xs. Por ejemplo,

     λ> soluciones [1,3,2]
     [(1,[1,3,3]),(1,[1,2,3])]
     λ> sort (nub (soluciones [3,3,2]))
     [(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]
     λ> sort (nub (soluciones [3,2,1]))
     [(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

λ> soluciones [1,3,2]

[(1,[1,3,3]),(1,[1,2,3])]

λ> sort (nub (soluciones [3,3,2]))

[(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]

λ> sort (nub (soluciones [3,2,1]))

[(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

(finales xs) son las listas obtenidas transformando xs y a las que no se les puede aplicar más transformaciones. Por ejemplo,

     finales [1,2,3]               ==  [[1,2,3]]
     finales [1,3,2]               ==  [[1,2,3],[1,3,3]]
     finales [3,2,1]               ==  [[2,2,3],[2,3,3],[3,3,3]]
     finales [1,3,2,4]             ==  [[1,2,3,4],[1,3,3,4]]
     finales [1,3,2,3]             ==  [[1,2,3,3],[1,3,3,3]]
     length (finales [9,6,0,7,2])  ==  19
     length (finales [80,60..0])   ==  420

finales [1,2,3] == [[1,2,3]]

finales [1,3,2] == [[1,2,3],[1,3,3]]

finales [3,2,1] == [[2,2,3],[2,3,3],[3,3,3]]

finales [1,3,2,4] == [[1,2,3,4],[1,3,3,4]]

finales [1,3,2,3] == [[1,2,3,3],[1,3,3,3]]

length (finales [9,6,0,7,2]) == 19

length (finales [80,60..0]) == 420

(finalesMaximales xs) es el par (n,yss) tal que la longitud de las cadenas más largas de transformaciones a partir de xs e yss es la lista de los estados finales a partir de xs con n transformaciones. Por ejemplo,

     finalesMaximales [9,5,7]   ==  (2,[[6,8,9],[8,8,9]])
     finalesMaximales [3,2,1]   ==  (4,[[2,3,3],[3,3,3]])
     finalesMaximales [3,2..0]  ==  (10,[[2,3,3,3],[3,3,3,3]])
     finalesMaximales [4,3..0]  ==  (20,[[3,4,4,4,4],[4,4,4,4,4]])

finalesMaximales [9,5,7] == (2,[[6,8,9],[8,8,9]])

finalesMaximales [3,2,1] == (4,[[2,3,3],[3,3,3]])

finalesMaximales [3,2..0] == (10,[[2,3,3,3],[3,3,3,3]])

finalesMaximales [4,3..0] == (20,[[3,4,4,4,4],[4,4,4,4,4]])

Soluciones

[schedule expon=’2017-06-07′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 07 de junio.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-06-07′ at=»06:00″]

import Data.List (nub, sort)
import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado
inicial xs = (0,xs)

esFinal :: Estado -> Bool
esFinal e = null (sucesores e)

--    λ> sucesores [9,6,0,7,2]
--    [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]
sucesores :: Estado -> [Estado]
sucesores (_,[])  = []
sucesores (_,[_]) = []
sucesores (n,x:y:xs) | x > y     = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss
                     | otherwise = yss
    where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]
                       

soluciones :: [Int] -> [Estado]
soluciones xs =
    buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]
finales xs =
    sort (nub (map snd (soluciones xs)))
            
finalesMaximales :: [Int] -> (Int,[[Int]])
finalesMaximales xs =
    (m, [xs | (n,xs) <- es, n == m])
    where es    = sort (nub (soluciones xs))
          (m,_) = maximum es

import Data.List (nub, sort)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado

inicial xs = (0,xs)

esFinal :: Estado -> Bool

esFinal e = null (sucesores e)

-- λ> sucesores [9,6,0,7,2]

-- [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]

sucesores :: Estado -> [Estado]

sucesores (_,[]) = []

sucesores (_,[_]) = []

sucesores (n,x:y:xs) | x > y = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss

| otherwise = yss

where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]

soluciones :: [Int] -> [Estado]

soluciones xs =

buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]

finales xs =

sort (nub (map snd (soluciones xs)))

finalesMaximales :: [Int] -> (Int,[[Int]])

finalesMaximales xs =

(m, [xs | (n,xs) <- es, n == m])

where es = sort (nub (soluciones xs))

(m,_) = maximum es

[/schedule]

Caminos en un grafo

PorJosé A. Alonso 17-mayo-201726-marzo-2022

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

[[1,3,5,2],[1,3,7,5,2]]

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Nota: Este ejercicio debe realizarse usando únicamente las funciones de la librería de grafos (I1M.Grafo) que se describe aquí y se encuentra aquí.

Soluciones

[schedule expon=’2017-05-24′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 24 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-05-24′ at=»06:00″]

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
    where ns = map fst as ++ map snd as
          m  = minimum ns
          n  = maximum ns

-- 1ª solución
-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
    aux [] = []
    aux ((x:xs):yss)
        | x == a    = (x:xs) : aux yss
        | otherwise = aux ([z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
                           ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
    where inicial          = [b]
          sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                     , z `notElem` (x:xs)] 
          esFinal (x:xs)   = x == a

-- Comparación de eficiencia
-- =========================

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

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

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

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

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

[/schedule]

Problema del dominó

PorJosé A. Alonso 16-mayo-201726-marzo-2022

Las fichas del dominó se pueden representar por pares de números enteros. El problema del dominó consiste en colocar todas las fichas de una lista dada de forma que el segundo número de cada ficha coincida con el primero de la siguiente.

Definir la función

   domino :: [(Int,Int)] -> [[(Int,Int)]]

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   λ> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   λ> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   λ> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   λ> domino [(1,2),(2,3),(5,4)]
   []
   λ> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])
   9
   λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0
   λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])
   84480

λ> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

λ> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

λ> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)]]

λ> domino [(1,2),(2,3),(5,4)]

[]

λ> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

[(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]

[(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]

[(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]

[(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]

[(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]

[(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]

[(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]

[(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]

[(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]

λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])

λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])

84480

Soluciones

[schedule expon=’2017-05-23′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 23 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-05-23′ at=»06:00″]

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)
-- =====================================

-- Las fichas son pares de números enteros.
type Ficha  = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar
type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.
inicial :: Problema -> Estado
inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.
esFinal :: Estado -> Bool
esFinal (fs,_) = null fs 

sucesores :: Estado -> [Estado]
sucesores (fs,[]) =
  [(delete f fs, [f]) | f <- fs]
sucesores (fs,n@((x,y):qs)) =
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
  [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

soluciones :: Problema -> [Estado]
soluciones p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]
domino ps = map snd (soluciones ps)
      
-- 2ª solución (por búsqueda en profundidad)
-- =========================================

soluciones2 :: Problema -> [Estado]
soluciones2 p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]
domino2 ps = map snd (soluciones2 ps)
      
-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)
-- =================================================

domino3 :: Problema -> [[Ficha]]
domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]
soluciones3 ps = buscaEE sucesores
                         esFinal         
                         (inicial ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)

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

-- Las fichas son pares de números enteros.

type Ficha = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar

type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.

inicial :: Problema -> Estado

inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.

esFinal :: Estado -> Bool

esFinal (fs,_) = null fs

sucesores :: Estado -> [Estado]

sucesores (fs,[]) =

[(delete f fs, [f]) | f <- fs]

sucesores (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

soluciones :: Problema -> [Estado]

soluciones p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]

domino ps = map snd (soluciones ps)

-- 2ª solución (por búsqueda en profundidad)

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

soluciones2 :: Problema -> [Estado]

soluciones2 p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]

domino2 ps = map snd (soluciones2 ps)

-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)

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

domino3 :: Problema -> [[Ficha]]

domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]

soluciones3 ps = buscaEE sucesores

esFinal

(inicial ps)

[/schedule]

Sucesiones de listas de números

PorJosé A. Alonso 20-mayo-201626-marzo-2022

En la Olimpiada Internacional de Matemáticas del 2012 se propuso el siguiente problema:

Varios enteros positivos se escriben en una lista. Iterativamente, Alicia elige dos números adyacentes x e y tales que x > y y x está a la izquierda de y y reemplaza el par (x,y) por (y+1,x) o (x-1,x). Demostrar que sólo puede aplicar un número finito de dichas iteraciones.

Por ejemplo, las transformadas de la lista [1,3,2] son [1,2,3] y [1,3,3] y las dos obtenidas son finales (es decir, no se les puede aplicar ninguna transformación).

Definir las funciones

   soluciones       :: [Int] -> [Estado]
   finales          :: [Int] -> [[Int]]
   finalesMaximales :: [Int] -> (Int,[[Int]])

soluciones :: [Int] -> [Estado]

finales :: [Int] -> [[Int]]

finalesMaximales :: [Int] -> (Int,[[Int]])

tales que

(soluciones xs) es la lista de pares (n,ys) tales que ys es una lista obtenida aplicándole n transformaciones a xs. Por ejemplo,

     λ> soluciones [1,3,2]
     [(1,[1,3,3]),(1,[1,2,3])]
     λ> sort (nub (soluciones [3,3,2]))
     [(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]
     λ> sort (nub (soluciones [3,2,1]))
     [(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

λ> soluciones [1,3,2]

[(1,[1,3,3]),(1,[1,2,3])]

λ> sort (nub (soluciones [3,3,2]))

[(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]

λ> sort (nub (soluciones [3,2,1]))

[(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

(finales xs) son las listas obtenidas transformando xs y a las que no se les puede aplicar más transformaciones. Por ejemplo,

     finales [1,2,3]               ==  [[1,2,3]]
     finales [1,3,2]               ==  [[1,2,3],[1,3,3]]
     finales [3,2,1]               ==  [[2,2,3],[2,3,3],[3,3,3]]
     finales [1,3,2,4]             ==  [[1,2,3,4],[1,3,3,4]]
     finales [1,3,2,3]             ==  [[1,2,3,3],[1,3,3,3]]
     length (finales [9,6,0,7,2])  ==  19
     length (finales [80,60..0])   ==  420

finales [1,2,3] == [[1,2,3]]

finales [1,3,2] == [[1,2,3],[1,3,3]]

finales [3,2,1] == [[2,2,3],[2,3,3],[3,3,3]]

finales [1,3,2,4] == [[1,2,3,4],[1,3,3,4]]

finales [1,3,2,3] == [[1,2,3,3],[1,3,3,3]]

length (finales [9,6,0,7,2]) == 19

length (finales [80,60..0]) == 420

(finalesMaximales xs) es el par (n,yss) tal que la longitud de las cadenas más largas de transformaciones a partir de xs e yss es la lista de los estados finales a partir de xs con n transformaciones. Por ejemplo,

     finalesMaximales [9,5,7]   ==  (2,[[6,8,9],[8,8,9]])
     finalesMaximales [3,2,1]   ==  (4,[[2,3,3],[3,3,3]])
     finalesMaximales [3,2..0]  ==  (10,[[2,3,3,3],[3,3,3,3]])
     finalesMaximales [4,3..0]  ==  (20,[[3,4,4,4,4],[4,4,4,4,4]])

finalesMaximales [9,5,7] == (2,[[6,8,9],[8,8,9]])

finalesMaximales [3,2,1] == (4,[[2,3,3],[3,3,3]])

finalesMaximales [3,2..0] == (10,[[2,3,3,3],[3,3,3,3]])

finalesMaximales [4,3..0] == (20,[[3,4,4,4,4],[4,4,4,4,4]])

Soluciones

import Data.List (nub, sort)
import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado
inicial xs = (0,xs)

esFinal :: Estado -> Bool
esFinal e = null (sucesores e)

--    λ> sucesores [9,6,0,7,2]
--    [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]
sucesores :: Estado -> [Estado]
sucesores (_,[])  = []
sucesores (_,[_]) = []
sucesores (n,x:y:xs) | x > y     = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss
                     | otherwise = yss
    where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]
                       

soluciones :: [Int] -> [Estado]
soluciones xs =
    buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]
finales xs =
    sort (nub (map snd (soluciones xs)))
            
finalesMaximales :: [Int] -> (Int,[[Int]])
finalesMaximales xs =
    (m, [xs | (n,xs) <- es, n == m])
    where es    = sort (nub (soluciones xs))
          (m,_) = maximum es

import Data.List (nub, sort)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado

inicial xs = (0,xs)

esFinal :: Estado -> Bool

esFinal e = null (sucesores e)

-- λ> sucesores [9,6,0,7,2]

-- [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]

sucesores :: Estado -> [Estado]

sucesores (_,[]) = []

sucesores (_,[_]) = []

sucesores (n,x:y:xs) | x > y = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss

| otherwise = yss

where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]

soluciones :: [Int] -> [Estado]

soluciones xs =

buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]

finales xs =

sort (nub (map snd (soluciones xs)))

finalesMaximales :: [Int] -> (Int,[[Int]])

finalesMaximales xs =

(m, [xs | (n,xs) <- es, n == m])

where es = sort (nub (soluciones xs))

(m,_) = maximum es

Problema de las jarras

PorJosé A. Alonso 18-mayo-201626-marzo-2022

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en la jarra de A litros de capacidad.

Definir, mediante búsqueda en espacio de estados, la función

   jarras :: (Int,Int,Int) -> [[(Int,Int)]]

1	jarras :: (Int,Int,Int) -> [[(Int,Int)]]

tal (jarras (a,b,c)) es la lista de las soluciones del problema de las
jarras (a,b,c). Por ejemplo,

   λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))
   [[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],
    [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))

[[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],

[(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

La interpretación [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)] es:

(0,0) se inicia con las dos jarras vacías,
(4,0) se llena la jarra de 4 con el grifo,
(1,3) se llena la de 3 con la de 4,
(1,0) se vacía la de 3,
(0,1) se pasa el contenido de la primera a la segunda,
(4,1) se llena la primera con el grifo,
(2,3) se llena la segunda con la primera.

Otros ejemplos

   λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]
   [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   []

λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]

[(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

[]

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y
-- el contenido que se desea lograr 

-- Un estado es una lista de dos números. El primero es el contenido de
-- la jarra de 4 litros y el segundo el de la de 3 litros. 
type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras
inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool
esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]
sucesoresEjarras (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > 0, x + y > a] ++
    [(x-(b-y),b) | x > 0, y < b, x + y > b] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales
type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras
inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool
esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]
sucesoresNjarras p n@(e:es) =
    [e':n | e' <- sucesoresEjarras p e,
            e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]
solucionesJarras p = buscaEE (sucesoresNjarras p)
                             (esFinalNjarras p)
                             inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras p = map reverse (solucionesJarras p)

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y

-- el contenido que se desea lograr

-- Un estado es una lista de dos números. El primero es el contenido de

-- la jarra de 4 litros y el segundo el de la de 3 litros.

type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras

inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool

esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]

sucesoresEjarras (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > 0, x + y > a] ++

[(x-(b-y),b) | x > 0, y < b, x + y > b] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales

type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras

inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool

esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]

sucesoresNjarras p n@(e:es) =

[e':n | e' <- sucesoresEjarras p e,

e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]

solucionesJarras p = buscaEE (sucesoresNjarras p)

(esFinalNjarras p)

inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]

jarras p = map reverse (solucionesJarras p)

Problema del dominó

PorJosé A. Alonso 17-mayo-201626-marzo-2022

Definir, mediante búsqueda en espacio de estados, la función

   domino :: [(Int,Int)] -> [[(Int,Int)]]

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   ghci> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   ghci> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   ghci> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   ghci> domino [(1,2),(2,3),(5,4)]
   []
   ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0

ghci> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

ghci> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

ghci> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)]]

ghci> domino [(1,2),(2,3),(5,4)]

[]

ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

[(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]

[(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]

[(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]

[(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]

[(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]

[(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]

[(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]

[(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]

[(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]

ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

type Ficha  = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino
inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool
esFinalDomino (fs,_) = null fs 

sucesoresDomino :: EstadoDomino -> [EstadoDomino]
sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]
sucesoresDomino (fs,n@((x,y):qs)) =
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
    [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

solucionesDomino :: [Ficha] -> [EstadoDomino]
solucionesDomino ps = buscaEE sucesoresDomino
                              esFinalDomino         
                              (inicialDomino ps)

domino :: [(Int,Int)] -> [[(Int,Int)]]
domino ps = map snd (solucionesDomino ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

type Ficha = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino

inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool

esFinalDomino (fs,_) = null fs

sucesoresDomino :: EstadoDomino -> [EstadoDomino]

sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]

sucesoresDomino (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

solucionesDomino :: [Ficha] -> [EstadoDomino]

solucionesDomino ps = buscaEE sucesoresDomino

esFinalDomino

(inicialDomino ps)

domino :: [(Int,Int)] -> [[(Int,Int)]]

domino ps = map snd (solucionesDomino ps)

Caminos en un grafo

PorJosé A. Alonso 2-junio-201526-marzo-2022

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

[[1,3,5,2],[1,3,7,5,2]]

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Nota: Este ejercicio debe realizarse usando únicamente las funciones de la librería de grafos (I1M.Grafo) que se describe aquí y se encuentra aquí.

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
    where ns = map fst as ++ map snd as
          m  = minimum ns
          n  = maximum ns

-- 1ª solución
-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
    aux [] = []
    aux ((x:xs):yss)
        | x == a    = (x:xs) : aux yss
        | otherwise = aux ([z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
                           ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
    where inicial          = [b]
          sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                     , z `notElem` (x:xs)] 
          esFinal (x:xs)   = x == a

-- Comparación de eficiencia
-- =========================

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

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

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

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

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Problema de las jarras (con espacios de estados)

Problema de suma cero (con espacios de estados)

El problema del dominó (con espacios de estados)

El problema del calendario mediante búsqueda en espacio de estado

El problema de las fichas mediante búsqueda en espacio de estado

El problema del 8 puzzle

Búsqueda por primero el mejor

El problema de la mochila (mediante espacio de estados)

El problema de las n reinas (mediante búsqueda por anchura en espacios de estados)

Búsqueda por anchura en espacios de estados

El problema de las n reinas (mediante búsqueda por profundidad en espacios de estados)

Búsqueda en espacios de estados por profundidad

Caminos en un grafo

Soluciones

Sucesiones de listas de números

Soluciones

Pensamiento

Descomposiciones de N como sumas de 1, 3 ó 4.

Soluciones

Caminos en un grafo

Soluciones

Sucesiones de listas de números

Soluciones

Caminos en un grafo

Soluciones

Problema del dominó

Soluciones

Sucesiones de listas de números

Soluciones

Problema de las jarras

Soluciones

Problema del dominó

Soluciones

Caminos en un grafo

Soluciones

Entradas recientes

Buscar

Correo electrónico