[graphql] remove ethercalc endpoint
[gargantext.git] / src / Gargantext / Core / Viz / Graph / Tools.hs
index 2869e92c98ff89d5520755885e3f08fc3ebf5b99..d5fe02dc827512abfaa2dc3febac8c365df3bdbe 100644 (file)
@@ -27,8 +27,10 @@ import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
-import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass, ClusterNode)
+import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
+import Gargantext.Core.Viz.Graph.Types (ClusterNode)
 import Gargantext.Prelude
+-- import qualified Graph.BAC.ProxemyOptim as BAC
 import IGraph.Random -- (Gen(..))
 import qualified Data.HashMap.Strict      as HashMap
 import qualified Data.List                as List
@@ -40,12 +42,11 @@ import qualified IGraph.Algorithms.Layout as Layout
 
 
 -------------------------------------------------------------
-
 defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
-defaultClustering = spinglass 1
+-- defaultClustering x = pure $ BAC.defaultClustering x
+defaultClustering x = spinglass 1 x
 
 -------------------------------------------------------------
-
 type Threshold = Double
 
 cooc2graph' :: Ord t => Distance
@@ -67,7 +68,7 @@ cooc2graph' distance threshold myCooc
         myCooc' = toIndex ti myCooc
 
 
-data PartitionMethod = Louvain | Spinglass | Bac
+data PartitionMethod = Louvain | Spinglass -- | Bac
 
 -- | coocurrences graph computation
 cooc2graphWith :: PartitionMethod
@@ -75,74 +76,10 @@ cooc2graphWith :: PartitionMethod
                -> Threshold
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graphWith Louvain   = undefined -- TODO use IGraph bindings
+cooc2graphWith Louvain   = undefined
 cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
-cooc2graphWith Bac       = undefined -- cooc2graphWith' BAC.defaultClustering
-
-cooc2graph'' :: Ord t => Distance
-                      -> Double
-                      -> Map (t, t) Int
-                      -> Map (Index, Index) Double
-cooc2graph'' distance threshold myCooc = neighbourMap
-  where
-    (ti, _) = createIndices myCooc
-    myCooc' = toIndex ti myCooc
-    matCooc = map2mat Triangle 0 (Map.size ti) $ Map.filter (> 1) myCooc'
-    distanceMat = measure distance matCooc
-    neighbourMap = filterByNeighbours threshold
-                 $ mat2map distanceMat
-
-
--- Quentin
-filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
-filterByNeighbours threshold distanceMap = filteredMap
-  where 
-    indexes :: [Index]
-    indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
-    filteredMap :: Map (Index, Index) Double
-    filteredMap = Map.fromList
-                $ List.concat 
-                $ map (\idx -> 
-                          let selected = List.reverse
-                                       $ List.sortOn snd
-                                       $ Map.toList 
-                                       $ Map.filter (> 0)
-                                       $ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
-                           in List.take (round threshold) selected
-                      ) indexes                 
-
-
-doDistanceMap :: Distance
-               -> Threshold
-               -> HashMap (NgramsTerm, NgramsTerm) Int
-               -> (Map (Int,Int) Double, Map (Index, Index) Int, Map NgramsTerm Index)
-doDistanceMap distance threshold myCooc = (distanceMap, myCooc', ti)
-  where
-    -- TODO remove below
-    theMatrix = Map.fromList
-              $ HashMap.toList myCooc
-
-    (ti, _) = createIndices theMatrix
-    tiSize  = Map.size ti
-    myCooc' = toIndex ti theMatrix
-    matCooc = case distance of  -- Shape of the Matrix
-                Conditional    -> map2mat Triangle 0 tiSize
-                Distributional -> map2mat Square     0 tiSize
-            $ case distance of   -- Removing the Diagonal ?
-                Conditional     -> Map.filterWithKey (\(a,b) _ -> a /= b)
-                Distributional  -> identity
-            $ Map.filter (>1) myCooc'
+-- cooc2graphWith Bac       = cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
 
-    similarities = measure distance matCooc
-    links = round (let n :: Double = fromIntegral tiSize in n * log n)
-
-    distanceMap = Map.fromList  $ List.take links
-                $ List.sortOn snd
-                $ Map.toList
-                $ case distance of
-                    Conditional    -> Map.filter (> threshold)
-                    Distributional -> Map.filter (> 0)
-                $ mat2map similarities
 
 cooc2graphWith' :: ToComId a
                => Partitions a
@@ -152,7 +89,7 @@ cooc2graphWith' :: ToComId a
                -> IO Graph
 cooc2graphWith' doPartitions distance threshold myCooc = do
   let
-    (distanceMap, myCooc', ti) = doDistanceMap distance threshold myCooc
+    (distanceMap, diag, ti) = doDistanceMap distance threshold myCooc
 
     nodesApprox :: Int
     nodesApprox = n'
@@ -178,7 +115,48 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
     confluence' = confluence (Map.keys bridgeness') 3 True False
 
   pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti)
-                    myCooc' bridgeness' confluence' partitions
+                    diag bridgeness' confluence' partitions
+
+
+
+doDistanceMap :: Distance
+              -> Threshold
+              -> HashMap (NgramsTerm, NgramsTerm) Int
+              -> ( Map (Int,Int) Double
+                 , Map (Index, Index) Int
+                 , Map NgramsTerm Index
+                 )
+doDistanceMap distance threshold myCooc = (distanceMap, toIndex ti diag, ti)
+  where
+    -- TODO remove below
+    (diag, theMatrix) = Map.partitionWithKey (\(x,y) _ -> x == y)
+                      $ Map.fromList
+                      $ HashMap.toList myCooc
+
+    (ti, _it) = createIndices theMatrix
+    tiSize  = Map.size ti
+
+    matCooc = case distance of  -- Shape of the Matrix
+                Conditional    -> map2mat Triangle 0 tiSize
+                Distributional -> map2mat Square   0 tiSize
+            {-$ case distance of   -- Removing the Diagonal ?
+                Conditional     -> Map.filterWithKey (\(a,b) _ -> a /= b)
+                Distributional  -> Map.filterWithKey (\(a,b) _ -> a /= b)
+                -}
+            $ toIndex ti theMatrix
+
+    similarities = measure distance matCooc
+    links = round (let n :: Double = fromIntegral tiSize in n * log n)
+
+    distanceMap = Map.fromList
+                $ List.take links
+                $ List.sortOn snd
+                $ Map.toList
+                $ Map.filter (> threshold)
+                $ mat2map similarities
+
+
+
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -198,22 +176,26 @@ clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
 
 ----------------------------------------------------------
 -- | From data to Graph
+
+type Occurrences  = Map (Int,  Int) Int
+
 data2graph :: ToComId a 
            => [(Text, Int)]
-           -> Map (Int, Int) Int
+           -> Occurrences
            -> Map (Int, Int) Double
            -> Map (Int, Int) Double
            -> [a]
            -> Graph
-data2graph labels coocs bridge conf partitions = Graph { _graph_nodes = nodes
+data2graph labels occurences bridge conf partitions = Graph { _graph_nodes = nodes
                                                        , _graph_edges = edges
                                                        , _graph_metadata = Nothing }
   where
 
-    community_id_by_node_id = Map.fromList $ map nodeId2comId partitions
+    community_id_by_node_id = Map.fromList
+                            $ map nodeId2comId partitions
 
     nodes = map (setCoord ForceAtlas labels bridge)
-          [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
+          [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) occurences)
                      , node_type = Terms -- or Unknown
                      , node_id    = cs (show n)
                      , node_label = l
@@ -222,7 +204,7 @@ data2graph labels coocs bridge conf partitions = Graph { _graph_nodes = nodes
                      , node_attributes =
                        Attributes { clust_default = maybe 0 identity
                                     (Map.lookup n community_id_by_node_id) }
-                     , node_children = Nothing }
+                     , node_children = [] }
                )
             | (l, n) <- labels
             , Set.member n $ Set.fromList
@@ -307,14 +289,41 @@ layout m n gen = maybe (panic "") identity $ Map.lookup n $ coord
     --p = Layout.defaultLGL
     p = Layout.kamadaKawai
     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
+
 -----------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--- Debug
-{-
--- measure logDistributional
-dataDebug = map2mat Square (0::Int) 19 dataBug'
+-- MISC Tools
+cooc2graph'' :: Ord t => Distance
+                      -> Double
+                      -> Map (t, t) Int
+                      -> Map (Index, Index) Double
+cooc2graph'' distance threshold myCooc = neighbourMap
+  where
+    (ti, _) = createIndices myCooc
+    myCooc' = toIndex ti myCooc
+    matCooc = map2mat Triangle 0 (Map.size ti) $ Map.filter (> 1) myCooc'
+    distanceMat = measure distance matCooc
+    neighbourMap = filterByNeighbours threshold
+                 $ mat2map distanceMat
+
+-- Quentin
+filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
+filterByNeighbours threshold distanceMap = filteredMap
+  where 
+    indexes :: [Index]
+    indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
+    filteredMap :: Map (Index, Index) Double
+    filteredMap = Map.fromList
+                $ List.concat 
+                $ map (\idx -> 
+                          let selected = List.reverse
+                                       $ List.sortOn snd
+                                       $ Map.toList 
+                                       $ Map.filter (> 0)
+                                       $ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
+                           in List.take (round threshold) selected
+                      ) indexes
+
+
+
+
 
-dataBug' :: Map (Int, Int) Int
-dataBug' = Map.fromList [((0,0),28),((0,1),8),((0,2),6),((0,3),2),((0,5),4),((0,6),4),((0,7),2),((0,9),7),((0,10),4),((0,13),4),((0,14),2),((0,15),5),((0,16),8),((0,17),3),((1,1),28),((1,2),6),((1,3),7),((1,4),5),((1,5),7),((1,6),5),((1,7),2),((1,9),6),((1,10),7),((1,11),5),((1,13),6),((1,15),6),((1,16),14),((1,18),4),((2,2),39),((2,3),5),((2,4),4),((2,5),3),((2,6),4),((2,7),4),((2,8),3),((2,9),17),((2,10),4),((2,11),8),((2,12),2),((2,13),15),((2,14),4),((2,15),5),((2,16),21),((2,18),4),((3,3),48),((3,4),10),((3,5),7),((3,6),3),((3,7),7),((3,8),6),((3,9),12),((3,10),9),((3,11),8),((3,12),5),((3,13),15),((3,14),5),((3,15),9),((3,16),17),((3,18),4),((4,4),33),((4,5),2),((4,6),5),((4,7),7),((4,8),4),((4,9),6),((4,10),12),((4,11),8),((4,12),3),((4,13),16),((4,14),4),((4,15),4),((4,16),5),((4,17),2),((4,18),12),((5,5),27),((5,6),2),((5,8),3),((5,9),12),((5,10),6),((5,11),9),((5,13),4),((5,14),2),((5,15),7),((5,16),11),((5,18),4),((6,6),34),((6,7),4),((6,8),3),((6,9),12),((6,10),8),((6,11),2),((6,12),5),((6,13),6),((6,14),6),((6,15),5),((6,16),22),((6,17),8),((6,18),4),((7,7),27),((7,8),2),((7,9),6),((7,10),2),((7,11),4),((7,13),13),((7,15),2),((7,16),8),((7,17),6),((7,18),4),((8,8),30),((8,9),9),((8,10),6),((8,11),9),((8,12),6),((8,13),3),((8,14),3),((8,15),4),((8,16),15),((8,17),3),((8,18),5),((9,9),69),((9,10),9),((9,11),22),((9,12),15),((9,13),18),((9,14),10),((9,15),14),((9,16),48),((9,17),6),((9,18),9),((10,10),39),((10,11),15),((10,12),5),((10,13),11),((10,14),2),((10,15),4),((10,16),19),((10,17),3),((10,18),11),((11,11),48),((11,12),9),((11,13),20),((11,14),2),((11,15),13),((11,16),29),((11,18),13),((12,12),30),((12,13),4),((12,15),5),((12,16),16),((12,17),6),((12,18),2),((13,13),65),((13,14),10),((13,15),14),((13,16),23),((13,17),6),((13,18),10),((14,14),25),((14,16),9),((14,17),3),((14,18),3),((15,15),38),((15,16),17),((15,18),4),((16,16),99),((16,17),11),((16,18),14),((17,17),29),((18,18),23)]
--}