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

[CLEAN+FEAT] adding map2graph function.

parent 4621cb84
module Main where module Main where
import System.Environment (getArgs) import System.Environment (getArgs)
import Data.Louvain import Data.Graph.Clustering.Louvain
import Data.Utils import Data.Graph.Clustering.Louvain.Utils
import Data.GexfParser import Data.IO.Gexf (readGexf)
main :: IO () main :: IO ()
main = do main = do
[file] <- getArgs [file] <- getArgs
graph <- mkGraph' <$> importGraphFromGexf file graph <- mkGraph' <$> readGexf file
print $ bestpartition True graph print $ bestpartition True graph
-- This file has been generated from package.yaml by hpack version 0.28.2.
--
-- see: https://github.com/sol/hpack
--
-- hash: 8da8cdd6f26a2737049e0c5d0375eacb97ed31cc4cff6ee1f5f3a89b10eb1371
name: clustering-louvain
version: 0.1.0.0
synopsis: Clustering FGL graph with Louvain algorithm
description: Please see README.md
category: Data
author: Alexandre Delanoë
maintainer: alexandre.delanoe+louvain@iscpif.fr
copyright: Copyright: (c) 2017-2018: see git logs and README
license: BSD3
license-file: LICENSE
build-type: Simple
cabal-version: >= 1.10
library
exposed-modules:
Data.Graph.Clustering.Louvain
Data.Graph.Clustering.Louvain.Utils
Data.Graph.Clustering.Louvain.IO.Gexf
other-modules:
Paths_clustering_louvain
hs-source-dirs:
src
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports
build-depends:
base >=4.7 && <5
, containers
, extra
, fgl
, hxt
, text
default-language: Haskell2010
test-suite louvain-doctest
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules:
Paths_clustering_louvain
hs-source-dirs:
src-doctest
ghc-options: -Wall -Werror -threaded -rtsopts -with-rtsopts=-N -Wmissing-signatures
build-depends:
Glob
, QuickCheck
, base
, containers
, doctest
, extra
, louvain
, text
default-language: Haskell2010
test-suite louvain-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Paths_clustering_louvain
hs-source-dirs:
src-test
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
build-depends:
base
, containers
, extra
, louvain
, text
default-language: Haskell2010
name: louvain
version: 0.1.0.0
synopsis: Graph Clustering
description: Please see README.md
homepage: https://github.com/adelanoe/louvain#readme
license: BSD3
license-file: LICENSE
author: Alexandre Delanoë
maintainer: alexandre+dev@delanoe.org
copyright: Copyright: (c) 2016 Alexandre Delanoë
category: Data
build-type: Simple
-- extra-source-files:
cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Data.Louvain
, Data.Utils
-- , Data.Example
, Data.GexfParser
build-depends: base >= 4.7 && < 5
, fgl
, hxt
default-language: Haskell2010
-- executable louvain
-- hs-source-dirs: app
-- main-is: MainLouvain.hs
-- ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2
-- build-depends: base >= 4.7 && < 5
-- , fgl
-- , hxt
-- , louvain
-- default-language: Haskell2010
-- --
test-suite louvain-test
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Spec.hs
build-depends: base
, louvain
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
-- source-repository head
-- type: git
-- location: https://github.com/adelanoe/louvain
name: clustering-louvain
version: '0.1.0.0'
synopsis: Clustering FGL graph with Louvain algorithm
description: Please see README.md
category: Data
author: Alexandre Delanoë
maintainer: alexandre.delanoe+louvain@iscpif.fr
copyright:
- ! 'Copyright: (c) 2017-2018: see git logs and README'
license: BSD3
homepage:
ghc-options: -Wall
dependencies:
- extra
- text
- containers
library:
source-dirs: src
ghc-options:
# - -Werror
- -Wincomplete-uni-patterns
- -Wincomplete-record-updates
- -Wmissing-signatures
- -Wunused-binds
- -Wunused-imports
exposed-modules:
- Data.Graph.Clustering.Louvain
- Data.Graph.Clustering.Louvain.Utils
- Data.Graph.Clustering.Louvain.IO.Gexf
dependencies:
- base >= 4.7 && < 5
- fgl
- hxt
tests:
louvain-test:
main: Spec.hs
source-dirs: src-test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- base
- louvain
louvain-doctest:
main: Main.hs
source-dirs: src-doctest
ghc-options:
- -Werror
- -threaded
- -rtsopts
- -with-rtsopts=-N
- -Wmissing-signatures
dependencies:
- doctest
- Glob
- QuickCheck
- base
- louvain
import System.FilePath.Glob
import Test.DocTest
main :: IO ()
main = glob "src/**/*.hs" >>= doctest
module Data.Louvain where {-|
Module : Data.Louvain.Formats.Gexf
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : alexandre.delanoe+louvain@iscpif.fr
Stability : experimental
Portability : POSIX
import Data.List (maximumBy,nub, intersect, scanl', foldl') Tools to clustering Graphs with louvain clustering algorithm.
References:
* 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
-}
module Data.Graph.Clustering.Louvain
where
import Data.List (maximumBy, nub, intersect, foldl')
import Data.Graph.Inductive import Data.Graph.Inductive
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -29,9 +47,9 @@ dendogram :: (Eq b, DynGraph gr) => gr a b -> Int -> Reverse -> [[Node]] ...@@ -29,9 +47,9 @@ dendogram :: (Eq b, DynGraph gr) => gr a b -> Int -> Reverse -> [[Node]]
dendogram gr n r = stepscom gr n (start gr r) dendogram gr n r = stepscom gr n (start gr r)
start :: DynGraph gr => gr a b -> Reverse -> [[Node]] start :: DynGraph gr => gr a b -> Reverse -> [[Node]]
start gr r = order $ Prelude.map (\x -> [] ++ [x]) ( nodes gr ) start gr r = order' $ Prelude.map (\x -> [] ++ [x]) ( nodes gr )
where where
order = case r of order' = case r of
True -> reverse True -> reverse
False -> id False -> id
...@@ -49,7 +67,6 @@ stepscom' gr n ns = foldl' (\xs _ -> stepcom' gr' (smallCom xs) xs) ns [1..n] ...@@ -49,7 +67,6 @@ stepscom' gr n ns = foldl' (\xs _ -> stepcom' gr' (smallCom xs) xs) ns [1..n]
gr' = undir gr gr' = undir gr
smallCom xs = head $ filter (\x -> length x == minimum (Prelude.map length xs)) (reverse xs) smallCom xs = head $ filter (\x -> length x == minimum (Prelude.map length xs)) (reverse xs)
------------------------------------------------------------------------ ------------------------------------------------------------------------
stepcom' :: DynGraph gr => gr a b -> [Node] -> [[Node]] -> [[Node]] stepcom' :: DynGraph gr => gr a b -> [Node] -> [[Node]] -> [[Node]]
......
{-|
Module : Data.Louvain.Formats.Gexf
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Tools to manage GEXF Format Graphs.
-}
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-} {-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
module Data.GexfParser (importGraphFromGexf) module Data.Graph.Clustering.Louvain.IO.Gexf (readGexf)
where where
import Text.XML.HXT.Core import Text.XML.HXT.Core
...@@ -33,7 +45,7 @@ parseGraph = atTag "graph" >>> ...@@ -33,7 +45,7 @@ parseGraph = atTag "graph" >>>
graphId <- getAttrValue "id" -< g graphId <- getAttrValue "id" -< g
nodes <- listA parseNodes -< g nodes <- listA parseNodes -< g
edges <- listA parseEdges -< g edges <- listA parseEdges -< g
returnA -< Graph{graphId=graphId, nodes=nodes, edges=edges} returnA -< Graph graphId nodes edges
getEdges = atTag "edge" >>> getAttrValue "source" getEdges = atTag "edge" >>> getAttrValue "source"
...@@ -63,11 +75,11 @@ getTargets source graph = map snd $ filter ((==source).fst) $ edges graph ...@@ -63,11 +75,11 @@ getTargets source graph = map snd $ filter ((==source).fst) $ edges graph
-- let graphEdges = getDataGraphNodeList' $ head graphs -- let graphEdges = getDataGraphNodeList' $ head graphs
-- return graphEdges -- return graphEdges
-- --
--importGraph' :: FilePath -> IO [(Int, [Int])] importGraph' :: String -> IO [Graph]
importGraph' file = runX (readDocument [withValidate no] file >>> parseGraph) importGraph' file = runX (readDocument [withValidate no] file >>> parseGraph)
importGraphFromGexf :: FilePath -> IO [FGL.LEdge Double] readGexf :: FilePath -> IO [FGL.LEdge Double]
importGraphFromGexf file = Prelude.map (\(a,b) -> (read a, read b, 1)) <$> edges <$> head <$> importGraph' file readGexf file = Prelude.map (\(a,b) -> (read a, read b, 1)) <$> edges <$> head <$> importGraph' file
--main :: IO() --main :: IO()
......
module Data.Utils where {-|
Module : Data.Louvain.Utils
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : alexandre.delanoe+louvain@iscpif.fr
Stability : experimental
Portability : POSIX
Tools to manage Graphs.
-}
module Data.Graph.Clustering.Louvain.Utils
where
import Data.Maybe
import Data.Graph.Inductive import Data.Graph.Inductive
import Data.List (nub) import Data.List (nub)
import Data.Map.Strict (Map, toList)
label' :: (Graph gr) => gr a b -> Edge -> Maybe b label' :: (Graph gr) => gr a b -> Edge -> Maybe b
...@@ -11,7 +24,6 @@ label' gr (u,v) = lookup v (lsuc gr u) ...@@ -11,7 +24,6 @@ label' gr (u,v) = lookup v (lsuc gr u)
shortest_path :: (Real b, Graph gr) => gr a b -> Node -> Node -> Maybe Path shortest_path :: (Real b, Graph gr) => gr a b -> Node -> Node -> Maybe Path
shortest_path graph node_1 node_2= sp node_1 node_2 graph shortest_path graph node_1 node_2= sp node_1 node_2 graph
mkGraph' :: [LEdge b] -> Gr () b mkGraph' :: [LEdge b] -> Gr () b
mkGraph' es = mkGraph ns es mkGraph' es = mkGraph ns es
where where
...@@ -22,5 +34,7 @@ mkGraph' es = mkGraph ns es ...@@ -22,5 +34,7 @@ mkGraph' es = mkGraph ns es
edge2nodes :: LEdge b -> [Node] edge2nodes :: LEdge b -> [Node]
edge2nodes (a,b,_) = [a,b] edge2nodes (a,b,_) = [a,b]
map2graph :: Map (Node, Node) b -> Gr () b
map2graph m = mkGraph' $ map (\((n1,n2), w) -> (n1,n2,w)) $ toList m
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