Menu Close

Etiqueta: Data.List

Sucesiones de listas de números

José A. Alonso, ,

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

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

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
Leer más →

Problema del dominó

José A. Alonso, ,

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, mediante búsqueda en espacio de estados, 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,

   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

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)
Leer más →

Caminos en un grafo

José A. Alonso, ,

Definir las funciones

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

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)
Leer más →

Ciclos de un grafo

José A. Alonso, ,

Un ciclo en un grafo G es una secuencia [v(1),v(2),v(3),…,v(n)] de nodos de G tal que:

  • (v(1),v(2)), (v(2),v(3)), (v(3),v(4)), …, (v(n-1),v(n)) son aristas de G,
  • v(1) = v(n), y
  • salvo v(1) = v(n), todos los v(i) son distintos entre sí.

Definir la función

   ciclos :: Grafo Int Int -> [[Int]]

tal que (ciclos g) es la lista de ciclos de g. Por ejemplo, si g1 y g2 son los grafos definidos por

   g1, g2 :: Grafo Int Int
   g1 = creaGrafo D (1,4) [(1,2,0),(2,3,0),(2,4,0),(4,1,0)]
   g2 = creaGrafo D (1,4) [(1,2,0),(2,1,0),(2,4,0),(4,1,0)]

entonces

   ciclos g1  ==  [[1,2,4,1],[2,4,1,2],[4,1,2,4]]
   ciclos g2  ==  [[1,2,1],[1,2,4,1],[2,1,2],[2,4,1,2],[4,1,2,4]]

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 (nub, subsequences, permutations, sort)
import I1M.Grafo
 
-- 1ª definición (por fuerza bruta)
-- ================================
 
ciclos1 :: Grafo Int Int -> [[Int]]
ciclos1 g = 
    sort [ys | (x:xs) <- concatMap permutations (subsequences (nodos g)) 
             , let ys = (x:xs) ++ [x]
             , esCiclo ys g]
 
-- (esCiclo vs g) se verifica si vs es un ciclo en el grafo g. Por
-- ejemplo, 
esCiclo :: [Int] -> Grafo Int Int -> Bool
esCiclo vs g = 
    all (aristaEn g) (zip vs (tail vs)) &&
    head vs == last vs &&
    length (nub vs) == length vs - 1    
 
-- 2ª definición
-- =============
 
ciclos2 :: Grafo Int Int -> [[Int]]
ciclos2 g = sort [ys | (x:xs) <- caminos g
                     , let ys = (x:xs) ++ [x]
                     , esCiclo ys g]
 
-- (caminos g) es la lista de los caminos en el grafo g. Por ejemplo,
--    caminos g1  ==  [[1,2,3],[1,2,4],[2,3],[2,4,1],[3],[4,1,2,3]]
caminos :: Grafo Int Int -> [[Int]]
caminos g = concatMap (caminosDesde g) (nodos g)
 
-- (caminosDesde g v) es la lista de los caminos en el grafo g a partir
-- del vértice v. Por ejemplo,
--    caminosDesde g1 1  ==  [[1],[1,2],[1,2,3],[1,2,4]]
--    caminosDesde g1 2  ==  [[2],[2,3],[2,4],[2,4,1]]
--    caminosDesde g1 3  ==  [[3]]
--    caminosDesde g1 4  ==  [[4],[4,1],[4,1,2],[4,1,2,3]]
caminosDesde :: Grafo Int Int -> Int -> [[Int]]
caminosDesde g v = 
    map (reverse . fst) $
    concat $ 
    takeWhile (not.null) (iterate (concatMap sucesores) [([v],[v])])
    where sucesores (x:xs,ys) = [(z:x:xs,z:ys) | z <- adyacentes g x
                                               , z `notElem` ys]
 
-- 3ª solución (Pedro Martín)
-- ==========================
 
ciclos3 :: Grafo Int Int -> [[Int]]
ciclos3 g = concat [aux [n] (adyacentes g n) | n <- nodos g] where 
    aux _ [] = []
    aux xs (y:ys)
        | notElem y xs = aux (xs ++ [y]) (adyacentes g y) ++ aux xs ys
        | y == head xs = (xs ++ [y]) : aux xs ys
        | otherwise    = aux xs ys
 
-- 4ª solución (Chema Cortés)
-- ==========================
 
ciclos4 :: Grafo Int Int -> [[Int]]
ciclos4 g = concat [ caminos a a [] | a <- nodos g ] where
    -- caminos posibles de b hasta a, sin pasar dos veces por un mismo nodo
    caminos a b vs
        | a == b && (not.null) vs = [[b]]
        | otherwise = [ b:xs | c <- adyacentes g b
                             , c `notElem` vs
                             , xs <- caminos a c (c:vs)]
 
-- Comparación de eficiencia
-- =========================
 
-- ghci> let ejemplo n = creaGrafo D (1,n) ((n,1,0) : [(i,i+1,0) | i <- [1..n-1]])
-- 
-- ghci> length (ciclos1 (ejemplo 9))
-- 9
-- (4.92 secs, 1371229152 bytes)
--
-- ghci> length (ciclos2 (ejemplo 9))
-- 9
-- (0.01 secs, 2577736 bytes)
-- 
-- ghci> length (ciclos3 (ejemplo 9))
-- 9
-- (0.01 secs, 1038932 bytes)
-- 
-- ghci> length (ciclos4 (ejemplo 9))
-- 9
-- (0.01 secs, 2589288 bytes)
-- 
-- ghci> length (ciclos2 (ejemplo 400))
-- 400
-- (11.74 secs, 5148997000 bytes)
-- 
-- ghci> length (ciclos3 (ejemplo 400))
-- 400
-- (4.99 secs, 936520100 bytes)
-- 
-- ghci> length (ciclos4 (ejemplo 400))
-- 400
-- (1.56 secs, 66701772 bytes)
Leer más →