[API] PostNodeAsync (wip)
[gargantext.git] / src / Gargantext / Viz / Graph / Tools.hs
index a97a9c62d0f7c700286ad4bcebf4b1358c05c863..38fb7177b7cc4503773e02bf4444b624e4cda421 100644 (file)
@@ -15,7 +15,9 @@ Portability : POSIX
 module Gargantext.Viz.Graph.Tools
   where
 
-import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
+import Debug.Trace (trace)
+import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
+-- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 import Data.Map (Map)
 import qualified Data.Set as Set
@@ -24,8 +26,8 @@ import Gargantext.Prelude
 import Gargantext.Core.Statistics
 import Gargantext.Viz.Graph
 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
-import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
-import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
+import Gargantext.Viz.Graph.Distances (Distance(..), measure)
+import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
 import Gargantext.Viz.Graph.IGraph (mkGraphUfromEdges)
 import Gargantext.Viz.Graph.Proxemy (confluence)
 import GHC.Float (sin, cos)
@@ -37,26 +39,67 @@ import qualified Data.List as List
 
 type Threshold = Double
 
+
+cooc2graph' :: Ord t => Double
+                     -> Map (t, t) Int
+                     -> Map (Index, Index) Double
+cooc2graph' threshold myCooc = distanceMap
+  where
+    (ti, _) = createIndices myCooc
+    myCooc' = toIndex ti myCooc
+    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    distanceMat = measure Conditional matCooc
+    distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+
+
 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
+  let
+    (ti, _) = createIndices myCooc
+    myCooc' = toIndex ti myCooc
+    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    distanceMat = measure Conditional matCooc
+    distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+
+    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 <- if (Map.size distanceMap > 0)
+      -- then iLouvainMap 100 10 distanceMap
+      -- then hLouvain distanceMap
+      then cLouvain level distanceMap
+      else panic "Text.Flow: DistanceMap is empty"
 
-  partitions <- case Map.size distanceMap > 0 of
-    True  -> cLouvain distanceMap
-    False -> panic "Text.Flow: DistanceMap is empty"
+  let
+    -- bridgeness' = distanceMap
+    bridgeness' = trace ("Rivers: " <> show rivers) $ bridgeness rivers partitions distanceMap
+    confluence' = confluence (Map.keys bridgeness') 3 True False
 
-  let bridgeness' = bridgeness 300 partitions distanceMap
-  let confluence' = confluence (Map.keys bridgeness') 3 True False
+  pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
 
-  data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
 
 
+data ClustersParams = ClustersParams { bridgness :: Double
+                                     , louvain   :: Text
+                                     } deriving (Show)
+
+clustersParams :: Int -> ClustersParams
+clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
+  {- where
+    y | x < 100  = "0.000001"
+      | x < 350  = "0.000001"
+      | x < 500  = "0.000001"
+      | x < 1000 = "0.000001"
+      | otherwise = "1"
+ -}
+
 ----------------------------------------------------------
 -- | From data to Graph
 data2graph :: [(Text, Int)]
@@ -64,12 +107,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
+
+    community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
 
-    nodes <- mapM (setCoord ForceAtlas labels bridge)
+    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)
@@ -87,7 +131,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
@@ -96,7 +140,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
 
 ------------------------------------------------------------------------
 
@@ -110,22 +153,27 @@ 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
+getCoord :: Ord a
+         => Layout
+         -> [(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