Commit 58e1e578 authored by Grégoire Locqueville's avatar Grégoire Locqueville

Fix spinglass functions

Spinglass functions would output incoherent clusters when the input graph
was nonconnected.
parent a36d62b5
......@@ -627,7 +627,6 @@ library
, servant-websockets >= 2.0.0 && < 2.1
, servant-xml-conduit ^>= 0.1.0.4
, shelly >= 1.9 && < 2
, singletons ^>= 3.0.2
, singletons-th >= 3.1 && < 3.3
, smtp-mail >= 0.3.0.0
, split >= 0.2.3.4
......
......@@ -16,8 +16,6 @@ module Gargantext.Core.Viz.Graph.Tools.IGraph
where
import Data.Serialize
import Data.Singletons (SingI)
import Gargantext.Core.Viz.Graph.Index
import Graph.Types (ClusterNode(..))
import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
import Protolude
......@@ -63,46 +61,34 @@ type Seed = Int
spinglass :: Seed -> Map (Int, Int) Double -> IO [ClusterNode]
spinglass s g = toClusterNode
<$> map catMaybes
<$> map (map (\n -> Map.lookup n fromI))
<$> List.concat
<$> mapM (partitions_spinglass' s) g'
where
-- Not connected components of the graph make crash spinglass
g' = IG.decompose $ mkGraphUfromEdges
$ Map.keys
$ toIndex toI g
(toI, fromI) = createIndices g
-- Non-connected graphs make spinglass crash
g' = IG.decompose -- decompose graph into connected components
$ edgeList2UGraph -- convert into IGraph type
$ Map.keys g -- retrieve edges in the form of `(Int, Int)`
spinglass' :: Seed -> Map (Int, Int) Double -> IO [Set Int]
spinglass' s g = map Set.fromList
<$> map catMaybes
<$> map (map (\n -> Map.lookup n fromI))
<$> List.concat
<$> mapM (partitions_spinglass' s) g'
where
-- Not connected components of the graph make crash spinglass
g' = IG.decompose $ mkGraphUfromEdges
$ Map.keys
$ toIndex toI g
(toI, fromI) = createIndices g
-- Non-connected graphs make spinglass crash
g' = IG.decompose -- decompose graph into connected components
$ edgeList2UGraph -- convert into IGraph type
$ Map.keys g -- retrieve edges in the form of `(Int, Int)`
-- | Tools to analyze graphs
partitions_spinglass' :: (Serialize v, Serialize e)
=> Seed -> IG.Graph 'U v e -> IO [[Int]]
partitions_spinglass' :: (Serialize v, Serialize e, Show v)
=> Seed -> IG.Graph 'U v e -> IO [[v]]
partitions_spinglass' s g = do
gen <- IG.withSeed s pure
res <- IG.findCommunity g Nothing Nothing IG.spinglass gen
-- res <- IG.findCommunity g Nothing Nothing IG.leiden gen
-- res <- IG.findCommunity g Nothing Nothing IG.infomap gen
saveAsFileDebug "/tmp/res" res
pure res
rawClusters <- IG.findCommunity g Nothing Nothing IG.spinglass gen
let clusterLabels = (fmap . fmap) (IG.nodeLab g) rawClusters
saveAsFileDebug "/tmp/res" clusterLabels
pure clusterLabels
toClusterNode :: [[Int]] -> [ClusterNode]
......@@ -110,20 +96,17 @@ toClusterNode ns = List.concat
$ map (\(cId, ns') -> map (\n -> ClusterNode n cId) ns')
$ List.zip [1..] ns
------------------------------------------------------------------
mkGraph :: (SingI d, Ord v,
Serialize v, Serialize e) =>
[v] -> [LEdge e] -> IG.Graph d v e
mkGraph = IG.mkGraph
-- | Make an undirected IGraph graph from a list of edges between `Int`s.
-- The output graph's vertices are labeled with the original `Int`s, and the
-- edges are not labeled.
edgeList2UGraph :: [(Int, Int)] -> IG.Graph 'U Int ()
edgeList2UGraph edgeList =
-- We're not using `IG.mkGraph` because of the following ticket:
-- https://gitlab.iscpif.fr/gargantext/haskell-igraph/issues/4
IG.fromLabeledEdges $ fmap (\edge -> (edge, ())) $ edgeList
------------------------------------------------------------------
mkGraphUfromEdges :: [(Int, Int)] -> Graph_Undirected
mkGraphUfromEdges es = mkGraph (List.replicate n ()) $ zip es $ repeat ()
mkGraphUfromEdges es = IG.mkGraph (List.replicate n ()) $ zip es $ repeat ()
where
(a,b) = List.unzip es
n = List.length (List.nub $ a <> b)
{-
mkGraphDfromEdges :: [(Int, Int)] -> Graph_Directed
mkGraphDfromEdges = undefined
-}
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