Commit a2fd553a authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FEAT] Order 1 and 2 implemented.

parent 22b6aa97
...@@ -30,7 +30,7 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs) ...@@ -30,7 +30,7 @@ import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types (HasSettings) import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Prelude (GargServer, simuLogs) import Gargantext.API.Prelude (GargServer, simuLogs)
import Gargantext.Core.Viz.Graph.API (recomputeGraph) import Gargantext.Core.Viz.Graph.API (recomputeGraph)
import Gargantext.Core.Methods.Distances (GraphMetric(..), Distance(..)) import Gargantext.Core.Methods.Distances (GraphMetric(..))
import Gargantext.Database.Action.Flow.Pairing (pairing) import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Action.Flow.Types (FlowCmdM) import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
...@@ -86,9 +86,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do ...@@ -86,9 +86,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
, _scst_events = Just [] , _scst_events = Just []
} }
_ <- case metric of _ <- recomputeGraph uId nId (Just metric)
Order1 -> recomputeGraph uId nId Conditional
Order2 -> recomputeGraph uId nId Distributional
pure JobLog { _scst_succeeded = Just 2 pure JobLog { _scst_succeeded = Just 2
, _scst_failed = Just 0 , _scst_failed = Just 0
......
...@@ -35,9 +35,9 @@ measure Conditional = measureConditional ...@@ -35,9 +35,9 @@ measure Conditional = measureConditional
measure Distributional = logDistributional measure Distributional = logDistributional
------------------------------------------------------------------------ ------------------------------------------------------------------------
withMetric :: GraphMetric -> Matrix Int -> Matrix Double withMetric :: GraphMetric -> Distance
withMetric Order1 = measureConditional withMetric Order1 = Conditional
withMetric Order2 = logDistributional withMetric Order2 = Distributional
------------------------------------------------------------------------ ------------------------------------------------------------------------
data GraphMetric = Order1 | Order2 data GraphMetric = Order1 | Order2
......
...@@ -18,6 +18,7 @@ module Gargantext.Core.Viz.Graph.API ...@@ -18,6 +18,7 @@ module Gargantext.Core.Viz.Graph.API
import Control.Lens (set, (^.), _Just, (^?)) import Control.Lens (set, (^.), _Just, (^?))
import Data.Aeson import Data.Aeson
import Data.Maybe (fromMaybe)
import Data.Swagger import Data.Swagger
import Data.Text import Data.Text
import Debug.Trace (trace) import Debug.Trace (trace)
...@@ -26,7 +27,7 @@ import Gargantext.API.Admin.Orchestrator.Types ...@@ -26,7 +27,7 @@ import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Ngrams.Tools import Gargantext.API.Ngrams.Tools
import Gargantext.API.Ngrams.Types (NgramsRepo, r_version) import Gargantext.API.Ngrams.Types (NgramsRepo, r_version)
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..)) import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..), withMetric)
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Core.Viz.Graph import Gargantext.Core.Viz.Graph
import Gargantext.Core.Viz.Graph.GEXF () import Gargantext.Core.Viz.Graph.GEXF ()
...@@ -91,9 +92,9 @@ getGraph _uId nId = do ...@@ -91,9 +92,9 @@ getGraph _uId nId = do
-- TODO Distance in Graph params -- TODO Distance in Graph params
case graph of case graph of
Nothing -> do Nothing -> do
-- graph' <- computeGraph cId Distributional NgramsTerms repo let defaultMetric = Order1
graph' <- computeGraph cId Conditional NgramsTerms repo graph' <- computeGraph cId (withMetric defaultMetric) NgramsTerms repo
mt <- defaultGraphMetadata cId "Title" repo mt <- defaultGraphMetadata cId "Title" repo defaultMetric
let let
graph'' = set graph_metadata (Just mt) graph' graph'' = set graph_metadata (Just mt) graph'
hg = HyperdataGraphAPI graph'' camera hg = HyperdataGraphAPI graph'' camera
...@@ -105,14 +106,17 @@ getGraph _uId nId = do ...@@ -105,14 +106,17 @@ getGraph _uId nId = do
HyperdataGraphAPI graph' camera HyperdataGraphAPI graph' camera
recomputeGraph :: UserId -> NodeId -> Distance -> GargNoServer Graph recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
recomputeGraph _uId nId d = do recomputeGraph _uId nId maybeDistance = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph) nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
let let
graph = nodeGraph ^. node_hyperdata . hyperdataGraph graph = nodeGraph ^. node_hyperdata . hyperdataGraph
camera = nodeGraph ^. node_hyperdata . hyperdataCamera camera = nodeGraph ^. node_hyperdata . hyperdataCamera
graphMetadata = graph ^? _Just . graph_metadata . _Just graphMetadata = graph ^? _Just . graph_metadata . _Just
listVersion = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version listVersion = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
graphMetric = case maybeDistance of
Nothing -> graph ^? _Just . graph_metadata . _Just . gm_metric
_ -> maybeDistance
repo <- getRepo repo <- getRepo
let let
...@@ -120,11 +124,14 @@ recomputeGraph _uId nId d = do ...@@ -120,11 +124,14 @@ recomputeGraph _uId nId d = do
cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent") cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent")
identity identity
$ nodeGraph ^. node_parentId $ nodeGraph ^. node_parentId
similarity = case graphMetric of
Nothing -> withMetric Order2
Just m -> withMetric m
case graph of case graph of
Nothing -> do Nothing -> do
graph' <- computeGraph cId d NgramsTerms repo graph' <- computeGraph cId similarity NgramsTerms repo
mt <- defaultGraphMetadata cId "Title" repo mt <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance)
let graph'' = set graph_metadata (Just mt) graph' let graph'' = set graph_metadata (Just mt) graph'
_ <- updateHyperdata nId (HyperdataGraph (Just graph'') camera) _ <- updateHyperdata nId (HyperdataGraph (Just graph'') camera)
pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" graph'' pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" graph''
...@@ -132,7 +139,7 @@ recomputeGraph _uId nId d = do ...@@ -132,7 +139,7 @@ recomputeGraph _uId nId d = do
Just graph' -> if listVersion == Just v Just graph' -> if listVersion == Just v
then pure graph' then pure graph'
else do else do
graph'' <- computeGraph cId d NgramsTerms repo graph'' <- computeGraph cId similarity NgramsTerms repo
let graph''' = set graph_metadata graphMetadata graph'' let graph''' = set graph_metadata graphMetadata graph''
_ <- updateHyperdata nId (HyperdataGraph (Just graph''') camera) _ <- updateHyperdata nId (HyperdataGraph (Just graph''') camera)
pure $ trace "[G.V.G.API] Graph exists, recomputing" graph''' pure $ trace "[G.V.G.API] Graph exists, recomputing" graph'''
...@@ -157,7 +164,7 @@ computeGraph cId d nt repo = do ...@@ -157,7 +164,7 @@ computeGraph cId d nt repo = do
<$> groupNodesByNgrams ngs <$> groupNodesByNgrams ngs
<$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs) <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
printDebug "myCooc" myCooc -- printDebug "myCooc" myCooc
graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
pure graph pure graph
...@@ -167,13 +174,14 @@ defaultGraphMetadata :: HasNodeError err ...@@ -167,13 +174,14 @@ defaultGraphMetadata :: HasNodeError err
=> CorpusId => CorpusId
-> Text -> Text
-> NgramsRepo -> NgramsRepo
-> GraphMetric
-> Cmd err GraphMetadata -> Cmd err GraphMetadata
defaultGraphMetadata cId t repo = do defaultGraphMetadata cId t repo gm = do
lId <- defaultList cId lId <- defaultList cId
pure $ GraphMetadata { pure $ GraphMetadata {
_gm_title = t _gm_title = t
, _gm_metric = Order1 , _gm_metric = gm
, _gm_corpusId = [cId] , _gm_corpusId = [cId]
, _gm_legend = [ , _gm_legend = [
LegendField 1 "#FFF" "Cluster1" LegendField 1 "#FFF" "Cluster1"
...@@ -209,7 +217,7 @@ graphRecompute u n logStatus = do ...@@ -209,7 +217,7 @@ graphRecompute u n logStatus = do
, _scst_remaining = Just 1 , _scst_remaining = Just 1
, _scst_events = Just [] , _scst_events = Just []
} }
_g <- trace (show u) $ recomputeGraph u n Distributional _g <- trace (show u) $ recomputeGraph u n Nothing
pure JobLog { _scst_succeeded = Just 1 pure JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0 , _scst_failed = Just 0
, _scst_remaining = Just 0 , _scst_remaining = Just 0
...@@ -249,7 +257,7 @@ graphVersions nId = do ...@@ -249,7 +257,7 @@ graphVersions nId = do
, gv_repo = v } , gv_repo = v }
recomputeVersions :: UserId -> NodeId -> GargNoServer Graph recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
recomputeVersions uId nId = recomputeGraph uId nId Distributional recomputeVersions uId nId = recomputeGraph uId nId Nothing
------------------------------------------------------------ ------------------------------------------------------------
graphClone :: UserId graphClone :: UserId
......
...@@ -51,12 +51,13 @@ cooc2graph' distance threshold myCooc ...@@ -51,12 +51,13 @@ cooc2graph' distance threshold myCooc
$ mat2map $ mat2map
$ measure distance $ measure distance
$ case distance of $ case distance of
Conditional -> map2mat Triangular 0 (Map.size ti) Conditional -> map2mat Triangular 0 tiSize
Distributional -> map2mat Square 0 (Map.size ti) Distributional -> map2mat Square 0 tiSize
$ Map.filter (> 1) myCooc' $ Map.filter (> 1) myCooc'
where where
(ti, _) = createIndices myCooc (ti, _) = createIndices myCooc
tiSize = Map.size ti
myCooc' = toIndex ti myCooc myCooc' = toIndex ti myCooc
...@@ -84,26 +85,18 @@ cooc2graphWith' doPartitions distance threshold myCooc = do ...@@ -84,26 +85,18 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
$ HashMap.toList myCooc $ HashMap.toList myCooc
(ti, _) = createIndices theMatrix (ti, _) = createIndices theMatrix
tiSize = Map.size ti
myCooc' = toIndex ti theMatrix myCooc' = toIndex ti theMatrix
matCooc = case distance of -- Shape of the Matrix matCooc = case distance of -- Shape of the Matrix
Conditional -> map2mat Triangular 0 (Map.size ti) Conditional -> map2mat Triangular 0 tiSize
Distributional -> map2mat Square 0 (Map.size ti) Distributional -> map2mat Square 0 tiSize
$ case distance of -- Removing the Diagonal ? $ case distance of -- Removing the Diagonal ?
Conditional -> Map.filterWithKey (\(a,b) _ -> a /= b) Conditional -> Map.filterWithKey (\(a,b) _ -> a /= b)
Distributional -> identity Distributional -> identity
$ Map.filter (>1) myCooc' $ Map.filter (>1) myCooc'
printDebug "myCooc'" myCooc'
printDebug "ti" (Map.size ti)
let
similarities = measure distance matCooc similarities = measure distance matCooc
links = round (let n :: Double = fromIntegral tiSize in n * log n)
printDebug "Similarities" similarities
let
links = round (let n :: Double = fromIntegral (Map.size ti) in n * log n)
distanceMap = Map.fromList distanceMap = Map.fromList
$ List.take links $ List.take links
$ List.sortOn snd $ List.sortOn snd
...@@ -120,6 +113,8 @@ cooc2graphWith' doPartitions distance threshold myCooc = do ...@@ -120,6 +113,8 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
n' = Set.size $ Set.fromList $ as <> bs n' = Set.size $ Set.fromList $ as <> bs
ClustersParams rivers _level = clustersParams nodesApprox ClustersParams rivers _level = clustersParams nodesApprox
printDebug "similarities" similarities
partitions <- if (Map.size distanceMap > 0) partitions <- if (Map.size distanceMap > 0)
then doPartitions distanceMap then doPartitions distanceMap
else panic "Text.Flow: DistanceMap is empty" else panic "Text.Flow: DistanceMap is empty"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment