Caminos en un grafo

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

Soluciones

[schedule expon=’2019-06-06′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 06 de junio.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

Tengo dentro de un herbario
una tarde disecada,
lila, violeta y dorada.
Caprichos de solitario.

Antonio Machado

[/schedule]

[schedule on=’2019-06-06′ 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

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (minimum b, maximum b) (map extiende as)
  where b = convierte as
        convierte [] = []
        convierte ((a,b):xs) = a:b:convierte xs
        extiende (a,b) = (a,b,0)

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = buscaEE (sucesores) (\xs -> (last xs) == b) [a]
  where sucesores xs = [xs ++ [c] | c <- adyacentes g (last xs), notElem c xs]

grafo as = creaGrafo ND (minimum b, maximum b) (map extiende as)

where b = convierte as

convierte [] = []

convierte ((a,b):xs) = a:b:convierte xs

extiende (a,b) = (a,b,0)

caminos g a b = buscaEE (sucesores) (\xs -> (last xs) == b) [a]

where sucesores xs = [xs ++ [c] | c <- adyacentes g (last xs), notElem c xs]

Responder

grafo   :: [(Int,Int)] -> Grafo Int Int
grafo xss = creaGrafo ND (minimum (f xss) ,maximum (f xss)) ( aux xss)
  where f [] = []
        f ((a,b):xss) = a:b:f xss
        aux xss = [ (a,b,0) | (a,b) <- xss]
caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = map (a:) $ map reverse  $ buscaEE sucesores esFinal []
  where esFinal [] = False
        esFinal xs =  head xs == b
        sucesores [] = [ [x] | x <- adyacentes g a]
        sucesores p@(x:xs) = [ y:p | y <- adyacentes g x , notElem y xs]

grafo xss = creaGrafo ND (minimum (f xss) ,maximum (f xss)) ( aux xss)

where f [] = []

f ((a,b):xss) = a:b:f xss

aux xss = [ (a,b,0) | (a,b) <- xss]

caminos g a b = map (a:) $ map reverse $ buscaEE sucesores esFinal []

where esFinal [] = False

esFinal xs = head xs == b

sucesores [] = [ [x] | x <- adyacentes g a]

sucesores p@(x:xs) = [ y:p | y <- adyacentes g x , notElem y xs]

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g x y = (buscaEE (sucesores g) (esFinal y) [x])
  where esFinal y (x:xs) = y == x
        sucesores g (z:xs) = [k:z:xs | k <- adyacentes g z , k`notElem` xs]

grafo :: [(Int,Int)] -> Grafo Int Int
grafo xs = creaGrafo ND (a,b) pss
  where ys = concatMap (\(x,y) -> [x,y]) xs
        b = maximum ys
        a = minimum ys 
        pss = map (\(a,b) -> (a,b,0)) xs

caminos g x y = (buscaEE (sucesores g) (esFinal y) [x])

where esFinal y (x:xs) = y == x

sucesores g (z:xs) = [k:z:xs | k <- adyacentes g z , k`notElem` xs]

grafo xs = creaGrafo ND (a,b) pss

where ys = concatMap (\(x,y) -> [x,y]) xs

b = maximum ys

a = minimum ys

pss = map (\(a,b) -> (a,b,0)) xs

Caminos en un grafo

Soluciones

Pensamiento

3 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Pensamiento

Se puede imprimir o compartir con

3 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico