Grafos

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]

Grafo de divisibilidad

PorJosé A. Alonso 11-mayo-201726-marzo-2022

El grafo de divisibilidad de orden n es el grafo cuyos nodos son los números naturales entre 1 y n, cuyas aristas son los pares (x,y) tales que x divide a y o y divide a x y el coste de cada arista es el cociente entre su mayos y menor elemento.

Definir las siguientes funciones:

   grafoDivisibilidad :: Int -> Grafo Int Int
   coste :: Int -> Int

1 2	grafoDivisibilidad :: Int -> Grafo Int Int coste :: Int -> Int

tales que

(grafoDivisibilidad n) es el grafo de divisibilidad de orden n. Por ejemplo,

      λ> grafoDivisibilidad 12
      G ND (array (1,12)
                  [(1,[(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),
                       (8,8),(9,9),(10,10),(11,11),(12,12)]),
                   (2,[(1,2),(4,2),(6,3),(8,4),(10,5),(12,6)]),
                   (3,[(1,3),(6,2),(9,3),(12,4)]),
                   (4,[(1,4),(2,2),(8,2),(12,3)]),
                   (5,[(1,5),(10,2)]),
                   (6,[(1,6),(2,3),(3,2),(12,2)]),
                   (7,[(1,7)]),
                   (8,[(1,8),(2,4),(4,2)]),
                   (9,[(1,9),(3,3)]),
                   (10,[(1,10),(2,5),(5,2)]),
                   (11,[(1,11)]),
                   (12,[(1,12),(2,6),(3,4),(4,3),(6,2)])])

λ> grafoDivisibilidad 12

G ND (array (1,12)

[(1,[(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),

(8,8),(9,9),(10,10),(11,11),(12,12)]),

(2,[(1,2),(4,2),(6,3),(8,4),(10,5),(12,6)]),

(3,[(1,3),(6,2),(9,3),(12,4)]),

(4,[(1,4),(2,2),(8,2),(12,3)]),

(5,[(1,5),(10,2)]),

(6,[(1,6),(2,3),(3,2),(12,2)]),

(7,[(1,7)]),

(8,[(1,8),(2,4),(4,2)]),

(9,[(1,9),(3,3)]),

(10,[(1,10),(2,5),(5,2)]),

(11,[(1,11)]),

(12,[(1,12),(2,6),(3,4),(4,3),(6,2)])])

(coste n) es el coste del árbol de expansión mínimo del grafo de divisibilidad de orden n. Por ejemplo,

      coste 12    ==  41
      coste 3000  ==  605305

1 2	coste 12 == 41 coste 3000 == 605305

Soluciones

[schedule expon=’2017-05-18′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 18 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-18′ at=»06:00″]

import Data.Ix
import Data.List (delete, sort)
import qualified Data.Set as S
import I1M.Grafo
import I1M.Tabla

grafoDivisibilidad :: Int -> Grafo Int Int
grafoDivisibilidad n =
  creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]
                                      , x <- [1..y-1]
                                      , y `mod` x == 0]


-- 1ª solución (con el algoritmo de Kruskal)
-- =========================================

coste1 :: Int -> Int
coste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]

-- (kruskal g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Kruskal. Por ejemplo,
--    λ> kruskal (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),
--     (2,4,8),(2,3,6),(2,2,4),(2,1,2)]
kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
kruskal g = kruskal' cola                           -- Cola ordenada
                     (tabla [(x,x) | x <- nodos g]) -- Tabla de raices
                     []                             -- Árbol de expansión
                     ((length (nodos g)) - 1)       -- Aristas por
                                                    -- colocar
    where cola = sort [(p,x,y) | (x,y,p) <- aristas g]

kruskal' ((p,x,y):as) t ae n 
  | n==0        = ae
  | actualizado = kruskal' as t' ((p,x,y):ae) (n-1)
  | otherwise   = kruskal' as t  ae           n
  where (actualizado,t') = buscaActualiza (x,y) t

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,
--    raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5  == 1
--    raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2  == 6
raiz:: Eq n => Tabla n n -> n -> n
raiz t x | v == x    = v
         | otherwise = raiz t v
         where v = valor t x

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los
-- dos vértices de la arista a tienen la misma raíz en t y el par
-- formado por True y la tabla obtenida añadiéndole a t la arista
-- formada por el vértice de a de mayor raíz y la raíz del vértice de
-- a de menor raíz. Por ejemplo,
--    ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]
--    ghci> buscaActualiza (2,3) t
--    (True,Tbl [(1,1),(2,1),(3,1),(4,1)])
--    ghci> buscaActualiza (3,4) t
--    (False,Tbl [(1,1),(2,2),(3,1),(4,1)])
buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)
buscaActualiza (x,y) t 
  | x' == y'  = (False, t) 
  | y' <  x'  = (True, modifica (x,y') t)
  | otherwise = (True, modifica (y,x') t)
  where x' = raiz t x 
        y' = raiz t y

-- 2ª solución (con el algoritmo de Prim)
-- ======================================

coste2 :: Int -> Int
coste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]

-- (prim g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
--    λ> prim (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
--     (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim g = prim' [n]              -- Nodos colocados
               ns               -- Nodos por colocar 
               []               -- Árbol de expansión
               (aristas g)      -- Aristas del grafo
         where (n:ns) = nodos g

prim' t [] ae as = ae
prim' t r  ae as = prim' (v':t) (delete v' r) (e:ae) as
  where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
                                         elem u t, 
                                         elem v r]

-- 3ª solución (con el algoritmo de Prim con conjuntos)
-- ====================================================

coste3 :: Int -> Int
coste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]

-- (prim2 g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
--    λ> prim2 (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
--     (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim2 g = prim2' (S.singleton n)  -- Nodos colocados
                 (S.fromList ns)  -- Nodos por colocar 
                 []               -- Árbol de expansión
                 (aristas g)      -- Aristas del grafo
  where (n:ns) = nodos g

prim2' t r ae as
  | S.null r  = ae
  | otherwise = prim2' (S.insert v' t)
                       (S.delete v' r)
                       (e:ae)
                       as
  where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
                                         S.member u t, 
                                         S.member v r]

-- Comparación de eficiencia
-- =========================

--    λ> coste1 400
--    14923
--    (0.08 secs, 31,336,440 bytes)
--    λ> coste2 400
--    14923
--    (4.54 secs, 220,745,608 bytes)
--    λ> coste3 400
--    14923
--    (0.69 secs, 217,031,144 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

import Data.Ix

import Data.List (delete, sort)

import qualified Data.Set as S

import I1M.Grafo

import I1M.Tabla

grafoDivisibilidad :: Int -> Grafo Int Int

grafoDivisibilidad n =

creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]

, x <- [1..y-1]

, y `mod` x == 0]

-- 1ª solución (con el algoritmo de Kruskal)

-- =========================================

coste1 :: Int -> Int

coste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]

-- (kruskal g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Kruskal. Por ejemplo,

-- λ> kruskal (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),

-- (2,4,8),(2,3,6),(2,2,4),(2,1,2)]

kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

kruskal g = kruskal' cola -- Cola ordenada

(tabla [(x,x) | x <- nodos g]) -- Tabla de raices

[] -- Árbol de expansión

((length (nodos g)) - 1) -- Aristas por

-- colocar

where cola = sort [(p,x,y) | (x,y,p) <- aristas g]

kruskal' ((p,x,y):as) t ae n

| n==0 = ae

| actualizado = kruskal' as t' ((p,x,y):ae) (n-1)

| otherwise = kruskal' as t ae n

where (actualizado,t') = buscaActualiza (x,y) t

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,

-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5 == 1

-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2 == 6

raiz:: Eq n => Tabla n n -> n -> n

raiz t x | v == x = v

| otherwise = raiz t v

where v = valor t x

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los

-- dos vértices de la arista a tienen la misma raíz en t y el par

-- formado por True y la tabla obtenida añadiéndole a t la arista

-- formada por el vértice de a de mayor raíz y la raíz del vértice de

-- a de menor raíz. Por ejemplo,

-- ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]

-- ghci> buscaActualiza (2,3) t

-- (True,Tbl [(1,1),(2,1),(3,1),(4,1)])

-- ghci> buscaActualiza (3,4) t

-- (False,Tbl [(1,1),(2,2),(3,1),(4,1)])

buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)

buscaActualiza (x,y) t

| x' == y' = (False, t)

| y' < x' = (True, modifica (x,y') t)

| otherwise = (True, modifica (y,x') t)

where x' = raiz t x

y' = raiz t y

-- 2ª solución (con el algoritmo de Prim)

-- ======================================

coste2 :: Int -> Int

coste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]

-- (prim g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Prim. Por ejemplo,

-- λ> prim (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),

-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]

prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

prim g = prim' [n] -- Nodos colocados

ns -- Nodos por colocar

[] -- Árbol de expansión

(aristas g) -- Aristas del grafo

where (n:ns) = nodos g

prim' t [] ae as = ae

prim' t r ae as = prim' (v':t) (delete v' r) (e:ae) as

where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,

elem u t,

elem v r]

-- 3ª solución (con el algoritmo de Prim con conjuntos)

-- ====================================================

coste3 :: Int -> Int

coste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]

-- (prim2 g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Prim. Por ejemplo,

-- λ> prim2 (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),

-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]

prim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

prim2 g = prim2' (S.singleton n) -- Nodos colocados

(S.fromList ns) -- Nodos por colocar

[] -- Árbol de expansión

(aristas g) -- Aristas del grafo

where (n:ns) = nodos g

prim2' t r ae as

| S.null r = ae

| otherwise = prim2' (S.insert v' t)

(S.delete v' r)

(e:ae)

where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,

S.member u t,

S.member v r]

-- Comparación de eficiencia

-- =========================

-- λ> coste1 400

-- 14923

-- (0.08 secs, 31,336,440 bytes)

-- λ> coste2 400

-- 14923

-- (4.54 secs, 220,745,608 bytes)

-- λ> coste3 400

-- 14923

-- (0.69 secs, 217,031,144 bytes)

[/schedule]

Grafo complemenario

PorJosé A. Alonso 10-mayo-201726-marzo-2022

El complementario del grafo G es un grafo G’ del mismo tipo que G (dirigido o no dirigido), con el mismo conjunto de nodos y tal que dos nodos de G’ son adyacentes si y sólo si no son adyacentes en G. Los pesos de todas las aristas del complementario es igual a 0.

Definir la función

   complementario :: Grafo Int Int -> Grafo Int Int

1	complementario :: Grafo Int Int -> Grafo Int Int

tal que (complementario g) es el complementario de g. Por ejemplo,

   λ> complementario (creaGrafo D (1,3) [(1,3,0),(3,2,0),(2,2,0),(2,1,0)])
   G D (array (1,3) [(1,[(1,0),(2,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])
   λ> complementario (creaGrafo D (1,3) [(3,2,0),(2,2,0),(2,1,0)])
   G D (array (1,3) [(1,[(1,0),(2,0),(3,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

λ> complementario (creaGrafo D (1,3) [(1,3,0),(3,2,0),(2,2,0),(2,1,0)])

G D (array (1,3) [(1,[(1,0),(2,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

λ> complementario (creaGrafo D (1,3) [(3,2,0),(2,2,0),(2,1,0)])

G D (array (1,3) [(1,[(1,0),(2,0),(3,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

Nota: Se usa el módulo Grafo de la librería de I1M o cualquiera de las implementaciones de grafos (GrafoConVectorDeAdyacencia o GrafoConMatrizDeAdyacencia).

Soluciones

[schedule expon=’2017-05-17′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 17 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-17′ at=»06:00″]

import I1M.Grafo

complementario :: Grafo Int Int -> Grafo Int Int
complementario g = 
    creaGrafo d (1,n) [(x,y,0) | x <- xs, y <- xs, not (aristaEn g (x,y))]
    where d  = if dirigido g then D else ND
          xs = nodos g
          n  = length xs

import I1M.Grafo

complementario :: Grafo Int Int -> Grafo Int Int

complementario g =

creaGrafo d (1,n) [(x,y,0) | x <- xs, y <- xs, not (aristaEn g (x,y))]

where d = if dirigido g then D else ND

xs = nodos g

n = length xs

[/schedule]

Caminos en un grafo

PorJosé A. Alonso 2-junio-201526-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

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)

Ciclos de un grafo

PorJosé A. Alonso 18-mayo-201526-marzo-2022

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

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

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

1 2	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)

100

101

102

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)

Reconocimiento de camino en un grafo

PorJosé A. Alonso 13-mayo-201526-marzo-2022

Dado un grafo no dirigido G, un camino en G es una secuencia de nodos [v(1),v(2),v(3),…,v(n)] tal que para todo i entre 1 y n-1, (v(i),v(i+1)) es una arista de G. Por ejemplo, dados los grafos

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

g1, g2 :: Grafo Int Int

g1 = creaGrafo ND (1,3) [(1,2,0),(1,3,0),(2,3,0)]

g2 = creaGrafo ND (1,4) [(1,2,0),(1,3,0),(1,4,0),(2,4,0),(3,4,0)]

la lista [1,2,3] es un camino en g1, pero no es un camino en g2 puesto que la arista (2,3) no existe en g2.

Definir la función

   camino :: Grafo Int Int -> [Int] -> Bool

1	camino :: Grafo Int Int -> [Int] -> Bool

tal que (camino g vs) se verifica si la lista de nodos vs es un camino en el grafo g. Por ejemplo,

   camino g1 [1,2,3]  ==  True
   camino g2 [1,2,3]  ==  False

1 2	camino g1 [1,2,3] == True camino g2 [1,2,3] == False

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 I1M.Grafo 
camino :: Grafo Int Int -> [Int] -> Bool
camino g vs = all (aristaEn g) (zip vs (tail vs))

import I1M.Grafo

camino :: Grafo Int Int -> [Int] -> Bool

camino g vs = all (aristaEn g) (zip vs (tail vs))

Caminos en un grafo

Soluciones

Grafo de divisibilidad

Soluciones

Grafo complemenario

Soluciones

Caminos en un grafo

Soluciones

Ciclos de un grafo

Soluciones

Reconocimiento de camino en un grafo

Soluciones

Entradas recientes

Buscar

Correo electrónico