[nodeStory] draft implementation of NodeStoryEnv
[gargantext.git] / src / Gargantext / Core / Viz / Graph / Tools.hs
index 1507841809db243d0f6ca1e3a1febb00a2b43636..82ad925fed33bd5c63971073b3a98cbea08ab667 100644 (file)
@@ -9,36 +9,60 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Gargantext.Core.Viz.Graph.Tools
   where
 
--- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
-import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
-import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
-import Data.Map (Map)
+import Data.Aeson
 import Data.HashMap.Strict (HashMap)
-import Data.Text (Text)
-import Debug.Trace (trace)
+import Data.Map (Map)
+import Data.Maybe (fromMaybe)
+import Data.Swagger hiding (items)
 import GHC.Float (sin, cos)
+import GHC.Generics (Generic)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Methods.Distances (Distance(..), measure)
+import Gargantext.Core.Methods.Distances.Conditional (conditional)
 import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
 import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
-import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness)
-import Gargantext.Core.Viz.Graph.IGraph (mkGraphUfromEdges)
-import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
+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)
+import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
+import Gargantext.Core.Viz.Graph.Utils (edgesFilter)
 import Gargantext.Prelude
+import Graph.Types (ClusterNode)
 import IGraph.Random -- (Gen(..))
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+import qualified Data.HashMap.Strict      as HashMap
 import qualified Data.List                as List
 import qualified Data.Map                 as Map
 import qualified Data.Set                 as Set
+import qualified Data.Text                as Text
 import qualified Data.Vector.Storable     as Vec
+import qualified Graph.BAC.ProxemyOptim   as BAC
 import qualified IGraph                   as Igraph
 import qualified IGraph.Algorithms.Layout as Layout
-import qualified Data.HashMap.Strict      as HashMap
 
+
+data PartitionMethod = Spinglass | Confluence | Infomap
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+instance FromJSON  PartitionMethod
+instance ToJSON    PartitionMethod
+instance ToSchema  PartitionMethod
+instance Arbitrary PartitionMethod where
+  arbitrary = elements [ minBound .. maxBound ]
+
+
+-------------------------------------------------------------
+defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
+-- defaultClustering x = pure $ BAC.defaultClustering x
+defaultClustering x = spinglass 1 x
+
+-------------------------------------------------------------
 type Threshold = Double
 
 
@@ -46,109 +70,171 @@ cooc2graph' :: Ord t => Distance
                      -> Double
                      -> Map (t, t) Int
                      -> Map (Index, Index) Double
-cooc2graph' distance threshold myCooc = distanceMap
-  where
-    (ti, _) = createIndices myCooc
-    myCooc' = toIndex ti myCooc
-    matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
-    distanceMat = measure distance matCooc
-    distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+cooc2graph' distance threshold myCooc
+    = Map.filter (> threshold)
+    $ mat2map
+    $ measure distance
+    $ case distance of
+        Conditional    -> map2mat Triangle 0 tiSize
+        Distributional -> map2mat Square   0 tiSize
+    $ Map.filter (> 1) myCooc'
+
+     where
+        (ti, _) = createIndices myCooc
+        tiSize  = Map.size ti
+        myCooc' = toIndex ti myCooc
+
+
+
+-- coocurrences graph computation
+cooc2graphWith :: PartitionMethod
+               -> Distance
+               -> Threshold
+               -> HashMap (NgramsTerm, NgramsTerm) Int
+               -> IO Graph
+cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
+cooc2graphWith Confluence= cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
+cooc2graphWith Infomap   = cooc2graphWith' (infomap "--silent --two-level -N2")
+                        -- TODO: change these options, or make them configurable in UI?
+
+
+cooc2graphWith' :: ToComId a
+               => Partitions a
+               -> Distance
+               -> Threshold
+               -> HashMap (NgramsTerm, NgramsTerm) Int
+               -> IO Graph
+cooc2graphWith' doPartitions distance threshold myCooc = do
+  let
+    (distanceMap, diag, ti) = doDistanceMap distance threshold myCooc
 
+--{- -- Debug
+  -- saveAsFileDebug "/tmp/distanceMap" distanceMap
+  -- saveAsFileDebug "/tmp/distanceMap.keys" (List.length $ Map.keys distanceMap)
+  -- printDebug "similarities" similarities
+--}
 
-cooc2graph :: Distance
-           -> Threshold
-           -> HashMap (NgramsTerm, NgramsTerm) Int
-           -> IO Graph
-cooc2graph distance threshold myCooc = do
-  printDebug "cooc2graph" distance
-  let
-    -- TODO remove below
-    theMatrix = Map.fromList $ HashMap.toList myCooc
-    (ti, _) = createIndices theMatrix
-    myCooc' = toIndex ti theMatrix
-    matCooc = map2mat 0 (Map.size ti)
-            $ Map.filterWithKey (\(a,b) _ -> a /= b) 
-            $ Map.filter (> 1) myCooc'
-    distanceMat = measure distance matCooc
-    distanceMap = Map.filter (> threshold) $ mat2map distanceMat
+  partitions <- if (Map.size distanceMap > 0)
+      then doPartitions distanceMap
+      else panic $ Text.unlines [ "[Gargantext.C.V.Graph.Tools] Similarity Matrix is empty"
+                                , "Maybe you should add more Map Terms in your list"
+                                , "Tutorial: link todo"
+                                ]
 
+  let
     nodesApprox :: Int
     nodesApprox = n'
       where
         (as, bs) = List.unzip $ Map.keys distanceMap
         n' = Set.size $ Set.fromList $ as <> bs
-    ClustersParams rivers level = clustersParams nodesApprox
+    bridgeness' = bridgeness (fromIntegral nodesApprox) partitions distanceMap
+    confluence' = confluence (Map.keys bridgeness') 3 True False
 
+  pure $ data2graph ti diag bridgeness' confluence' partitions
 
-  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"
 
-  let
-    -- bridgeness' = distanceMap
-    bridgeness' = trace ("Rivers: " <> show rivers)
-                $ bridgeness rivers partitions distanceMap
-    confluence' = confluence (Map.keys bridgeness') 3 True False
+doDistanceMap :: Distance
+              -> Threshold
+              -> HashMap (NgramsTerm, NgramsTerm) Int
+              -> ( Map (Int,Int) Double
+                 , Map (Index, Index) Int
+                 , Map NgramsTerm Index
+                 )
+doDistanceMap Distributional 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
 
-  pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti) myCooc' bridgeness' confluence' partitions
+    similarities = measure Distributional
+                 $ map2mat Square 0 tiSize
+                 $ toIndex ti theMatrix
 
+    links = round (let n :: Double = fromIntegral tiSize in n * (log n)^(2::Int))
 
+    distanceMap = Map.fromList
+                $ List.take links
+                $ List.reverse
+                $ List.sortOn snd
+                $ Map.toList
+                $ edgesFilter
+                $ Map.filter (> threshold)
+                $ mat2map similarities
+
+doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', ti)
+  where
+    myCooc' = Map.fromList $ HashMap.toList myCooc
+    (ti, _it) = createIndices myCooc'
 
-data ClustersParams = ClustersParams { bridgness :: Double
-                                     , louvain   :: Text
-                                     } deriving (Show)
+    links = round (let n :: Double = fromIntegral (Map.size ti) in n * log n)
 
-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"
- -}
+    distanceMap = toIndex ti
+                $ Map.fromList
+                $ List.take links
+                $ List.sortOn snd
+                $ HashMap.toList
+                $ HashMap.filter (> threshold)
+                $ conditional myCooc
 
 ----------------------------------------------------------
 -- | From data to Graph
-data2graph :: [(Text, Int)]
-           -> Map (Int, Int) Int
+
+type Occurrences      = Int
+
+data2graph :: ToComId a 
+           => Map NgramsTerm Int
+           -> Map (Int, Int) Occurrences
            -> Map (Int, Int) Double
            -> Map (Int, Int) Double
-           -> [LouvainNode]
+           -> [a]
            -> Graph
-data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
+data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = nodes
+                                                             , _graph_edges = edges
+                                                             , _graph_metadata = Nothing
+                                                             }
   where
 
-    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)
-                   , node_label = l
-                   , node_x_coord = 0
-                   , node_y_coord = 0
-                   , node_attributes =
-                     Attributes { clust_default = maybe 0 identity
-                                (Map.lookup n community_id_by_node_id) } }
+          [ (n, Node { node_size    = maybe 0 identity (Map.lookup (n,n) occurences)
+                     , node_type    = Terms -- or Unknown
+                     , node_id      = cs (show n)
+                     , node_label   = unNgramsTerm l
+                     , node_x_coord = 0
+                     , node_y_coord = 0
+                     , node_attributes = Attributes { clust_default = fromMaybe 0
+                                                       (Map.lookup n community_id_by_node_id)
+                                                    }
+                     , node_children = []
+                     }
                )
             | (l, n) <- labels
-            , Set.member n $ Set.fromList
-                           $ List.concat
-                           $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
-                           $ Map.toList bridge
+            , Set.member n nodesWithScores
             ]
 
     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
-                   -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
-                   , edge_id     = cs (show i) }
-                   | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
-                   ]
+                   , edge_target = cs (show t)
+                   , edge_weight = weight
+                   , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
+                   , edge_id     = cs (show i)
+                   }
+            | (i, ((s,t), weight)) <- zip ([0..]::[Integer] ) $ Map.toList bridge
+            , s /= t
+            , weight > 0
+            ]
+
+    community_id_by_node_id = Map.fromList
+                            $ map nodeId2comId partitions
+
+    labels = Map.toList labels'
+
+    nodesWithScores = Set.fromList
+                     $ List.concat
+                     $ map (\((s,t),d) -> if d > 0 && s/=t then [s,t] else [])
+                     $ Map.toList bridge
 
 
 ------------------------------------------------------------------------
@@ -201,7 +287,7 @@ getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") ident
         ns = map snd items
 
     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
-    toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
+    toVec n' ns' m'' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m'') ns')
 ------------------------------------------------------------------------
 
 -- | KamadaKawai Layout
@@ -215,3 +301,40 @@ layout m n gen = maybe (panic "") identity $ Map.lookup n $ coord
     p = Layout.kamadaKawai
     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 
+-----------------------------------------------------------------------------
+-- 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
+
+
+
+
+