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

[FIX] clustering-louvain dep (readme).

parent eade2d55
......@@ -48,6 +48,10 @@ sudo apt-get install libbz2-dev lipq-dev
git clone https://github.com/np/servant-job.git
### Get the clustering louvain library
git clone https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
## Building and installing
stack install
......
Copyright Alexandre Delanoë (c) 2016
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Alexandre Delanoë nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file
module Main where
import System.Environment (getArgs)
import Data.Louvain
import Data.Utils
import Data.GexfParser
main :: IO ()
main = do
[file] <- getArgs
graph <- mkGraph' <$> importGraphFromGexf file
print $ bestpartition True graph
module Data.Example where
import Data.List (sort)
import Data.Utils
import Data.Graph.Inductive
karate :: Gr () Double
-- karate = mkGraph' <$> importGraphFromGexf "src/Data/karate.gexf"
karate = mkGraph [(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,())] [(1,2,1.0),(1,3,1.0),(1,4,1.0),(1,5,1.0),(1,6,1.0),(1,7,1.0),(1,8,1.0),(1,9,1.0),(1,11,1.0),(1,12,1.0),(1,13,1.0),(1,14,1.0),(1,18,1.0),(1,20,1.0),(1,22,1.0),(1,32,1.0),(2,3,1.0),(2,4,1.0),(2,8,1.0),(2,14,1.0),(2,18,1.0),(2,20,1.0),(2,22,1.0),(2,31,1.0),(3,4,1.0),(3,8,1.0),(3,9,1.0),(3,10,1.0),(3,14,1.0),(3,28,1.0),(3,29,1.0),(3,33,1.0),(4,8,1.0),(4,13,1.0),(4,14,1.0),(5,7,1.0),(5,11,1.0),(6,7,1.0),(6,11,1.0),(6,17,1.0),(7,17,1.0),(9,31,1.0),(9,33,1.0),(9,34,1.0),(10,34,1.0),(14,34,1.0),(15,33,1.0),(15,34,1.0),(16,33,1.0),(16,34,1.0),(19,33,1.0),(19,34,1.0),(20,34,1.0),(21,33,1.0),(21,34,1.0),(23,33,1.0),(23,34,1.0),(24,26,1.0),(24,28,1.0),(24,30,1.0),(24,33,1.0),(24,34,1.0),(25,26,1.0),(25,28,1.0),(25,32,1.0),(26,32,1.0),(27,30,1.0),(27,34,1.0),(28,34,1.0),(29,32,1.0),(29,34,1.0),(30,33,1.0),(30,34,1.0),(31,33,1.0),(31,34,1.0),(32,33,1.0),(32,34,1.0),(33,34,1.0)]
karate2com :: [[Node]]
karate2com = sort $ Prelude.map (sort) [[10, 29, 32, 25, 28, 26, 24, 30, 27, 34, 31, 33, 23, 15, 16, 21, 19], [3, 9, 8, 4, 14, 20, 2, 13, 22, 1, 18, 12, 5, 7, 6, 17]]
eU :: [LEdge Double]
eU = [
(2,1,1)
,(1,2,1)
,(1,4,1)
,(4,1,1)
,(2,3,1)
,(3,2,1)
,(3,4,1)
,(4,3,1)
,(4,5,1)
,(5,4,1)
]
eD :: [LEdge Double]
eD = [
(2,1,1)
,(1,4,1)
,(2,3,1)
,(3,4,1)
,(4,5,1)
]
gU :: Gr () Double
gU = mkGraph' eU
-- > prettyPrint gU
-- 1:()->[(1,2),(1,4)]
-- 2:()->[(1,1),(1,3)]
-- 3:()->[(1,2),(1,4)]
-- 4:()->[(1,1),(1,3),(1,5)]
-- 5:()->[(1,4)]
-- Visual representation:
--
-- 2
-- / \
-- 1 3
-- \ /
-- 4
-- |
-- 5
--
--
gD :: Gr () Double
gD = mkGraph' eD
eD' :: [LEdge Double]
eD' = [
(2,1,1)
,(1,4,1)
,(2,3,1)
,(3,4,1)
,(4,5,1)
,(5,6,1)
,(5,7,1)
,(6,7,1)
]
gD' :: Gr () Double
gD' = mkGraph' eD'
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
module Data.GexfParser (importGraphFromGexf)
where
import Text.XML.HXT.Core
-- import qualified Data.Graph as DataGraph
import qualified Data.Graph.Inductive as FGL
import System.Environment (getArgs)
data Graph = Graph
{ graphId :: String,
nodes :: [String],
edges :: [(String, String)] -- (Source, target)
}
deriving (Show, Eq)
atTag tag = deep (isElem >>> hasName tag)
parseEdges = atTag "edge" >>>
proc e -> do
source <- getAttrValue "source" -< e
target <- getAttrValue "target" -< e
returnA -< (source, target)
parseNodes = atTag "node" >>>
proc n -> do
nodeId <- getAttrValue "id" -< n
returnA -< nodeId
parseGraph = atTag "graph" >>>
proc g -> do
graphId <- getAttrValue "id" -< g
nodes <- listA parseNodes -< g
edges <- listA parseEdges -< g
returnA -< Graph{graphId=graphId, nodes=nodes, edges=edges}
getEdges = atTag "edge" >>> getAttrValue "source"
-- Get targets for a single node in a Graph
getTargets :: String -> Graph -> [String]
getTargets source graph = map snd $ filter ((==source).fst) $ edges graph
-- Convert a graph node into a Data.Graph-usable
-- getDataGraphNode :: Graph -> String -> (String, String, [String])
-- getDataGraphNode graph node = (node, node, getTargets node graph)
--
--
-- getDataGraphNode' :: Graph -> String -> (Int, [Int])
-- getDataGraphNode' graph node = (read node, Prelude.map read (getTargets node graph))
--
-- -- Convert a Graph instance into a Data.Graph list of (node, nodeid, edge) tuples
-- getDataGraphNodeList :: Graph -> [(String, String, [String])]
-- getDataGraphNodeList graph = map (getDataGraphNode graph) (nodes graph)
--
-- getDataGraphNodeList' :: Graph -> [(Int, [Int])]
-- getDataGraphNodeList' graph = map (getDataGraphNode' graph) (nodes graph)
--
-- -- Convert Graph structure to Data.Graph-importable tuple list
-- importGraph :: FilePath -> IO [(Int, [Int])]
-- importGraph file = do
-- graphs <- runX (readDocument [withValidate no] file >>> parseGraph)
-- let graphEdges = getDataGraphNodeList' $ head graphs
-- return graphEdges
--
--importGraph' :: FilePath -> IO [(Int, [Int])]
importGraph' file = runX (readDocument [withValidate no] file >>> parseGraph)
importGraphFromGexf :: FilePath -> IO [FGL.LEdge Double]
importGraphFromGexf file = Prelude.map (\(a,b) -> (read a, read b, 1)) <$> edges <$> head <$> importGraph' file
--main :: IO()
-- main = do
-- [file] <- getArgs
-- importGraph file >>= print
--
-- Convert to a Data.Graph
-- let (graph, vertexMap) = DataGraph.graphFromEdges' graphEdges
-- Example of what to do with the Graph: Print vertices
-- print $ map ((\ (vid, _, _) -> vid) . vertexMap) (DataGraph.vertices graph)
module Data.Louvain where
import Data.List (maximumBy,nub, intersect, scanl', foldl')
import Data.Graph.Inductive
------------------------------------------------------------------------
-- | Definitions
------------------------------------------------------------------------
type Modularity = Double
type Community = [Node]
-- type Community' = Community { nodes :: [Node], modularity :: Maybe Modularity}
-- type Partition = [Community]
type Reverse = Bool
------------------------------------------------------------------------
-- | Partitionning the graph
------------------------------------------------------------------------
bestpartition :: (Eq b, DynGraph gr) => Reverse -> gr a b -> [[Node]]
bestpartition r gr = converge gr (start gr r)
converge :: (Eq b, DynGraph gr) => gr a1 b -> [[Node]] -> [[Node]]
converge gr ns = case stepscom gr (length ns) ns of
ns' | ns == ns' -> ns
| otherwise -> stepscom gr (length ns') ns'
------------------------------------------------------------------------
dendogram :: (Eq b, DynGraph gr) => gr a b -> Int -> Reverse -> [[Node]]
dendogram gr n r = stepscom gr n (start gr r)
start :: DynGraph gr => gr a b -> Reverse -> [[Node]]
start gr r = order $ Prelude.map (\x -> [] ++ [x]) ( nodes gr )
where
order = case r of
True -> reverse
False -> id
------------------------------------------------------------------------
------------------------------------------------------------------------
stepscom :: (DynGraph gr, Eq b) => gr a1 b -> Int -> [[Node]] -> [[Node]]
stepscom gr n ns = foldl' (\xs _ -> stepcom gr' (smallCom xs) xs) ns [1..n]
where
gr' = undir gr
smallCom xs = head $ filter (\x -> length x == minimum (Prelude.map length xs)) (reverse xs)
stepscom' :: (DynGraph gr, Eq b) => gr a1 b -> Int -> [[Node]] -> [[Node]]
stepscom' gr n ns = foldl' (\xs _ -> stepcom' gr' (smallCom xs) xs) ns [1..n]
where
gr' = undir gr
smallCom xs = head $ filter (\x -> length x == minimum (Prelude.map length xs)) (reverse xs)
------------------------------------------------------------------------
stepcom' :: DynGraph gr => gr a b -> [Node] -> [[Node]] -> [[Node]]
stepcom' gr n ns = bestModularities gr $ Prelude.map (\x -> x ++ neighout) (addcom n neighin)
where
-- | First remove the node (n) of the current partition (ns)
ns' = filter (/= n) ns
neighin = filter (\c -> (intersect (neighcom gr n) c) /= [] ) ns'
neighout = filter (\c -> (intersect (neighcom gr n) c) == [] ) ns'
stepcom :: DynGraph gr => gr a b -> [Node] -> [[Node]] -> [[Node]]
stepcom gr n ns = bestModularities gr $ [ns] ++ Prelude.map (\x -> x ++ neighout) (addcom n neighin)
where
-- | First remove the node (n) of the current partition (ns)
ns' = filter (/= n) ns
neighin = filter (\c -> (intersect (neighcom gr n) c) /= [] ) ns'
neighout = filter (\c -> (intersect (neighcom gr n) c) == [] ) ns'
addcom :: [a] -> [[a]] -> [[[a]]]
addcom com coms = Prelude.map (\n -> addcom' com (rotate n coms)) ns
where
ns = [0.. fromIntegral (length coms) ]
addcom' c cs = [com'] ++ coms''
where
com' = concat $ [c] ++ (take 1 cs)
coms'' = drop 1 cs
neighcom :: DynGraph gr => gr a b -> [Node] -> [Node]
neighcom gr ns = ( nub . filter (not . (`elem` ns)) . concat ) ns'
where ns' = Prelude.map (neighbors gr) ns
rotate :: Int -> [a] -> [a]
rotate _ [] = []
rotate n xs = zipWith const (drop n (cycle xs)) xs
------------------------------------------------------------------------
-- | Computing modularity of the partition
------------------------------------------------------------------------
modularities :: DynGraph gr => gr a b -> [[Node]] -> Double
modularities gr xs = sum $ Prelude.map (\y -> modularity gr y) xs
compareModularities :: DynGraph gr => gr a b -> [[Node]] -> [[Node]] -> Ordering
compareModularities gr xs ys
| modularities gr xs < modularities gr ys = LT
| modularities gr xs > modularities gr ys = GT
| otherwise = EQ
bestModularities :: DynGraph gr => gr a b -> [[[Node]]] -> [[Node]]
bestModularities gr ns = maximumBy (compareModularities gr) ns
modularity :: DynGraph gr => gr a b -> [Node] -> Double
modularity gr ns = coverage - edgeDensity
where
coverage :: Double
coverage = sizeSubGraph / sizeAllGraph
where
sizeSubGraph :: Double
sizeSubGraph = fromIntegral ( size $ subgraph ns gr )
sizeAllGraph :: Double
sizeAllGraph = fromIntegral (size gr)
edgeDensity :: Double
edgeDensity = (sum (Prelude.map (\node -> (degree node) / links ) ns)) ** 2
where
degree :: Node -> Double
degree node = fromIntegral (deg gr node)
links :: Double
links = fromIntegral (2 * (size gr))
----------------------------------------------------------
-- | Discover what NP complete means:
----------------------------------------------------------
takeDrop :: Int -> [a] -> [[a]]
takeDrop n xs = [ (take n xs), drop n xs]
-- http://stackoverflow.com/questions/35388734/list-partitioning-implemented-recursively
separate :: [a] -> [[[a]]]
separate [] = [[]]
separate (x:xs) = let recur = separate xs
split = do
partition <- recur
return $ [x] : partition
noSplit = do
(y:ys) <- recur
return $ (x:y):ys
in split ++ noSplit
-- separate' :: forall a. [a] -> [[[a]]]
-- separate' xs = [ takeDrop t (rotate r xs)
-- | t <- [1.. fromIntegral (length xs) - 1 ]
-- , r <- [0.. fromIntegral (length xs) ]
-- ]
gpartition :: DynGraph gr => gr a b -> [[[Node]]]
gpartition gr = separate (nodes gr)
bestPartition' :: DynGraph gr => gr a b -> [[Node]]
bestPartition' gr = maximumBy (compareModularities gr) $ gpartition gr
----------------------------------------------------------
module Data.Utils where
import Data.Maybe
import Data.Graph.Inductive
import Data.List (nub)
label' :: (Graph gr) => gr a b -> Edge -> Maybe b
label' gr (u,v) = lookup v (lsuc gr u)
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
mkGraph' :: [LEdge b] -> Gr () b
mkGraph' es = mkGraph ns es
where
ns :: [LNode ()]
ns = zip [1.. (fromIntegral . length) ns'] (repeat ())
where ns' = nub $ concat (Prelude.map edge2nodes es)
edge2nodes :: LEdge b -> [Node]
edge2nodes (a,b,_) = [a,b]
<?xml version="1.0" encoding="utf-8"?><gexf version="1.1" xmlns="http://www.gexf.net/1.1draft" xmlns:viz="http://www.gexf.net/1.1draft/viz" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.w3.org/2001/XMLSchema-instance">
<graph defaultedgetype="undirected" mode="static">
<nodes>
<node id="1" label="1" />
<node id="2" label="2" />
<node id="3" label="3" />
<node id="4" label="4" />
<node id="5" label="5" />
<node id="6" label="6" />
<node id="7" label="7" />
<node id="8" label="8" />
<node id="9" label="9" />
<node id="10" label="10" />
<node id="11" label="11" />
<node id="12" label="12" />
<node id="13" label="13" />
<node id="14" label="14" />
<node id="15" label="15" />
<node id="16" label="16" />
<node id="17" label="17" />
<node id="18" label="18" />
<node id="19" label="19" />
<node id="20" label="20" />
<node id="21" label="21" />
<node id="22" label="22" />
<node id="23" label="23" />
<node id="24" label="24" />
<node id="25" label="25" />
<node id="26" label="26" />
<node id="27" label="27" />
<node id="28" label="28" />
<node id="29" label="29" />
<node id="30" label="30" />
<node id="31" label="31" />
<node id="32" label="32" />
<node id="33" label="33" />
<node id="34" label="34" />
</nodes>
<edges>
<edge id="0" source="1" target="32" />
<edge id="1" source="1" target="2" />
<edge id="2" source="1" target="3" />
<edge id="3" source="1" target="4" />
<edge id="4" source="1" target="5" />
<edge id="5" source="1" target="6" />
<edge id="6" source="1" target="7" />
<edge id="7" source="1" target="8" />
<edge id="8" source="1" target="9" />
<edge id="9" source="1" target="11" />
<edge id="10" source="1" target="12" />
<edge id="11" source="1" target="13" />
<edge id="12" source="1" target="14" />
<edge id="13" source="1" target="18" />
<edge id="14" source="1" target="20" />
<edge id="15" source="1" target="22" />
<edge id="16" source="2" target="3" />
<edge id="17" source="2" target="4" />
<edge id="18" source="2" target="8" />
<edge id="19" source="2" target="14" />
<edge id="20" source="2" target="18" />
<edge id="21" source="2" target="20" />
<edge id="22" source="2" target="22" />
<edge id="23" source="2" target="31" />
<edge id="24" source="3" target="4" />
<edge id="25" source="3" target="33" />
<edge id="26" source="3" target="8" />
<edge id="27" source="3" target="9" />
<edge id="28" source="3" target="10" />
<edge id="29" source="3" target="14" />
<edge id="30" source="3" target="28" />
<edge id="31" source="3" target="29" />
<edge id="32" source="4" target="8" />
<edge id="33" source="4" target="13" />
<edge id="34" source="4" target="14" />
<edge id="35" source="5" target="11" />
<edge id="36" source="5" target="7" />
<edge id="37" source="6" target="7" />
<edge id="38" source="6" target="11" />
<edge id="39" source="6" target="17" />
<edge id="40" source="7" target="17" />
<edge id="41" source="9" target="31" />
<edge id="42" source="9" target="34" />
<edge id="43" source="9" target="33" />
<edge id="44" source="10" target="34" />
<edge id="45" source="14" target="34" />
<edge id="46" source="15" target="33" />
<edge id="47" source="15" target="34" />
<edge id="48" source="16" target="33" />
<edge id="49" source="16" target="34" />
<edge id="50" source="19" target="33" />
<edge id="51" source="19" target="34" />
<edge id="52" source="20" target="34" />
<edge id="53" source="21" target="33" />
<edge id="54" source="21" target="34" />
<edge id="55" source="23" target="33" />
<edge id="56" source="23" target="34" />
<edge id="57" source="24" target="33" />
<edge id="58" source="24" target="26" />
<edge id="59" source="24" target="28" />
<edge id="60" source="24" target="34" />
<edge id="61" source="24" target="30" />
<edge id="62" source="25" target="32" />
<edge id="63" source="25" target="26" />
<edge id="64" source="25" target="28" />
<edge id="65" source="26" target="32" />
<edge id="66" source="27" target="34" />
<edge id="67" source="27" target="30" />
<edge id="68" source="28" target="34" />
<edge id="69" source="29" target="32" />
<edge id="70" source="29" target="34" />
<edge id="71" source="30" target="33" />
<edge id="72" source="30" target="34" />
<edge id="73" source="31" target="34" />
<edge id="74" source="31" target="33" />
<edge id="75" source="32" target="33" />
<edge id="76" source="32" target="34" />
<edge id="77" source="33" target="34" />
</edges>
</graph>
</gexf>
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-11.10
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
# git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# subdirs:
# - auto-update
# - wai
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver
# using the same syntax as the packages field.
# (e.g., acme-missiles-0.3)
# extra-deps: []
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.7"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
\ No newline at end of file
http://ptrckprry.com/course/ssd/lecture/community.html
import networkx as nx
import community as co
from collections import defaultdict
karate = nx.read_gexf("../src/Data/karate.gexf")
part = co.best_partition(karate)
print(karate.edges())
#result = defaultdict(list)
result = dict()
for k,v in part.items():
if v is not None:
r = result.get(v, [])
r.append(k)
result[v] = r
print(result)
--import Data.List (sort)
---- import Data.Example
--import Data.Louvain
--
--
--testKarate2com = do
-- p <- bestpartition True <$> karate
-- k <- karate
-- let result = (sort $ Prelude.map (sort) (stepscom' k 2 p))
-- print result
-- print karate2com
-- print $ result == karate2com
--
main :: IO ()
main = print "undefined" -- testKarate2com
http://www-rohan.sdsu.edu/~gawron/python_for_ss/course_core/book_draft/Social_Networks/Social_Networks.html
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