[FEA] Graph options with Links Strength

src/Gargantext/API/Node/Update.hs

@@ -28,6 +28,7 @@ import Gargantext.API.Ngrams.List (reIndexWith)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core.Methods.Distances (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
+import Gargantext.Core.Viz.Graph (Strength)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
 import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
 import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
@@ -61,6 +62,7 @@ data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
 
                       | UpdateNodeParamsGraph { methodGraphMetric        :: !GraphMetric
                                               , methodGraphClustering    :: !PartitionMethod
+                                              , methodGraphEdgesStrength :: !Strength
                                               }
 
                       | UpdateNodeParamsTexts { methodTexts :: !Granularity }
@@ -103,7 +105,7 @@ updateNode :: (HasSettings env, FlowCmdM env err m)
     -> UpdateNodeParams
     -> (JobLog -> m ())
     -> m JobLog
-updateNode uId nId (UpdateNodeParamsGraph metric method) logStatus = do
+updateNode uId nId (UpdateNodeParamsGraph metric method strength) logStatus = do
 
   logStatus JobLog { _scst_succeeded = Just 1
                    , _scst_failed    = Just 0
@@ -111,7 +113,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric method) logStatus = do
                    , _scst_events    = Just []
                    }
   printDebug "Computing graph: " method
-  _ <- recomputeGraph uId nId method (Just metric) True
+  _ <- recomputeGraph uId nId method (Just metric) (Just strength) True
   printDebug "Graph computed: " method
 
   pure  JobLog { _scst_succeeded = Just 2
@@ -272,7 +274,7 @@ instance ToSchema  UpdateNodeParams
 instance Arbitrary UpdateNodeParams where
   arbitrary = do
     l <- UpdateNodeParamsList  <$> arbitrary
-    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary
+    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary
     t <- UpdateNodeParamsTexts <$> arbitrary
     b <- UpdateNodeParamsBoard <$> arbitrary
     elements [l,g,t,b]

src/Gargantext/Core/Viz/Graph.hs

@@ -76,7 +76,8 @@ instance ToSchema Edge where
 data LegendField = LegendField { _lf_id :: Int
                                , _lf_color :: Text
                                , _lf_label :: Text
-   } deriving (Show, Generic)
+                               }
+  deriving (Show, Generic)
 $(deriveJSON (unPrefix "_lf_") ''LegendField)
 
 instance ToSchema LegendField where
@@ -96,10 +97,22 @@ instance ToSchema ListForGraph where
 
 makeLenses ''ListForGraph
 
---
+data Strength = Strong | Weak
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+
+$(deriveJSON (unPrefix "") ''Strength)
+instance ToSchema Strength where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+instance Arbitrary Strength where
+  arbitrary = elements $ [Strong, Weak]
+
+
+
 data GraphMetadata =
   GraphMetadata { _gm_title            :: Text          -- title of the graph
                 , _gm_metric           :: GraphMetric
+                , _gm_edgesStrength    :: Maybe Strength
                 , _gm_corpusId         :: [NodeId]      -- we can map with different corpus
                 , _gm_legend           :: [LegendField] -- legend of the Graph
                 , _gm_list             :: ListForGraph
@@ -113,6 +126,7 @@ instance ToSchema GraphMetadata where
 makeLenses ''GraphMetadata
 
 
+
 data Graph = Graph { _graph_nodes    :: [Node]
                    , _graph_edges    :: [Edge]
                    , _graph_metadata :: Maybe GraphMetadata

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

@@ -104,8 +104,9 @@ getGraph _uId nId = do
     Nothing     -> do
         let defaultMetric          = Order1
         let defaultPartitionMethod = Spinglass
-        graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) NgramsTerms repo
-        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric
+        let defaultEdgesStrength   = Strong
+        graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) defaultEdgesStrength NgramsTerms repo
+        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
         let
           graph'' = set graph_metadata (Just mt) graph'
           hg = HyperdataGraphAPI graph'' camera
@@ -123,9 +124,10 @@ recomputeGraph :: FlowCmdM env err m
                -> NodeId
                -> PartitionMethod
                -> Maybe GraphMetric
+               -> Maybe Strength
                -> Bool
                -> m Graph
-recomputeGraph _uId nId method maybeDistance force = do
+recomputeGraph _uId nId method maybeDistance maybeStrength force = do
   printDebug "recomputeGraph begins" (nId, method)
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
@@ -140,6 +142,12 @@ recomputeGraph _uId nId method maybeDistance force = do
                    Nothing -> withMetric Order1
                    Just m  -> withMetric m
 
+    strength = case maybeStrength of
+                   Nothing -> case graph ^? _Just . graph_metadata . _Just . gm_edgesStrength of
+                        Nothing  -> Strong
+                        Just  mr -> fromMaybe Strong mr
+                   Just r  -> r
+
   mcId <- getClosestParentIdByType nId NodeCorpus
   let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
   printDebug "recomputeGraph corpus" cId
@@ -152,7 +160,7 @@ recomputeGraph _uId nId method maybeDistance force = do
 
   let computeG mt = do
         printDebug "about to run computeGraph" ()
-        g <- computeGraph cId method similarity NgramsTerms repo
+        g <- computeGraph cId method similarity strength NgramsTerms repo
         seq g $ printDebug "graph computed" ()
         let g' = set graph_metadata mt g
         seq g' $ printDebug "computed graph with new metadata" ()
@@ -162,7 +170,7 @@ recomputeGraph _uId nId method maybeDistance force = do
 
   case graph of
     Nothing     -> do
-      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance)
+      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance) strength
       g <- computeG $ Just mt
       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" g
     Just graph' -> if (listVersion == Just v) && (not force)
@@ -176,10 +184,11 @@ computeGraph :: FlowCmdM env err m
              => CorpusId
              -> PartitionMethod
              -> Distance
+             -> Strength
              -> NgramsType
              -> NodeListStory
              -> m Graph
-computeGraph cId method d nt repo = do
+computeGraph cId method d strength nt repo = do
   printDebug "computeGraph" (cId, method, nt)
   lId  <- defaultList cId
   printDebug "computeGraph got list id: " lId
@@ -194,7 +203,7 @@ computeGraph cId method d nt repo = do
          <$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
   printDebug "computeGraph got coocs" (HashMap.size myCooc)
 
-  graph <- liftBase $ cooc2graphWith method d 0 myCooc
+  graph <- liftBase $ cooc2graphWith method d 0 strength myCooc
   printDebug "computeGraph got graph" ()
 
   --listNgrams <- getListNgrams [lId] nt
@@ -209,13 +218,14 @@ defaultGraphMetadata :: HasNodeError err
                      -> Text
                      -> NodeListStory
                      -> GraphMetric
+                     -> Strength
                      -> Cmd err GraphMetadata
-defaultGraphMetadata cId t repo gm = do
+defaultGraphMetadata cId t repo gm str = do
   lId  <- defaultList cId
 
-  pure $ GraphMetadata {
-      _gm_title = t
+  pure $ GraphMetadata { _gm_title         = t
                        , _gm_metric        = gm
+                       , _gm_edgesStrength = Just str
                        , _gm_corpusId      = [cId]
                        , _gm_legend = [
                              LegendField 1 "#FFF" "Cluster1"
@@ -255,7 +265,7 @@ graphRecompute u n logStatus = do
                    , _scst_remaining = Just 1
                    , _scst_events    = Just []
                    }
-  _g <- trace (show u) $ recomputeGraph u n Spinglass Nothing False
+  _g <- trace (show u) $ recomputeGraph u n Spinglass Nothing Nothing False
   pure  JobLog { _scst_succeeded = Just 1
                , _scst_failed    = Just 0
                , _scst_remaining = Just 0
@@ -310,7 +320,7 @@ recomputeVersions :: FlowCmdM env err m
                   => UserId
                   -> NodeId
                   -> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing False
+recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing Nothing False
 
 ------------------------------------------------------------
 graphClone :: UserId

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

@@ -92,6 +92,7 @@ cooc2graph' distance threshold myCooc
 cooc2graphWith :: PartitionMethod
                -> Distance
                -> Threshold
+               -> Strength
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
 cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
@@ -104,10 +105,11 @@ cooc2graphWith' :: ToComId a
                => Partitions a
                -> Distance
                -> Threshold
+               -> Strength
                -> HashMap (NgramsTerm, NgramsTerm) Int
                -> IO Graph
-cooc2graphWith' doPartitions distance threshold myCooc = do
-  let (distanceMap, diag, ti) = doDistanceMap distance threshold myCooc
+cooc2graphWith' doPartitions distance threshold strength myCooc = do
+  let (distanceMap, diag, ti) = doDistanceMap distance threshold strength myCooc
   distanceMap `seq` trace "distanceMap OK" diag `seq` trace "diag OK" ti `seq` printDebug "ti done" ()
 
 --{- -- Debug
@@ -136,17 +138,20 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
   --seq confluence' $ printDebug "confluence OK" ()
   --saveAsFileDebug "/tmp/confluence" confluence'
   let g = data2graph ti diag bridgeness' confluence' partitions
-  saveAsFileDebug "/tmp/graph" g
+  --saveAsFileDebug "/tmp/graph" g
   pure g
 
+type Reverse = Bool
+
 doDistanceMap :: Distance
               -> Threshold
+              -> Strength
               -> HashMap (NgramsTerm, NgramsTerm) Int
               -> ( Map (Int,Int) Double
                  , Map (Index, Index) Int
                  , Map NgramsTerm Index
                  )
-doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, ti)
+doDistanceMap Distributional threshold strength myCooc = (distanceMap, toIndex ti diag, ti)
   where
     -- TODO remove below
     (diag, theMatrix) = Map.partitionWithKey (\(x,y) _ -> x == y)
@@ -165,14 +170,14 @@ doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, t
 
     distanceMap = Map.fromList . trace "fromList" identity
                 $ List.take links
-                $ List.reverse
+                $ (if strength == Weak then List.reverse else identity)
                 $ List.sortOn snd
                 $ Map.toList
                 $ edgesFilter
                 $ (\m -> m `seq` trace "map2map done" (Map.filter (> threshold) m))
                 $ similarities `seq` mat2map (trace "similarities done" similarities)
 
-doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', ti)
+doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti myCooc', ti)
   where
     myCooc' = Map.fromList $ HashMap.toList myCooc
     (ti, _it) = createIndices myCooc'
@@ -182,7 +187,7 @@ doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', t
     distanceMap = toIndex ti
                 $ Map.fromList
                 $ List.take links
-                $ List.reverse
+                $ (if strength == Weak then List.reverse else identity)
                 $ List.sortOn snd
                 $ HashMap.toList
                 $ HashMap.filter (> threshold)
@@ -344,5 +349,3 @@ filterByNeighbours threshold distanceMap = filteredMap
 
 
 
-
-