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]

3 Comentarios

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]

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]

Responder

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]

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]

Responder

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]

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]

Responder

Caminos en un grafo

Soluciones

3 Comentarios

Leave a Reply to enrnarbejCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

3 Comentarios

Leave a Reply to enrnarbejCancel reply

Entradas recientes

Buscar

Correo electrónico