Ciclos de un grafo
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 -- ========================= -- λ> let ejemplo n = creaGrafo D (1,n) ((n,1,0) : [(i,i+1,0) | i <- [1..n-1]]) -- -- λ> length (ciclos1 (ejemplo 9)) -- 9 -- (4.92 secs, 1371229152 bytes) -- -- λ> length (ciclos2 (ejemplo 9)) -- 9 -- (0.01 secs, 2577736 bytes) -- -- λ> length (ciclos3 (ejemplo 9)) -- 9 -- (0.01 secs, 1038932 bytes) -- -- λ> length (ciclos4 (ejemplo 9)) -- 9 -- (0.01 secs, 2589288 bytes) -- -- λ> length (ciclos2 (ejemplo 400)) -- 400 -- (11.74 secs, 5148997000 bytes) -- -- λ> length (ciclos3 (ejemplo 400)) -- 400 -- (4.99 secs, 936520100 bytes) -- -- λ> length (ciclos4 (ejemplo 400)) -- 400 -- (1.56 secs, 66701772 bytes)