{-|
Module      : Gargantext.Core.Viz.Graph.Tools.IGraph
Description : Tools to build Graph
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Reference:
* Gábor Csárdi, Tamás Nepusz: The igraph software package for complex network research. InterJournal Complex Systems, 1695, 2006.

-}

module Gargantext.Core.Viz.Graph.Tools.IGraph
  ( spinglass
  , mkGraphUfromEdges
  ) where

import Data.Serialize (Serialize)
import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
import Protolude
import qualified Data.List                   as List
import qualified Data.Map.Strict             as Map
import qualified IGraph                      as IG
import qualified IGraph.Algorithms.Community as IG
import qualified IGraph.Algorithms.Structure as IG
import qualified IGraph.Random               as IG
import qualified Data.Set                    as Set


-- | Cluster a graph using the Spinglass algorithm
-- Warning: Currently, this does not take the weights into account, all vertices
-- and edges are treated equally.
-- TODO Take the weights into account
spinglass :: Int                   -- ^ Random seed
          -> Map (Int, Int) Double -- ^ Weight map of the graph
          -> IO [Set Int]          -- ^ A list of clusters, in the form of sets of vertex IDs
spinglass seed graph = graph
   -- Non-connected graphs make Spinglass crash, so we
   -- decompose the graph into connected components perform
   -- the algorithm on each component, and then put the
   -- clusterings together.
   &  Map.keys                 -- get all edges in the form of pairs of vertex IDs
   &  edgeList2UGraph          -- turn that into an IGraph graph
   &  IG.decompose             -- split the graph into connected components
   &  mapM (spinglassAux seed) -- perform Spinglass on each subgraph
  <&> List.concat              -- put all clusterings together
  <&> map Set.fromList         -- convert clusters from list to set


-- | Helper function for `spinglass`. Same as `spinglass`, except the input and
-- output are represented using different types
spinglassAux :: (Serialize v, Serialize e, Show v)
             => Int             -- ^ Random seed
             -> IG.Graph 'U v e -- ^ Input graph
             -> IO [[v]]        -- ^ List of clusters, in the form of lists of vertex labels
spinglassAux seed graph = IG.withSeed seed $ \gen -> do -- initialize random generator
  rawClusters <- IG.findCommunity graph Nothing Nothing IG.spinglass gen -- perform clustering
  -- The clusters we get are composed of vertex IDs corresponding to the internal
  -- representation of IGraph graphs, so we need to retrieve the vertex labels:
  let clusterLabels = (fmap . fmap) (IG.nodeLab graph) rawClusters
  pure clusterLabels -- return the result


-- | 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 issue raised in the following ticket:
 -- https://gitlab.iscpif.fr/gargantext/haskell-igraph/issues/4
  IG.fromLabeledEdges $ fmap (\edge -> (edge, ())) $ edgeList


-- | Make an "anonymous" (i.e. without labels) graph out of a list of edges.
-- Warning: there is no guarantee, as far as I know, that the underlying
-- representation of the nodes corresponds to the original `Int`.
mkGraphUfromEdges :: [(Int, Int)] -> IG.Graph 'U () ()
mkGraphUfromEdges es = IG.mkGraph (List.replicate n ()) $ fmap makeLEdge es
  where
    makeLEdge e = (e, ())
    n         = Set.size nodes
    nodes     = Set.fromList $ map fst es