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

[FUN] flouvain function.

parent f0f00ffd
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.Graph.Clustering.Example where
......@@ -16,8 +18,8 @@ import Text.Parsec.Language (haskellStyle)
import qualified Text.Parsec.Token as PT
-- | Utility function to remap Gr () Double into FGraph () ()
exampleRemap :: Gr () Double -> FGraph () ()
exampleRemap gr = gmap remap gr
toFgraph :: Gr () Double -> FGraph () ()
toFgraph gr = gmap remap gr
where
remap :: Context () Double -> Context () (Weight, ())
remap (p, v, l, s) = (p', v, l, s')
......@@ -33,16 +35,16 @@ exampleRemap gr = gmap remap gr
iterateOnce :: Gr () Double -> CGr
iterateOnce gr = iteration fgr cgr
where
fgr = exampleRemap gr
fgr = toFgraph gr
cgr = initialCGr fgr
runIterations :: Int -> Gr () Double -> IO ()
runIterations n gr = do
let fgr = exampleRemap gr
let fgr = toFgraph gr
let fgrWeight = graphWeight fgr
let initCgr = initialCGr fgr
putStrLn "Initial modularity: "
putStrLn ("Initial modularity: " :: Text)
putStrLn $ T.unpack $ show $ modularity fgr initCgr fgrWeight
foldM_ (runIteration fgr fgrWeight) initCgr [0..n]
......@@ -50,16 +52,16 @@ runIterations n gr = do
where
runIteration fgr fgrWeight iterCgr i = do
let iterNextCgr = iteration fgr iterCgr
putStrLn $ "----- ITERATION " <> show i
putStrLn $ ("----- ITERATION " :: Text) <> show i
putStrLn $ prettify iterNextCgr
putStrLn $ show i <> " iteration modularity: "
putStrLn $ show i <> (" iteration modularity: " :: Text)
putStrLn $ T.unpack $ show $ modularity fgr iterNextCgr fgrWeight
return iterNextCgr
runLouvainFirstStepIterate :: Int -> Gr () Double -> (Modularity, CGr)
runLouvainFirstStepIterate n gr = (modularity fgr cgr m, cgr)
where
fgr = exampleRemap gr
fgr = toFgraph gr
cgr = louvainFirstStepIterate n fgr
m = graphWeight fgr
......@@ -152,9 +154,7 @@ gU = mkGraph' eU
cuiller :: Gr () Double
cuiller = gU
-- Visual representation:
--
-- 2
-- / \
-- 1 3
......
......@@ -57,7 +57,10 @@ data ClusteringMethod = Glue | Klue
-- 'a' is the initial value
fixPt :: Int -> (a -> a) -> (a -> Bool) -> a -> a
fixPt 0 iterator _ init = iterator init
fixPt n iterator cond init = if cond next then fixPt (n - 1) iterator cond init else next
fixPt n iterator cond init =
if cond next
then fixPt (n - 1) iterator cond init
else next
where
next = iterator init
......
......@@ -18,10 +18,12 @@ References:
module Data.Graph.Clustering.Louvain
where
import Data.Tuple.Extra (fst3)
import Data.List (maximumBy, nub, intersect, foldl', zipWith, concat)
import Data.Graph.Inductive
import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
import Data.Graph.Clustering.FLouvain (louvainFirstStepIterate, Community(..), initialCGr)
import Data.Graph.Clustering.Example (toFgraph)
------------------------------------------------------------------------
-- | Definitions
------------------------------------------------------------------------
......@@ -31,6 +33,11 @@ type Community = [Node]
-- type Partition = [Community]
type Reverse = Bool
------------------------------------------------------------------------
flouvain :: Int -> Gr () Double -> [[Node]]
flouvain n g = map (fst3 . unCommunity . snd) $ labNodes g'
where
g' = louvainFirstStepIterate n (toFgraph g)
------------------------------------------------------------------------
hLouvain :: (Eq b, DynGraph gr)
=> Reverse
......@@ -41,7 +48,6 @@ hLouvain r g = concat $ toLouvainNode (bestpartition r g)
toLouvainNode :: [[Node]] -> [[LouvainNode]]
toLouvainNode ns = zipWith (\cId ns' -> map (\n -> LouvainNode n cId) ns')
[1..] ns
------------------------------------------------------------------------
-- | Partitionning the graph
------------------------------------------------------------------------
......
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