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

[FACTO] moving data2graph from textflow to Viz.Graph.

parent 16a85fb4
...@@ -2,5 +2,5 @@ import System.FilePath.Glob ...@@ -2,5 +2,5 @@ import System.FilePath.Glob
import Test.DocTest import Test.DocTest
main :: IO () main :: IO ()
main = glob "src/Gargantext/Text/" >>= doctest main = glob "src/Gargantext/" >>= doctest
{-| {-|
Module : Gargantext.API Module : Gargantext.API
Description : Server API Description : REST API declaration
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
Maintainer : team@gargantext.org Maintainer : team@gargantext.org
...@@ -10,6 +10,7 @@ Portability : POSIX ...@@ -10,6 +10,7 @@ Portability : POSIX
Main REST API of Gargantext (both Server and Client sides) Main REST API of Gargantext (both Server and Client sides)
TODO App type, the main monad in which the bot code is written with. TODO App type, the main monad in which the bot code is written with.
Provide config, state, logs and IO Provide config, state, logs and IO
type App m a = ( MonadState AppState m type App m a = ( MonadState AppState m
, MonadReader Conf m , MonadReader Conf m
...@@ -186,22 +187,32 @@ makeDevApp env = do ...@@ -186,22 +187,32 @@ makeDevApp env = do
type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json" type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
-- | API for serving main operational routes of @gargantext.org@ -- | API for serving main operational routes of @gargantext.org@
type GargAPI = "user" :> Summary "First user endpoint" type GargAPI =
-- Roots endpoint
"user" :> Summary "First user endpoint"
:> Roots :> Roots
-- Node endpoint
:<|> "node" :> Summary "Node endpoint" :<|> "node" :> Summary "Node endpoint"
:> Capture "id" Int :> NodeAPI :> Capture "id" Int :> NodeAPI
-- Corpus endpoint
:<|> "corpus":> Summary "Corpus endpoint" :<|> "corpus":> Summary "Corpus endpoint"
:> Capture "id" Int :> NodeAPI :> Capture "id" Int :> NodeAPI
-- Corpus endpoint
:<|> "nodes" :> Summary "Nodes endpoint" :<|> "nodes" :> Summary "Nodes endpoint"
:> ReqBody '[JSON] [Int] :> NodesAPI :> ReqBody '[JSON] [Int] :> NodesAPI
-- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
-- Corpus endpoint
:<|> "count" :> Summary "Count endpoint" :<|> "count" :> Summary "Count endpoint"
:> ReqBody '[JSON] Query :> CountAPI :> ReqBody '[JSON] Query :> CountAPI
-- Corpus endpoint
:<|> "search":> Summary "Search endpoint" :<|> "search":> Summary "Search endpoint"
:> ReqBody '[JSON] SearchQuery :> SearchAPI :> ReqBody '[JSON] SearchQuery :> SearchAPI
......
...@@ -63,7 +63,7 @@ termTests = "It is hard to detect important articles in a specific context. Info ...@@ -63,7 +63,7 @@ termTests = "It is hard to detect important articles in a specific context. Info
-- | Ngrams Test -- | Ngrams Test
-- >>> ngramsTest testText -- >> ngramsTest testText
-- 248 -- 248
--ngramsTest :: Text -> Int --ngramsTest :: Text -> Int
--ngramsTest x = length ws --ngramsTest x = length ws
......
...@@ -22,17 +22,15 @@ import qualified Data.Text as T ...@@ -22,17 +22,15 @@ import qualified Data.Text as T
import Data.Text.IO (readFile) import Data.Text.IO (readFile)
import Data.Map.Strict (Map)
import qualified Data.Array.Accelerate as A import qualified Data.Array.Accelerate as A
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
---------------------------------------------- ----------------------------------------------
import Gargantext.Core (Lang) import Gargantext.Core (Lang)
import Gargantext.Core.Types (Label)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map) import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
import Gargantext.Viz.Graph.Distances.Matrice (conditional) import Gargantext.Viz.Graph.Distances.Matrice (conditional)
import Gargantext.Viz.Graph (Graph(..), Node(..), Edge(..), Attributes(..), TypeNode(..)) import Gargantext.Viz.Graph (Graph(..), data2graph)
import Gargantext.Text.Metrics.Count (cooc) import Gargantext.Text.Metrics.Count (cooc)
import Gargantext.Text.Metrics import Gargantext.Text.Metrics
import Gargantext.Text.Terms (TermType, extractTerms) import Gargantext.Text.Terms (TermType, extractTerms)
...@@ -40,7 +38,7 @@ import Gargantext.Text.Context (splitBy, SplitContext(Sentences)) ...@@ -40,7 +38,7 @@ import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
import Gargantext.Text.Parsers.CSV import Gargantext.Text.Parsers.CSV
import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain, LouvainNode(..)) import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
{- {-
...@@ -130,28 +128,4 @@ textFlow' termType contexts = do ...@@ -130,28 +128,4 @@ textFlow' termType contexts = do
--printDebug "partitions" partitions --printDebug "partitions" partitions
pure $ data2graph (M.toList ti) myCooc4 distanceMap partitions pure $ data2graph (M.toList ti) myCooc4 distanceMap partitions
-----------------------------------------------------------
-- | From data to Graph
-- FIXME: distance should not be a map since we just "toList" it (same as cLouvain)
data2graph :: [(Label, Int)] -> Map (Int, Int) Int
-> Map (Int, Int) Double
-> [LouvainNode]
-> Graph
data2graph labels coocs distance partitions = Graph nodes edges
where
community_id_by_node_id = M.fromList [ (n, c) | LouvainNode n c <- partitions ]
nodes = [ Node { node_size = maybe 0 identity (M.lookup (n,n) coocs)
, node_type = Terms -- or Unknown
, node_id = cs (show n)
, node_label = T.unwords l
, node_attributes =
Attributes { clust_default = maybe 0 identity
(M.lookup n community_id_by_node_id) } }
| (l, n) <- labels ]
edges = [ Edge { edge_source = cs (show s)
, edge_target = cs (show t)
, edge_weight = w
, edge_id = cs (show i) }
| (i, ((s,t), w)) <- zip ([0..]::[Integer]) (M.toList distance) ]
-----------------------------------------------------------
{-| {-|
Module : Gargantext.Viz.Graph Module : Gargantext.Viz.Graph
Description : Description : Graph utils
Copyright : (c) CNRS, 2017-Present Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3 License : AGPL + CECILL v3
Maintainer : team@gargantext.org Maintainer : team@gargantext.org
...@@ -27,9 +27,14 @@ import Data.Text (Text) ...@@ -27,9 +27,14 @@ import Data.Text (Text)
import qualified Text.Read as T import qualified Text.Read as T
import qualified Data.Text as T import qualified Data.Text as T
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Types (Label)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix)
import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
data TypeNode = Terms | Unknown data TypeNode = Terms | Unknown
deriving (Show, Generic) deriving (Show, Generic)
...@@ -92,7 +97,30 @@ data GraphOld = GraphOld { ...@@ -92,7 +97,30 @@ data GraphOld = GraphOld {
$(deriveJSON (unPrefix "go_") ''GraphOld) $(deriveJSON (unPrefix "go_") ''GraphOld)
---------------------------------------------------------- ----------------------------------------------------------
-- | From data to Graph
-- FIXME: distance should not be a map since we just "toList" it (same as cLouvain)
data2graph :: [(Label, Int)] -> Map (Int, Int) Int
-> Map (Int, Int) Double
-> [LouvainNode]
-> Graph
data2graph labels coocs distance partitions = Graph nodes edges
where
community_id_by_node_id = M.fromList [ (n, c) | LouvainNode n c <- partitions ]
nodes = [ Node { node_size = maybe 0 identity (M.lookup (n,n) coocs)
, node_type = Terms -- or Unknown
, node_id = cs (show n)
, node_label = T.unwords l
, node_attributes =
Attributes { clust_default = maybe 0 identity
(M.lookup n community_id_by_node_id) } }
| (l, n) <- labels ]
edges = [ Edge { edge_source = cs (show s)
, edge_target = cs (show t)
, edge_weight = w
, edge_id = cs (show i) }
| (i, ((s,t), w)) <- zip ([0..]::[Integer]) (M.toList distance) ]
-----------------------------------------------------------
-----------------------------------------------------------
graphOld2graph :: GraphOld -> Graph graphOld2graph :: GraphOld -> Graph
graphOld2graph (GraphOld links nodes) = Graph (map nodeOld2node nodes) (zipWith linkOld2edge [1..] links) graphOld2graph (GraphOld links nodes) = Graph (map nodeOld2node nodes) (zipWith linkOld2edge [1..] links)
......
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