[REFACT] preparing metrics update

src/Gargantext/API/Node/Update.hs

@@ -22,6 +22,7 @@ import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import Gargantext.API.Node.Corpus.New (AsyncJobs)
 import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.Viz.Graph.Distances (GraphMetric)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), {-Int, pure, (*),-} printDebug, {-(^)-}) -- (-), (^))
@@ -47,10 +48,6 @@ data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: Method      }
 data Method = Basic | Advanced | WithModel
     deriving (Generic, Eq, Ord, Enum, Bounded)
 
-----------------------------------------------------------------------
-data GraphMetric = Order1 | Order2
-    deriving (Generic, Eq, Ord, Enum, Bounded)
-
 ----------------------------------------------------------------------
 data Granularity = NewNgrams | NewTexts | Both
     deriving (Generic, Eq, Ord, Enum, Bounded)
@@ -82,12 +79,6 @@ instance ToSchema  Method
 instance Arbitrary Method where
   arbitrary = elements [ minBound .. maxBound ]
 
-instance FromJSON  GraphMetric
-instance ToJSON    GraphMetric
-instance ToSchema  GraphMetric
-instance Arbitrary GraphMetric where
-  arbitrary = elements [ minBound .. maxBound ]
-
 instance FromJSON  Granularity
 instance ToJSON    Granularity
 instance ToSchema  Granularity

src/Gargantext/API/Routes.hs

@@ -77,7 +77,8 @@ type GargAPI' =
           :<|> GargPrivateAPI
 
 
-type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> GargPrivateAPI'
+type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
+                    :> GargPrivateAPI'
 
 type GargAdminAPI
               -- Roots endpoint

src/Gargantext/Viz/Graph.hs

@@ -16,27 +16,28 @@ Portability : POSIX
 module Gargantext.Viz.Graph
   where
 
+
 import Control.Lens (makeLenses)
 import Data.Aeson.TH (deriveJSON)
-import qualified Data.Aeson as DA
 import Data.ByteString.Lazy as DBL (readFile, writeFile)
 import Data.Swagger
 import Data.Text (Text, pack)
-import qualified Data.Text as T
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Generics (Generic)
 import GHC.IO (FilePath)
-import Database.PostgreSQL.Simple.FromField (FromField, fromField)
-import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-import Test.QuickCheck (elements)
-import qualified Text.Read as T
-
 import Gargantext.Core.Types (ListId)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
+import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Viz.Graph.Distances (GraphMetric)
 import Gargantext.Database.Prelude (fromField')
 import Gargantext.Prelude
+import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Data.Aeson as DA
+import qualified Data.Text as T
+import qualified Text.Read as T
 
 
 data TypeNode = Terms | Unknown
@@ -88,7 +89,8 @@ instance ToSchema LegendField where
 makeLenses ''LegendField
 ---------------------------------------------------------------
 type Version = Int
-data ListForGraph = ListForGraph { _lfg_listId  :: ListId
+data ListForGraph =
+  ListForGraph { _lfg_listId  :: ListId
                , _lfg_version :: Version
                } deriving (Show, Generic)
 $(deriveJSON (unPrefix "_lfg_") ''ListForGraph)
@@ -99,7 +101,9 @@ instance ToSchema ListForGraph where
 makeLenses ''ListForGraph
 
 --
-data GraphMetadata = GraphMetadata { _gm_title    :: Text   -- title of the graph
+data GraphMetadata =
+  GraphMetadata { _gm_title    :: Text          -- title of the graph
+                , _gm_metric   :: GraphMetric
                 , _gm_corpusId :: [NodeId]      -- we can map with different corpus
                 , _gm_legend   :: [LegendField] -- legend of the Graph
                 , _gm_list     :: ListForGraph
@@ -161,7 +165,8 @@ $(deriveJSON (unPrefix "go_") ''GraphV3)
 
 -----------------------------------------------------------
 
-data HyperdataGraph = HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
+data HyperdataGraph =
+  HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
                  } deriving (Show, Generic)
 $(deriveJSON (unPrefix "") ''HyperdataGraph)
 
@@ -176,7 +181,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-
 -----------------------------------------------------------
 
 graphV3ToGraph :: GraphV3 -> Graph

src/Gargantext/Viz/Graph/API.hs

@@ -44,6 +44,7 @@ import Gargantext.Prelude
 import Gargantext.Viz.Graph
 import Gargantext.Viz.Graph.GEXF ()
 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
+import Gargantext.Viz.Graph.Distances (Distance(..), GraphMetric(..))
 import Servant
 import Servant.Job.Async
 import Servant.XML
@@ -59,7 +60,8 @@ type GraphAPI   =  Get  '[JSON] Graph
 
 data GraphVersions =
   GraphVersions { gv_graph :: Maybe Int
-                , gv_repo :: Int }
+                , gv_repo :: Int
+                }
    deriving (Show, Generic)
 
 instance ToJSON GraphVersions
@@ -76,15 +78,17 @@ getGraph :: UserId -> NodeId -> GargNoServer Graph
 getGraph _uId nId = do
   nodeGraph <- getNodeWith nId HyperdataGraph
   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
+
   repo <- getRepo
 
   let cId = maybe (panic "[G.V.G.API] Node has no parent")
                   identity
                   $ nodeGraph ^. node_parentId
 
+  -- TODO Distance in Graph params
   g <- case graph of
     Nothing     -> do
-        graph' <- computeGraph cId NgramsTerms repo
+        graph' <- computeGraph cId Conditional NgramsTerms repo
         _      <- updateHyperdata nId (HyperdataGraph $ Just graph')
         pure $ trace "[G.V.G.API] Graph empty, computing" $ graph'
 
@@ -93,8 +97,8 @@ getGraph _uId nId = do
   pure g
 
 
-recomputeGraph :: UserId -> NodeId -> GargNoServer Graph
-recomputeGraph _uId nId = do
+recomputeGraph :: UserId -> NodeId -> Distance -> GargNoServer Graph
+recomputeGraph _uId nId d = do
   nodeGraph <- getNodeWith nId HyperdataGraph
   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
   let listVersion = graph ^? _Just
@@ -111,14 +115,14 @@ recomputeGraph _uId nId = do
 
   g <- case graph of
     Nothing     -> do
-      graph' <- computeGraph cId NgramsTerms repo
+      graph' <- computeGraph cId d NgramsTerms repo
       _ <- updateHyperdata nId (HyperdataGraph $ Just graph')
       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" $ graph'
 
     Just graph' -> if listVersion == Just v
                      then pure graph'
                      else do
-                       graph'' <- computeGraph cId NgramsTerms repo
+                       graph'' <- computeGraph cId d NgramsTerms repo
                        _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
                        pure $ trace "[G.V.G.API] Graph exists, recomputing" $ graph''
   pure g
@@ -127,13 +131,16 @@ recomputeGraph _uId nId = do
 -- TODO use Database Monad only here ?
 computeGraph :: HasNodeError err
              => CorpusId
+             -> Distance
              -> NgramsType
              -> NgramsRepo
              -> Cmd err Graph
-computeGraph cId nt repo = do
+computeGraph cId d nt repo = do
   lId  <- defaultList cId
 
-  let metadata = GraphMetadata "Title" [cId]
+  let metadata = GraphMetadata "Title"
+                               Order1
+                               [cId]
                                [ LegendField 1 "#FFF" "Cluster"
                                , LegendField 2 "#FFF" "Cluster"
                                ]
@@ -148,7 +155,7 @@ computeGraph cId nt repo = do
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 
-  graph <- liftBase $ cooc2graph 0 myCooc
+  graph <- liftBase $ cooc2graph d 0 myCooc
   let graph' = set graph_metadata (Just metadata) graph
   pure graph'
 
@@ -174,7 +181,7 @@ graphAsync' u n logStatus = do
                           , _scst_remaining = Just 1
                           , _scst_events    = Just []
                           }
-  _g <- trace (show u) $ recomputeGraph u n
+  _g <- trace (show u) $ recomputeGraph u n Conditional
   pure  JobLog { _scst_succeeded = Just 1
                       , _scst_failed    = Just 0
                       , _scst_remaining = Just 0
@@ -209,7 +216,7 @@ graphVersions _uId nId = do
                        , gv_repo = v }
 
 recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
-recomputeVersions uId nId = recomputeGraph uId nId
+recomputeVersions uId nId = recomputeGraph uId nId Conditional
 
 ------------------------------------------------------------
 getGraphGexf :: UserId

src/Gargantext/Viz/Graph/Distances.hs

@@ -14,17 +14,37 @@ Portability : POSIX
 module Gargantext.Viz.Graph.Distances
   where
 
-
-import Data.Array.Accelerate
+import Data.Aeson
+import Data.Array.Accelerate (Matrix)
+import Data.Swagger
+import GHC.Generics (Generic)
+import Gargantext.Prelude (Ord, Eq, Int, Double)
+import Gargantext.Prelude (Show)
 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional, distributional)
+import Prelude (Enum, Bounded, minBound, maxBound)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
 
+------------------------------------------------------------------------
 data Distance = Conditional | Distributional
 
-
 measure :: Distance -> Matrix Int -> Matrix Double
 measure Conditional    = measureConditional
 measure Distributional = distributional
+------------------------------------------------------------------------
 
+withMetric :: GraphMetric -> Matrix Int -> Matrix Double
+withMetric Order1 = measureConditional
+withMetric Order2 = distributional
 
+------------------------------------------------------------------------
+data GraphMetric = Order1 | Order2
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
 
+instance FromJSON  GraphMetric
+instance ToJSON    GraphMetric
+instance ToSchema  GraphMetric
+instance Arbitrary GraphMetric where
+  arbitrary = elements [ minBound .. maxBound ]
 
+------------------------------------------------------------------------

src/Gargantext/Viz/Graph/Distances/Matrice.hs

@@ -180,7 +180,9 @@ measureConditional m = run (matProba (dim m) $ map fromIntegral $ use m)
 --
 -- \[P_c=max(\frac{n_i}{n_{ij}},\frac{n_j}{n_{ij}} )\]
 conditional' :: Matrix Int -> (Matrix InclusionExclusion, Matrix SpecificityGenericity)
-conditional' m = (run $ ie $ map fromIntegral $ use m, run $ sg $ map fromIntegral $ use m)
+conditional' m = ( run $ ie $ map fromIntegral $ use m
+                 , run $ sg $ map fromIntegral $ use m
+                 )
   where
     ie :: Acc (Matrix Double) -> Acc (Matrix Double)
     ie mat = map (\x -> x / (2*n-1)) $ zipWith (+) (xs mat) (ys mat)
@@ -240,6 +242,8 @@ distributional m = run $ matMiniMax $ ri (map fromIntegral $ use m)
               $ zipWith (/) (crossProduct m') (total m')
 
     total m'' = replicate (constant (Z :. n :. n)) $ fold (+) 0 $ fold (+) 0 m''
+
+    n :: Dim
     n = dim m
     
     crossProduct m''' = zipWith (*) (cross m'''  ) (cross (transpose m'''))

src/Gargantext/Viz/Graph/MaxClique.hs

@@ -61,6 +61,7 @@ import Data.Set (fromList, toList, isSubsetOf)
 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
 import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
 import Gargantext.Viz.Graph.Tools (cooc2graph', Threshold)
+import Gargantext.Viz.Graph.Distances (Distance)
 import Gargantext.Viz.Graph.Index (createIndices, toIndex)
 type Graph = Graph_Undirected
 type Neighbor = Node
@@ -68,8 +69,8 @@ type Neighbor = Node
 
 -- | getMaxCliques
 -- TODO chose distance order
-getMaxCliques :: Ord a => Threshold -> Map (a, a) Int -> [[a]]
-getMaxCliques t m = map fromIndices $ getMaxCliques' t m'
+getMaxCliques :: Ord a => Distance -> Threshold -> Map (a, a) Int -> [[a]]
+getMaxCliques d t m = map fromIndices $ getMaxCliques' t m'
   where
     m'          = toIndex to m
     (to,from)   = createIndices m
@@ -79,7 +80,7 @@ getMaxCliques t m = map fromIndices $ getMaxCliques' t m'
     getMaxCliques' t' n = maxCliques graph
       where
         graph = mkGraphUfromEdges (Map.keys n')
-        n'    = cooc2graph' t' n
+        n'    = cooc2graph' d t' n
 
 maxCliques :: Graph -> [[Node]]
 maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax

src/Gargantext/Viz/Graph/Tools.hs

@@ -38,27 +38,29 @@ import qualified Data.List as List
 type Threshold = Double
 
 
-cooc2graph' :: Ord t => Double
+cooc2graph' :: Ord t => Distance
+                     -> Double
                      -> Map (t, t) Int
                      -> Map (Index, Index) Double
-cooc2graph' threshold myCooc = distanceMap
+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 Conditional matCooc
+    distanceMat = measure distance matCooc
     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 
 
-cooc2graph :: Threshold
+cooc2graph :: Distance
+           -> Threshold
            -> (Map (Text, Text) Int)
            -> IO Graph
-cooc2graph threshold myCooc = do
+cooc2graph distance threshold myCooc = do
   let
     (ti, _) = createIndices myCooc
     myCooc' = toIndex ti myCooc
     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
-    distanceMat = measure Conditional matCooc
+    distanceMat = measure distance matCooc
     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 
     nodesApprox :: Int