0votos

Clausura transitiva en grafos no dirigidos en Haskell

por josejuan hace 5 años

Solución ineficiente que aplica iterativamente la transitividad hasta que no hay cambio.

Dado un grafo no dirigido, obtener la clausura transitiva, es decir, el conjunto de conjuntos de nodos conectados.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
import Control.Monad 
import qualified Data.Map as M 
import qualified Data.Set as S 
import Data.List 
import Data.Map ((!)) 
 
 
closure g = if closed                                       -- Si ya está cerrado... 
                then g                                      -- ...es el mismo grafo. 
                else closure g'                             -- ...sino, la clausura de su expansión. 
 
  where closed = null expansion                             -- Está cerrado si no se expande. 
 
        expansion = do (x, ys) <- M.toList g                -- De cada nodo... 
                       y <- S.toList ys                     -- ...de cada amigo suyo... 
                       z <- S.toList (g!y)                  -- ...sus amigos... 
                       guard (z `S.notMember` ys)           -- ...(si no lo son ya)... 
                       return (x, z)                        -- ...pasan a ser sus amigos. 
 
        g' = foldr (\(x,z) -> M.adjust (S.insert z) x) g expansion -- Añadir la expansión. 
 
 
 
 
 
 
{- 
 
  Tres tipos de representación de grafos: 
 
    1. Mapa de conjuntos de adyacentes :: Map nodo (Set nodo) 
 
    2. Lista de listas de adyacentes   :: [(nodo, [nodo])] 
 
    3. Aristas                         :: [(nodo, nodo)] 
 
 
-} 
graphEdgesToLists :: Ord a => [(a, a)] -> [(a, [a])] 
graphEdgesToLists = map (\g@((x,_):_) -> (x, map snd g)) .  -- Un nodo y sus adyacentes... 
                    groupBy ((.fst).(==).fst) .             -- ... agrupando por nodo... 
                    sortBy ((.fst).compare.fst) .           -- ... ordenando por nodo... 
                    ap (++) (map (\(x, y) -> (y, x)))       -- ... duplicando sentido aristas. 
 
graphListsToEdges :: Ord a => [(a, [a])] -> [(a, a)] 
graphListsToEdges = nub .                                   -- Eliminamos duplicados... 
                    filter (uncurry (<)) .                  -- ...ignoramos sentido aristas... 
                    concatMap (\(x, as) -> map ((,) x) as)  -- ...creamos todas aristas. 
 
graphListsToMapSet :: Ord a => [(a, [a])] -> M.Map a (S.Set a) 
graphListsToMapSet = M.fromList . map (\(x, ys) -> (x, S.fromList ys)) 
 
graphMapSetToLists :: Ord a => M.Map a (S.Set a) -> [(a, [a])] 
graphMapSetToLists = map (\(x, ys) -> (x, S.toList ys)) . M.toList 
 
graphEdgesToMapSet :: Ord a => [(a, a)] -> M.Map a (S.Set a) 
graphEdgesToMapSet = graphListsToMapSet . graphEdgesToLists 
 
graphMapSetToEdges :: Ord a => M.Map a (S.Set a) -> [(a, a)] 
graphMapSetToEdges = graphListsToEdges . graphMapSetToLists 
 
 
-- Simple test 
test = graphMapSetToEdges . closure . graphEdgesToMapSet 
 
test1 = test [(1, 2), (1, 3)] 
test2 = test [(1, 2), (1, 3), (4, 5), (5, 6)] 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.