Ir al contenido principal

Longitud de la subsecuencia común máxima.

Si a una secuencia X de elementos (pongamos por ejemplo, caracteres) le quitamos algunos de ellos y dejamos los que quedan en el orden en el que aparecían originalmente tenemos lo que se llama una subsecuencia de X. Por ejemplo, "aaoa" es una subsecuencia de la secuencia "amapola".

El término también se aplica cuando quitamos todos los elementos (es decir, la secuencia vacía es siempre subsecuencia de cualquier secuencia) o cuando no quitamos ninguno (lo que significa que cualquier secuencia es siempre subsecuencia de sí misma).

Dadas dos secuencias X e Y, decimos que Z es una subsecuencia común de X e Y si Z es subsecuencia de X y de Y. Por ejemplo, si X = "amapola" e Y = "matamoscas", la secuencia "aaoa" es una de las subsecuencias comunes de X e Y más larga, con longitud 4, ya que no hay ninguna subsecuencia común a X e Y de longitud mayor que 4. También son subsecuencias comunes de longitud 4 "maoa" o "amoa".

Se desea encontrar la longitud de las subsecuencias comunes más largas de dos secuencias de caracteres dadas.

Definir la función

   longitudSCM :: Eq a => [a] -> [a] -> Int

tal que longitudSCM xs ys es la longitud de la subsecuencia máxima de xs e ys. Por ejemplo,

   longitudSCM "amapola" "matamoscas" == 4
   longitudSCM "atamos" "matamoscas"  == 6
   longitudSCM "aaa" "bbbb"           == 0

Leer más…

Coeficientes binomiales

El coeficiente binomial n sobre k es el número de subconjuntos de k elementos escogidos de un conjunto con n elementos.

Definir la función

   binomial :: Integer -> Integer -> Integer

tal que binomial n k es el coeficiente binomial n sobre k. Por ejemplo,

   binomial 6 3 == 20
   binomial 5 2 == 10
   binomial 5 3 == 10

Leer más…

La función de Fibonacci por programación dinámica

Los primeros términos de la sucesión de Fibonacci son

   0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, ...

Escribir dos definiciones (una recursiva y otra con programación dinámica) de la función

   fib :: Integer -> Integer

tal que fib n es el n-ésimo término de la sucesión de Fibonacci. Por ejemplo,

   fib 6 == 8

Comparar la eficiencia de las dos definiciones.

Leer más…

Problema de las jarras

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

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

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)
   []

Leer más…

Problema de suma cero

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

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]
   []

Leer más…

El problema del dominó

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

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)]
   []

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

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

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

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

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]

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

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

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

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

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

y el final es

      +---+---+---+---+---+---+---+
      | 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)
  • Tablero que es una lista de fichas que representa las fichas colocadas en el tablero.
     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)
  • Busqueda es un procedimiento de búsqueda
     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 |
      +---+---+---+---+---+---+---+

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

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

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

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

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

Un granjero está parado en un lado del río y con él tiene un una cabra y una repollo. En el río hay un barco pequeño. El desea cruzar el río con sus tres posesiones. No hay puentes y en el barco hay solamente sitio para el granjero y un artículo. Si deja la cabra con la repollo sola en un lado del río la cabra comerá la repollo. Si deja el lobo y la cabra en un lado, el lobo se comerá a la cabra. ¿Cómo puede cruzar el granjero el río con los tres artículos, sin que ninguno se coma al otro?

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

  • Orilla con dos constructores (I y D) que representan las orillas izquierda y derecha, respectivamente.
  • Estado que es una tupla que representa en qué orilla se encuentra cada uno de los elementos (granjero, lobo, cabra, repollo). Por ejemplo, (I,D,D,I) representa que el granjero está en la izquierda, que el lobo está en la derecha, que la cabra está en la derecha y el repollo está en la izquierda.

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

   granjero :: [[Estado]]

tal que granjero son las soluciones del problema del granjero mediante el patrón de búsqueda en espacio de estados. Por ejemplo,

   λ> head granjero
   [(I,I,I,I),(D,I,D,I),(I,I,D,I),(D,D,D,I),
    (I,D,I,I),(D,D,I,D),(I,D,I,D),(D,D,D,D)]
   λ> length granjero
   2

Soluciones

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

Soluciones en Haskell

module BEE_El_problema_del_granjero where

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

data Orilla = I | D
  deriving (Eq, Show)

type Estado = (Orilla,Orilla,Orilla,Orilla)

-- (seguro e) se verifica si el estado e es seguro; es decir, que no
-- puede estar en una orilla el lobo con la cabra sin el granjero ni la
-- cabra con el repollo sin el granjero. Por ejemplo,
--    seguro (I,D,D,I)  ==  False
--    seguro (D,D,D,I)  ==  True
--    seguro (D,D,I,I)  ==  False
--    seguro (I,D,I,I)  ==  True
seguro :: Estado -> Bool
seguro (g,l,c,r) = not (g /= c && (c == l || c == r))

-- (opuesta x) es la opuesta de la orilla x. Por ejemplo
--    opuesta I = D
opuesta :: Orilla -> Orilla
opuesta I = D
opuesta D = I

-- (sucesoresE e) es la lista de los sucesores seguros del estado e. Por
-- ejemplo,
--    sucesoresE (I,I,I,I)  ==  [(D,I,D,I)]
--    sucesoresE (D,I,D,I)  ==  [(I,I,D,I),(I,I,I,I)]
sucesoresE :: Estado -> [Estado]
sucesoresE e = [mov e | mov <- [m1,m2,m3,m4], seguro (mov e)]
  where m1 (g,l,c,r) = (opuesta g, l, c, r)
        m2 (g,l,c,r) = (opuesta g, opuesta l, c, r)
        m3 (g,l,c,r) = (opuesta g, l, opuesta c, r)
        m4 (g,l,c,r) = (opuesta g, l, c, opuesta r)

-- Nodo es el tipo de los nodos del espacio de búsqueda, donde un nodo
-- es una lista de estados
--    [e_n, ..., e_2, e_1]
-- tal que e_1 es el estado inicial y para cada i (2 <= i <= n), e_i es un
-- sucesor de e_(i-1).
newtype Nodo = Nodo [Estado]
  deriving (Eq, Show)

-- inicial es el nodo inicial en el que todos están en la orilla
-- izquierda.
inicial :: Nodo
inicial = Nodo [(I,I,I,I)]

-- (esFinal n) se verifica si n es un nodo final; es decir, su primer
-- elemento es el estado final. Por ejemplo,
--    esFinal (Nodo [(D,D,D,D),(I,I,I,I)])  ==  True
--    esFinal (Nodo [(I,I,D,I),(I,I,I,I)])  ==  False
esFinal :: Nodo -> Bool
esFinal (Nodo (n:_)) = n == (D,D,D,D)

-- (sucesores n) es la lista de los sucesores del nodo n. Por ejemplo,
--    λ> sucesores (Nodo [(I,I,D,I),(D,I,D,I),(I,I,I,I)])
--    [Nodo [(D,D,D,I),(I,I,D,I),(D,I,D,I),(I,I,I,I)],
--     Nodo [(D,I,D,D),(I,I,D,I),(D,I,D,I),(I,I,I,I)]]
sucesores :: Nodo -> [Nodo]
sucesores (Nodo n@(e:es)) =
  [Nodo (e':n) | e' <- sucesoresE e, e' `notElem` es]

granjero :: [[Estado]]
granjero =
  [reverse es | (Nodo es) <- buscaProfundidad sucesores esFinal inicial]

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

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    head granjero `shouldBe`
    [(I,I,I,I),(D,I,D,I),(I,I,D,I),(D,D,D,I),
     (I,D,I,I),(D,D,I,D),(I,D,I,D),(D,D,D,D)]
  it "e2" $
    length granjero `shouldBe` 2

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

Soluciones en Python

from enum import Enum

from src.BusquedaEnProfundidad import buscaProfundidad


class Orilla(Enum):
    I = 0
    D = 1

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

I = Orilla.I
D = Orilla.D

Estado = tuple[Orilla, Orilla, Orilla, Orilla]

# seguro(e) se verifica si el estado e es seguro; es decir, que no
# puede estar en una orilla el lobo con la cabra sin el granjero ni la
# cabra con el repollo sin el granjero. Por ejemplo,
#    seguro((I,D,D,I))  ==  False
#    seguro((D,D,D,I))  ==  True
#    seguro((D,D,I,I))  ==  False
#    seguro((I,D,I,I))  ==  True
def seguro(e: Estado) -> bool:
    (g,l,c,r) = e
    return not (g != c and c in {l, r})

# (opuesta x) es la opuesta de la orilla x. Por ejemplo
#    opuesta(I) == D
def opuesta(o: Orilla) -> Orilla:
    if o == I:
        return D
    return I

# sucesoresE(e) es la lista de los sucesores seguros del estado e. Por
# ejemplo,
#    sucesoresE((I,I,I,I))  ==  [(D,I,D,I)]
#    sucesoresE((D,I,D,I))  ==  [(I,I,D,I),(I,I,I,I)]
def sucesoresE(e: Estado) -> list[Estado]:
    def mov(n: int, e: Estado) -> Estado:
        (g,l,c,r) = e
        if n == 1:
            return (opuesta(g), l, c, r)
        if n == 2:
            return (opuesta(g), opuesta(l), c, r)
        if n == 3:
            return (opuesta(g), l, opuesta(c), r)
        return (opuesta(g), l, c, opuesta(r))
    return [mov(n, e) for n in range(1, 5) if seguro(mov(n, e))]

# Nodo es el tipo de los nodos del espacio de búsqueda, donde un nodo
# es una lista de estados
#    [e_n, ..., e_2, e_1]
# tal que e_1 es el estado inicial y para cada i (2 <= i <= n), e_i es un
# sucesor de e_(i-1).
Nodo = list[Estado]

# inicial es el nodo inicial en el que todos están en la orilla
# izquierda.
inicial: Nodo = [(I,I,I,I)]

# esFinal(n) se verifica si n es un nodo final; es decir, su primer
# elemento es el estado final. Por ejemplo,
#    esFinal([(D,D,D,D),(I,I,I,I)])  ==  True
#    esFinal([(I,I,D,I),(I,I,I,I)])  ==  False
def esFinal(n: Nodo) -> bool:
    return n[0] == (D,D,D,D)

# sucesores(n) es la lista de los sucesores del nodo n. Por ejemplo,
#    >>> sucesores([(I,I,D,I),(D,I,D,I),(I,I,I,I)])
#    [[(D, D, D, I), (I, I, D, I), (D, I, D, I), (I, I, I, I)],
#     [(D, I, D, D), (I, I, D, I), (D, I, D, I), (I, I, I, I)]]
def sucesores(n: Nodo) -> list[Nodo]:
    e, *es = n
    return [[e1] + n for e1 in sucesoresE(e) if e1 not in es]

def granjero() -> list[list[Estado]]:
    return [list(reversed(es)) for es in buscaProfundidad(sucesores, esFinal, inicial)]

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

def test_granjero() -> None:
    assert granjero() == \
        [[(I,I,I,I),(D,I,D,I),(I,I,D,I),(D,I,D,D),(I,I,I,D),(D,D,I,D),(I,D,I,D),(D,D,D,D)],
         [(I,I,I,I),(D,I,D,I),(I,I,D,I),(D,D,D,I),(I,D,I,I),(D,D,I,D),(I,D,I,D),(D,D,D,D)]]
    print("Verificado")

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

El algoritmo de Prim del árbol de expansión mínimo por escalada

El algoritmo de Prim calcula un recubridor mínimo en un grafo conexo y ponderado. Es decir, busca un subconjunto de aristas que, formando un árbol, incluyen todos los vértices y donde el valor de la suma de todas las aristas del árbol es el mínimo.

El algoritmo de Prim funciona de la siguiente manera:

  • Inicializar un árbol con un único vértice, elegido arbitrariamente, del grafo.
  • Aumentar el árbol por un lado. Llamamos lado a la unión entre dos vértices: de las posibles uniones que pueden conectar el árbol a los vértices que no están aún en el árbol, encontrar el lado de menor distancia y unirlo al árbol.
  • Repetir el paso 2 (hasta que todos los vértices pertenezcan al árbol)

Usando la búsqueda en escalada el tipo abstracto de datos de los grafos, definir la función

   prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

tal que prim g es el árbol de expansión mínimo del grafo g calculado mediante el algoritmo de Prim con bñusqueda en escalada. Por ejemplo, si g1, g2, g3 y g4 son los grafos definidos por

   g1, g2, g3, g4 :: Grafo Int Int
   g1 = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78),
                            (2,4,55),(2,5,32),
                            (3,4,61),(3,5,44),
                            (4,5,93)]
   g2 = creaGrafo ND (1,5) [(1,2,13),(1,3,11),(1,5,78),
                            (2,4,12),(2,5,32),
                            (3,4,14),(3,5,44),
                            (4,5,93)]
   g3 = creaGrafo ND (1,7) [(1,2,5),(1,3,9),(1,5,15),(1,6,6),
                            (2,3,7),
                            (3,4,8),(3,5,7),
                            (4,5,5),
                            (5,6,3),(5,7,9),
                            (6,7,11)]
   g4 = creaGrafo ND (1,7) [(1,2,5),(1,3,9),(1,5,15),(1,6,6),
                            (2,3,7),
                            (3,4,8),(3,5,1),
                            (4,5,5),
                            (5,6,3),(5,7,9),
                            (6,7,11)]

entonces

   prim g1 == [(2,4,55),(1,3,34),(2,5,32),(1,2,12)]
   prim g2 == [(2,5,32),(2,4,12),(1,2,13),(1,3,11)]
   prim g3 == [(5,7,9),(2,3,7),(5,4,5),(6,5,3),(1,6,6),(1,2,5)]
   prim g4 == [(5,7,9),(5,4,5),(5,3,1),(6,5,3),(1,6,6),(1,2,5)]

Soluciones

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

Soluciones en Haskell

module Escalada_Prim where

import BusquedaEnEscalada (buscaEscalada)
import TAD.Grafo (Grafo, Orientacion (ND), aristaEn, creaGrafo, nodos, peso)
import Data.Ix (Ix)
import Data.List (delete)
import Test.Hspec (Spec, hspec, it, shouldBe)

g1, g2, g3, g4 :: Grafo Int Int
g1 = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78),
                         (2,4,55),(2,5,32),
                         (3,4,61),(3,5,44),
                         (4,5,93)]
g2 = creaGrafo ND (1,5) [(1,2,13),(1,3,11),(1,5,78),
                         (2,4,12),(2,5,32),
                         (3,4,14),(3,5,44),
                         (4,5,93)]
g3 = creaGrafo ND (1,7) [(1,2,5),(1,3,9),(1,5,15),(1,6,6),
                         (2,3,7),
                         (3,4,8),(3,5,7),
                         (4,5,5),
                         (5,6,3),(5,7,9),
                         (6,7,11)]
g4 = creaGrafo ND (1,7) [(1,2,5),(1,3,9),(1,5,15),(1,6,6),
                         (2,3,7),
                         (3,4,8),(3,5,1),
                         (4,5,5),
                         (5,6,3),(5,7,9),
                         (6,7,11)]

-- Una arista esta formada por dos vértices junto con su peso.
type Arista a b = (a,a,b)

-- Un estado (Estado (p,t,r,aem)) está formado por el peso p de la
-- última arista añadida el árbol de expansión mínimo (aem), la lista t
-- de nodos del grafo que están en el aem, la lista r de nodos del
-- grafo que no están en el aem y el aem.
type Estado a b = (b,[a],[a],[Arista a b])

-- (inicial g) es el estado inicial correspondiente al grafo g.
inicial :: (Ix a, Num b, Ord b) => Grafo a b -> Estado a b
inicial g = (0,[n],ns,[])
  where (n:ns) = nodos g

-- (esFinal e) se verifica si e es un estado final; es decir, si no
-- queda ningún elemento en la lista de nodos sin colocar en el árbol de
-- expansión mínimo.
esFinal :: Estado a b -> Bool
esFinal (_,_,[],_) = True
esFinal _          = False

-- (sucesores g e) es la lista de los sucesores del estado e en el
-- grafo g. Por ejemplo,
--    λ> sucesores g1 (0,[1],[2..5],[])
--    [(12,[2,1],[3,4,5],[(1,2,12)]),
--     (34,[3,1],[2,4,5],[(1,3,34)]),
--     (78,[5,1],[2,3,4],[(1,5,78)])]
sucesores
  :: (Ix a, Num b, Eq b) => Grafo a b -> Estado a b -> [Estado a b]
sucesores g (_,t,r,aem) =
  [(peso x y g, y:t, delete y r, (x,y,peso x y g):aem)
   | x <- t , y <- r, aristaEn g (x,y)]

prim :: (Ix a, Num b, Ord b) => Grafo a b -> [Arista a b]
prim g = sol
  where [(_,_,_,sol)] = buscaEscalada (sucesores g)
                                      esFinal
                                      (inicial g)

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

verifica :: IO ()
verifica = hspec spec

spec :: Spec
spec = do
  it "e1" $
    prim g1 `shouldBe` [(2,4,55),(1,3,34),(2,5,32),(1,2,12)]
  it "e2" $
    prim g2 `shouldBe` [(2,5,32),(2,4,12),(1,2,13),(1,3,11)]
  it "e3" $
    prim g3 `shouldBe` [(5,7,9),(2,3,7),(5,4,5),(6,5,3),(1,6,6),(1,2,5)]
  it "e4" $
    prim g4 `shouldBe` [(5,7,9),(5,4,5),(5,3,1),(6,5,3),(1,6,6),(1,2,5)]

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

Soluciones en Python

from typing import Optional

from src.BusquedaEnEscalada import buscaEscalada
from src.TAD.Grafo import (Grafo, Orientacion, Peso, Vertice, aristaEn,
                           creaGrafo, nodos, peso)

g1 = creaGrafo (Orientacion.ND,
                (1,5),
                [((1,2),12),((1,3),34),((1,5),78),
                 ((2,4),55),((2,5),32),
                 ((3,4),61),((3,5),44),
                 ((4,5),93)])
g2 = creaGrafo (Orientacion.ND,
                (1,5),
                [((1,2),13),((1,3),11),((1,5),78),
                 ((2,4),12),((2,5),32),
                 ((3,4),14),((3,5),44),
                 ((4,5),93)])
g3 = creaGrafo (Orientacion.ND,
                (1,7),
                [((1,2),5),((1,3),9),((1,5),15),((1,6),6),
                 ((2,3),7),
                 ((3,4),8),((3,5),7),
                 ((4,5),5),
                 ((5,6),3),((5,7),9),
                 ((6,7),11)])
g4 = creaGrafo (Orientacion.ND,
                (1,7),
                [((1,2),5),((1,3),9),((1,5),15),((1,6),6),
                 ((2,3),7),
                 ((3,4),8),((3,5),1),
                 ((4,5),5),
                 ((5,6),3),((5,7),9),
                 ((6,7),11)])

Arista = tuple[tuple[Vertice, Vertice], Peso]

# Un nodo (Estado (p,t,r,aem)) está formado por el peso p de la última
# arista añadida el árbol de expansión mínimo (aem), la lista t
# de nodos del grafo que están en el aem, la lista r de nodos del
# grafo que no están en el aem y el aem.
Estado = tuple[Peso, list[Vertice], list[Vertice], list[Arista]]

# inicial(g) es el estado inicial correspondiente al grafo g.
def inicial(g: Grafo) -> Estado:
    n, *ns = nodos(g)
    return (0, [n], ns, [])

# esFinal(e) se verifica si e es un estado final; es decir, si no
# queda ningún elemento en la lista de nodos sin colocar en el árbol de
# expansión mínimo.
def esFinal(e: Estado) -> bool:
    return e[2] == []

# sucesores(g, e) es la lista de los sucesores del estado e en el
# grafo g. Por ejemplo,
#    λ> sucesores(g1, (0,[1],[2,3,4,5],[]))
#    [(12,[2,1],[3,4,5],[(1,2,12)]),
#     (34,[3,1],[2,4,5],[(1,3,34)]),
#     (78,[5,1],[2,3,4],[(1,5,78)])]
def sucesores(g: Grafo, e: Estado) -> list[Estado]:
    (_,t,r,aem) = e
    return [(peso(x, y, g),
             [y] + t,
             [x for x in r if x != y],
             [((x,y),peso(x, y, g))] + aem)
            for x in t for y in r if aristaEn(g, (x, y))]

def prim(g: Grafo) -> Optional[list[Arista]]:
    r = buscaEscalada(lambda e: sucesores(g, e), esFinal, inicial(g))
    if r is None:
        return None
    return r[3]

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

def test_prim() -> None:
    assert prim(g1) == [((2,4),55),((1,3),34),((2,5),32),((1,2),12)]
    assert prim(g2) == [((2,5),32),((2,4),12),((1,2),13),((1,3),11)]
    assert prim(g3) == [((5,7),9),((2,3),7),((5,4),5),((6,5),3),((1,6),6),((1,2),5)]
    assert prim(g4) == [((5,7),9),((5,4),5),((5,3),1),((6,5),3),((1,6),6),((1,2),5)]
    print("Verificado")

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