[WIP] bridgeness2 needs optim

src/Gargantext/Core/Viz/Graph/Bridgeness.hs

@@ -14,17 +14,21 @@ TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
 TODO use Map LouvainNodeId (Map LouvainNodeId)
 -}
 
+{-# LANGUAGE BangPatterns #-}
 
 module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
   where
 
 import Data.List (concat, sortOn)
 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
-import Data.Maybe (catMaybes)
-import Data.Ord (Down(..))
+import Data.Maybe (catMaybes, fromMaybe)
+import Data.Set (Set)
 import Gargantext.Prelude
 import Graph.Types (ClusterNode(..))
-import qualified Data.Map as DM
+import Data.Ord (Down(..))
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Set  as Set
 
 ----------------------------------------------------------------------
 type Partitions a = Map (Int, Int) Double -> IO [a]
@@ -42,24 +46,62 @@ instance ToComId ClusterNode where
 ----------------------------------------------------------------------
 ----------------------------------------------------------------------
 type Bridgeness = Double
+type Confluence = Map (NodeId, NodeId) Double
+
+bridgeness3 :: Confluence
+           -> Map (NodeId, NodeId) Double
+           -> Map (NodeId, NodeId) Double
+bridgeness3 _ m = m
+
+
+bridgeness2 :: Confluence
+           -> Map (NodeId, NodeId) Double
+           -> Map (NodeId, NodeId) Double
+bridgeness2 c m = Map.fromList
+                $ List.filter (\((k1,k2),_v) -> if k1 > k2
+                                                   then fromMaybe False (Set.member k2 <$> Map.lookup k1 toKeep)
+                                                   else fromMaybe False (Set.member k1 <$> Map.lookup k2 toKeep)
+                               )
+                $ m'
+  where
+    toKeep :: Map NodeId (Set NodeId)
+    !toKeep = Map.fromListWith (<>)
+            $ map (\((k1,k2), _v) -> if k1 > k2 
+                                        then (k1, Set.singleton k2)
+                                        else (k2, Set.singleton k1)
+                  )
+            $ List.take n
+            $ List.sortOn (Down . snd)
+            $ Map.toList c
+
+    !m' = Map.toList m
+    n :: Int
+    !n = round $ (fromIntegral $ List.length m') / (2 :: Double)
+    
+{-
+    n :: Int
+    n = Set.size $ Set.fromList $ as <> bs
+      where
+        (as, bs) = List.unzip $ Map.keys m
+-}
 
 bridgeness :: ToComId a
-           => Bridgeness
+           => Confluence
            -> [a]
            -> Map (NodeId, NodeId) Double
            -> Map (NodeId, NodeId) Double
 bridgeness = bridgenessWith nodeId2comId
   where
     bridgenessWith :: (a -> (Int, Int))
-               -> Bridgeness
+               -> Confluence
                -> [a]
                -> Map (Int, Int) Double
                -> Map (Int, Int) Double
-    bridgenessWith f b ns = DM.fromList
+    bridgenessWith f b ns = Map.fromList
                            . concat
-                       . DM.elems
+                           . Map.elems
                            . filterComs b
-                       . groupEdges (DM.fromList $ map f ns)
+                           . groupEdges (Map.fromList $ map f ns)
 
 
 groupEdges :: (Ord a, Ord b1)
@@ -81,7 +123,7 @@ filterComs :: (Ord n1, Eq n2)
            => p
            -> Map (n2, n2) [(a3, n1)]
            -> Map (n2, n2) [(a3, n1)]
-filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
+filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
   where
     filter' (c1,c2) a
       | c1 == c2  = a

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
 import Gargantext.Core.Methods.Similarities.Conditional (conditional)
 import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
-import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
+import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness2, 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)
@@ -127,14 +127,10 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
                                 , "Tutorial: link todo"
                                 ]
   length partitions `seq` return ()
+
   let
-    nodesApprox :: Int
-    nodesApprox = n'
-      where
-        (as, bs) = List.unzip $ Map.keys distanceMap
-        n' = Set.size $ Set.fromList $ as <> bs
     !confluence' = BAC.computeConfluences 3 (Map.keys bridgeness') True
-    !bridgeness' = bridgeness (fromIntegral nodesApprox) partitions distanceMap
+    !bridgeness' = bridgeness2 confluence' distanceMap
   pure $ data2graph multi ti diag bridgeness' confluence' partitions
 
 type Reverse = Bool
@@ -177,7 +173,7 @@ doSimilarityMap Conditional threshold strength myCooc = (distanceMap, toIndex ti
   where
     myCooc' = Map.fromList $ HashMap.toList myCooc
     (ti, _it) = createIndices myCooc'
-    links = round (let n :: Double = fromIntegral (Map.size ti) in n * log n)
+    links = round (let n :: Double = fromIntegral (Map.size ti) in n * (log n)^(2::Int))
     distanceMap = toIndex ti
                 $ Map.fromList
                 $ List.take links

src/Gargantext/Database/Schema/Ngrams.hs

@@ -99,6 +99,12 @@ instance FromJSONKey NgramsType where
    fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
 
 instance ToJSON NgramsType
+  where
+    toJSON Authors     = String "Authors"
+    toJSON Institutes  = String "Institutes"
+    toJSON Sources     = String "Sources"
+    toJSON NgramsTerms = String "Terms"
+
 instance ToJSONKey NgramsType where
    toJSONKey = toJSONKeyText (pack . show)
 instance FromHttpApiData NgramsType where