[Graph] Haskell version removing the c++ one (tech+legal issue mainly).

src/Gargantext/Viz/Graph/API.hs

@@ -181,3 +181,6 @@ graphAsync' u n logStatus = do
                           , _scst_remaining = Just 1
                           , _scst_events    = Just []
                           }
+
+
+

src/Gargantext/Viz/Graph/Tools.hs

@@ -15,9 +15,9 @@ Portability : POSIX
 module Gargantext.Viz.Graph.Tools
   where
 
-import Debug.Trace (trace)
 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
-import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
+import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
+-- import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 import Data.Map (Map)
 import qualified Data.Set as Set
 import Data.Text (Text)
@@ -53,33 +53,33 @@ cooc2graph' threshold myCooc = distanceMap
 
 cooc2graph :: Threshold
            -> (Map (Text, Text) Int)
-           -> IO Graph
-cooc2graph threshold myCooc = do
-  let (ti, _) = createIndices myCooc
-      myCooc' = toIndex ti myCooc
-      matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
-      distanceMat = measureConditional matCooc
-      distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+           -> Graph
+cooc2graph threshold myCooc = data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
+  where
+    (ti, _) = createIndices myCooc
+    myCooc' = toIndex ti myCooc
+    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    distanceMat = measureConditional matCooc
+    distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 
-  let nodesApprox :: Int
-      nodesApprox = n'
-        where
-          (as, bs) = List.unzip $ Map.keys distanceMap
-          n' = Set.size $ Set.fromList $ as <> bs
-      ClustersParams rivers level = {-trace ("nodesApprox: " <> show nodesApprox) $-} clustersParams nodesApprox
+    nodesApprox :: Int
+    nodesApprox = n'
+      where
+        (as, bs) = List.unzip $ Map.keys distanceMap
+        n' = Set.size $ Set.fromList $ as <> bs
+    ClustersParams rivers _level = clustersParams nodesApprox
 
-  partitions <- inMVarIO $ case Map.size distanceMap > 0 of
-    True  -> trace ("level" <> show level) $ cLouvain level distanceMap
-    False -> panic "Text.Flow: DistanceMap is empty"
+    partitions = if (Map.size distanceMap > 0)
+        --then iLouvainMap 100 10 distanceMap
+        then hLouvain distanceMap
+        else panic "Text.Flow: DistanceMap is empty"
+        -- True  -> trace ("level" <> show level) $ cLouvain level distanceMap
 
-  bridgeness' <- trace "bridgeness" $ inMVar $ {-trace ("rivers: " <> show rivers) $-}
-                    bridgeness rivers partitions distanceMap
+    bridgeness' = bridgeness rivers partitions distanceMap
 
-  confluence' <- trace "confluence" $ inMVar $ confluence (Map.keys bridgeness') 3 True False
+    confluence' = confluence (Map.keys bridgeness') 3 True False
 
-  r <- trace "data2graph" $ inMVarIO $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
 
-  pure r
 
 
 
@@ -106,12 +106,13 @@ data2graph :: [(Text, Int)]
            -> Map (Int, Int) Double
            -> Map (Int, Int) Double
            -> [LouvainNode]
-           -> IO Graph
-data2graph labels coocs bridge conf partitions = do
-    
-    let community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
+           -> Graph
+data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
+  where
 
-    nodes <- mapM (setCoord ForceAtlas labels bridge)
+    community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
+
+    nodes = map (setCoord ForceAtlas labels bridge)
           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
                    , node_type = Terms -- or Unknown
                    , node_id    = cs (show n)
@@ -129,7 +130,7 @@ data2graph labels coocs bridge conf partitions = do
                            $ Map.toList bridge
             ]
 
-    let edges = [ Edge { edge_source = cs (show s)
+    edges = [ Edge { edge_source = cs (show s)
                        , edge_target = cs (show t)
                        , edge_weight =  d
                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
@@ -138,7 +139,6 @@ data2graph labels coocs bridge conf partitions = do
                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
                    ]
 
-    pure $ Graph nodes edges Nothing
 
 ------------------------------------------------------------------------
 
@@ -152,22 +152,23 @@ setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 
 
 -- | ACP
-setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> IO Node
-setCoord l labels m (n,node) = getCoord l labels m n
-                           >>= \(x,y) -> pure $ node { node_x_coord = x
-                                                     , node_y_coord = y
-                                                     }
+setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
+setCoord l labels m (n,node) = node { node_x_coord = x
+                                    , node_y_coord = y
+                                    }
+  where
+    (x,y) = getCoord l labels m n
 
 
 getCoord :: Ord a => Layout
-                  -> [(a, Int)] -> Map (Int, Int) Double -> Int -> IO (Double, Double)
-getCoord KamadaKawai _ m n = layout m n
+                  -> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
+getCoord KamadaKawai _ _m _n = undefined -- layout m n
 
-getCoord ForceAtlas _ _ n = pure (sin d, cos d)
+getCoord ForceAtlas _ _ n = (sin d, cos d)
   where
     d = fromIntegral n
 
-getCoord ACP labels m n = pure $ to2d $ maybe (panic "Graph.Tools no coordinate") identity
+getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
              $ Map.lookup n
              $ pcaReduceTo (Dimension 2)
              $ mapArray labels m

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
 - git: https://github.com/np/servant-job.git
   commit: 4016c76398a56e1a352a45b3ee9d698dd0dd2597
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
-  commit: f8fd33e4e9639730d47cd02b223a0f8fbbbfe975
+  commit: 7d74f96dfea8e51fbab1793cc0429b2fe741f73d
 - git: https://github.com/np/patches-map
   commit: 8c6f38c4844ead53e664cf9c82ba461715dbe445
 - git: https://github.com/delanoe/haskell-opaleye.git  #- opaleye-0.6.7002.0