Commit f9292434 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[DOC+first version] test is ko

parent e170273d
...@@ -4,7 +4,7 @@ cabal-version: 1.12 ...@@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 85a89537835f3546235aaf6eea2ef007ef1dd0406a6c9afc4bf6119d2f8239f0 -- hash: f5efad8af0a555a91b2aa7b955eb00996a2391daa5222b63ae306ad40e22121c
name: clustering-louvain name: clustering-louvain
version: 0.1.0.0 version: 0.1.0.0
...@@ -37,6 +37,7 @@ library ...@@ -37,6 +37,7 @@ library
Data.Graph.Clustering.Louvain.IO.Gexf Data.Graph.Clustering.Louvain.IO.Gexf
Data.Graph.Clustering.Louvain.CplusPlus Data.Graph.Clustering.Louvain.CplusPlus
other-modules: other-modules:
Data.Graph.Clustering.Example
Data.Graph.Clustering.HLouvain Data.Graph.Clustering.HLouvain
Paths_clustering_louvain Paths_clustering_louvain
default-language: Haskell2010 default-language: Haskell2010
module Data.Example where module Data.Graph.Clustering.Example where
import Data.List (sort) import Data.List (sort)
import Data.Utils import Data.Graph.Clustering.Louvain.Utils
import Data.Graph.Inductive import Data.Graph.Inductive
......
{-| {-|
Module : Data.Graph.Clustering.HLouvain Module : Data.Graph.Clustering.HLouvain
Description : Purely functional (Inductive) Louvain clustering Description : Purely functional (Inductive) Louvain clustering
Copyright : (c) CNRS, 2020-Present Copyright : (c) Alexandre Delanoë, CNRS, 2020-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
Maintainer : alexandre.delanoe+louvain@iscpif.fr Maintainer : alexandre.delanoe+louvain@iscpif.fr
Stability : experimental Stability : experimental
Portability : POSIX Portability : POSIX
Main Reference:
* Blondel, Vincent D; Guillaume, Jean-Loup; Lambiotte, Renaud; Lefebvre, Etienne (9 October 2008). "Fast unfolding of communities in large networks". Journal of Statistical Mechanics: Theory and Experiment. 2008 (10): P10008. arXiv:0803.0476 Freely accessible. doi:10.1088/1742-5468/2008/10/P10008.
* Louvain_Modularity https://en.wikipedia.org/wiki/Louvain_Modularity
-} -}
...@@ -18,7 +14,7 @@ module Data.Graph.Clustering.HLouvain ...@@ -18,7 +14,7 @@ module Data.Graph.Clustering.HLouvain
where where
import Data.Ord (Down(..)) import Data.Ord (Down(..))
import Data.List (sortOn) import Data.List (sortOn, foldl')
import Data.Graph.Inductive import Data.Graph.Inductive
-- import Data.Graph.Clustering.Louvain -- import Data.Graph.Clustering.Louvain
...@@ -26,20 +22,28 @@ import Data.Graph.Inductive ...@@ -26,20 +22,28 @@ import Data.Graph.Inductive
-- | Main Tools -- | Main Tools
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Glustering (instead of clustering) since we are working on the glue
-- between nodes to create "glusters" of nodes
glustering :: DynGraph gr glustering :: DynGraph gr
=> gr a b => gr a b
-> [Module] -> [Module]
glustering g = undefined glustering g = foldl' (\a b -> modulare g b a) [] modules
where
modules :: [Module]
modules = map (\n -> Module n [] (modularity' g [n])) ns
ns :: [Node]
ns = sortOn (Down . (deg g)) $ nodes g
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Definitions -- | Definitions
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Module = Module { node :: Node data Module = Module { node :: !Node
, modules :: [Module] , modules :: ![Module]
, score :: Double , score :: !Double
} }
deriving (Show)
-- | Divide en conquer method -- | Divide en conquer method
modulare :: DynGraph gr modulare :: DynGraph gr
...@@ -64,9 +68,9 @@ flat (Module n ns _) = [n] ++ (concat $ map flat ns) ...@@ -64,9 +68,9 @@ flat (Module n ns _) = [n] ++ (concat $ map flat ns)
-- | TODO Sum or Union -> QuickCheck -- | TODO Sum or Union -> QuickCheck
modularity :: DynGraph gr => gr a b -> Module -> Double modularity :: DynGraph gr => gr a b -> Module -> Double
modularity g m = modularity' g (flat m) modularity g m = modularity' g (flat m)
where
modularity' :: DynGraph gr => gr a b -> [Node] -> Double modularity' :: DynGraph gr => gr a b -> [Node] -> Double
modularity' gr ns = coverage - edgeDensity modularity' gr ns = coverage - edgeDensity
where where
coverage :: Double coverage :: Double
coverage = sizeSubGraph / sizeAllGraph coverage = sizeSubGraph / sizeAllGraph
......
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