Commit 2afa4fd0 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[HyperGraph] Finally maybe the right type.

parent ba86adac
......@@ -19,15 +19,15 @@ ILouvain: really inductive Graph
module Data.Graph.Clustering.ILouvain
where
import Data.Maybe (catMaybes)
import Data.List (zip, cycle)
import Protolude hiding (empty)
import Protolude hiding (empty, (&))
import Data.Graph.Inductive
------------------------------------------------------------------------
-- Recursive Graph
data RGraph = Empty | Gr RGraph Double
deriving (Show, Eq)
-- HyperGraph Definition
type HyperGraph a b = Gr (Gr () a) b
------------------------------------------------------------------------
-- Spoon Graph
-- 1
......@@ -38,11 +38,11 @@ data RGraph = Empty | Gr RGraph Double
-- |
-- 5
spoon :: Gr RGraph Double
spoon :: HyperGraph Double Double
spoon = mkGraph ns es
where
ns :: [LNode RGraph]
ns = zip [1..6] (cycle [Empty])
ns :: [LNode (Gr () Double)]
ns = zip [1..6] (cycle [empty])
es :: [LEdge Double]
es = [ (1, 2, 1.0)
......@@ -51,6 +51,26 @@ spoon = mkGraph ns es
, (3, 4, 1.0)
, (4, 5, 1.0)
]
-- | Work in progress:
mvNode :: HyperGraph a a -> Node -> Node -> HyperGraph a a
mvNode g n1 n2 = buildGr $ catMaybes [c1, c2]
where
(c1, g1) = match n1 g
(c2, g2) = match n2 g1
------------------------------------------------------------------------
-- | Recursive Node of Graph
{-
rnodes :: RGraph -> [Node]
rnodes Empty = []
rnodes g = concat $ map (\(x1, x2) -> [x1] <> rnodes x2) $ labNodes g
rlabNodes :: Graph' a b -> [LNode a]
rlabNodes Empty' = []
rlabNodes g = labNodes g
-}
------------------------------------------------------------------------
-- Paths in the Graph to be tested
-- Directed graph strategy
......@@ -67,11 +87,4 @@ path g' = map sortNodes cs
cs = components g
g = undir g'
------------------------------------------------------------------------
------------------------------------------------------------------------
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment