Menu Close

Caminos en un grafo

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

3 soluciones de “Caminos en un grafo

  1. albcercid
     
    import I1M.Grafo
    import Data.List
    import qualified Data.Set as S
     
    grafo :: [(Int,Int)] -> Grafo Int Int
    grafo xs = creaGrafo ND (a,b) (map ((x,y) -> (x,y,0)) xs)
          where (a,b) = (minimum t, maximum t)
                t = map fst xs ++ map snd xs
     
     
    caminos g a b = map (reverse.fst) $ busca [([a],S.fromList [a])]
      where busca [] = []
            busca (p@((e:_),_):xs) | e == b = p:busca xs
                               | otherwise = busca (siguiente p ++ xs)
            siguiente ((a:xs),b) =
              [ (c:a:xs, S.insert c b) | c <- adyacentes g a, S.notMember c b]
  2. enrnarbej
    import I1M.Grafo
    import qualified Data.Set as S
    import Data.List
     
    grafo :: [(Int,Int)] -> Grafo Int Int
    grafo xs = creaGrafo ND (minimum m, maximum m) n
             where
              m = map fst xs ++ map snd xs
              n = map ((x,y) -> (x,y,0)) xs 
     
     
    caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
    caminos g a b = busca [(S.delete a n,[a])]  
                  where
                   n = (S.fromList . nodos) g
                   busca [] = []
                   busca ((s,(x:e)):estados) | x == b = reverse (x:e) : busca estados
                                             | otherwise = busca (siguientes (s,(x:e)) g ++ estados)
     
    siguientes :: (S.Set Int,[Int]) -> Grafo Int Int -> [(S.Set Int, [Int])]
    siguientes (s,(x:e)) g = [(S.delete d s, d:x:e) | d <- adyacentes g x, d `S.member` s]
  3. josdeher
    import I1M.Grafo
     
    grafo :: [(Int,Int)] -> Grafo Int Int
    grafo xs = creaGrafo ND (a,b) (map ((x,y) -> (x,y,0)) xs)
      where (a,b) = (minimum t, maximum t)
            t     = map fst xs ++ map snd xs
     
    caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
    caminos g a b | a == b    = [[a]]
                  | otherwise = separa (map (reverse.aux [a] (delete a (nodos g)))(adyacentes g a))
      where separa xss | length xss == 1 = filter (not.null) $ separa2 (head xss)
                       | otherwise       = filter (not.null) $ concatMap separa2 xss
            separa2   []   = [[]]
            separa2 (x:xs) = (x:(takeWhile (/=a) xs)) :separa2 (dropWhile (/=a) xs)
            aux :: [Int] -> [Int] -> Int -> [Int]
            aux (c:cs) [] _ | c == b    = (c:cs)
                            | otherwise = []
            aux   []   [] _ = []
            aux   xs   ns v | v == b    = b:xs
                            | otherwise = concatMap (aux (v:xs) (delete v ns)) (intersect (adyacentes g v) ns)
     
    delete :: Int -> [Int] -> [Int]
    delete v xs = [x | x <- xs, x /= v]
     
    intersect :: [Int] -> [Int] -> [Int]
    intersect ys xs = [ y | y <- ys, elem y xs]

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.