[GRAPH] again without filters.

src/Gargantext/API/Node.hs

@@ -38,6 +38,7 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Monad ((>>))
 --import System.IO (putStrLn, readFile)
 
+--import qualified Data.Map as Map
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Text (Text())
 import Data.Swagger
@@ -55,11 +56,12 @@ import Gargantext.Database.Node.Children (getChildren)
 import qualified Gargantext.Database.Node.Update as U (update, Update(..))
 import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),FacetChart,runViewAuthorsDoc)
 import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
-import Gargantext.Database.Metrics.Count (getCoocByDocDev)
+import Gargantext.Database.Metrics.Count (getNgramsByNode)
 import Gargantext.Database.Schema.Node (defaultList)
 import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
-
+import Gargantext.Text.Metrics.Count (coocOn)
 -- Graph
 import Gargantext.Text.Flow (cooc2graph)
 import Gargantext.Viz.Graph hiding (Node)-- (Graph(_graph_metadata),LegendField(..), GraphMetadata(..),readGraphFromJson,defaultGraph)
@@ -289,8 +291,10 @@ graphAPI nId = do
                                      ]
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
   let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
-  lId <- defaultList cId
-  myCooc <- getCoocByDocDev cId lId
+  _lId <- defaultList cId
+  -- lId' <- listsWith masterUser
+  --myCooc <- getCoocByDocDev cId lId -- (lid' <> [lId])
+  myCooc <- coocOn identity <$> getNgramsByNode cId NgramsTerms
   liftIO $ set graph_metadata (Just metadata)
         <$> cooc2graph myCooc
         

src/Gargantext/Database/Metrics/Count.hs

@@ -11,6 +11,7 @@ Count Ngrams by Context
 
 -}
 
+{-# LANGUAGE Arrows            #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes       #-}
@@ -18,18 +19,25 @@ Count Ngrams by Context
 
 module Gargantext.Database.Metrics.Count where
 
+import Control.Arrow (returnA)
 import Control.Lens (view)
 import Data.Map.Strict (Map, fromListWith, elems)
 import Data.Text (Text)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Gargantext.Core.Types.Main (listTypeId, ListType(..))
+import Gargantext.Database.Queries.Join (leftJoin4)
+import Gargantext.Database.Schema.Ngrams
+import Gargantext.Database.Schema.Ngrams (NgramsId, NgramsType(..), ngramsTypeId, Ngrams(..), NgramsIndexed(..), ngrams, ngramsTerms)
+import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Node (HasNodeError(..))
+import Gargantext.Database.Schema.NodeNgram
+import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId)
+import Gargantext.Database.Utils
+import Gargantext.Database.Utils (Cmd, runPGSQuery)
 import Gargantext.Prelude
-import Gargantext.Core.Types.Main (listTypeId, ListType(..))
 import Gargantext.Text.Metrics.Count (Coocs, coocOn)
-import Gargantext.Database.Utils (Cmd, runPGSQuery)
-import Gargantext.Database.Types.Node (ListId, CorpusId)
-import Gargantext.Database.Types.Node (NodeId)
-import Gargantext.Database.Schema.Ngrams (NgramsId, NgramsType(..), ngramsTypeId, Ngrams(..), NgramsIndexed(..), ngrams, ngramsTerms)
+import Opaleye
 
 getCoocByDocDev :: HasNodeError err => CorpusId -> ListId -> Cmd err (Map ([Text], [Text]) Int)
 getCoocByDocDev cId lId = coocOn (\n-> [ view ( ngrams . ngramsTerms) n]) <$> getNgramsByDoc cId lId
@@ -65,3 +73,56 @@ getNgramsByDocDb cId lId = runPGSQuery query params
     AND   list.ngrams_type = ? -- NgramsTypeId
 
   |]
+
+
+getNgramsByNode :: NodeId -> NgramsType -> Cmd err [[Text]]
+getNgramsByNode nId nt =  elems
+                   <$> fromListWith (<>)
+                   <$> map (\(i,t) -> (i,[t]))
+                   <$> getNgramsByNodeIndexed nId nt
+
+-- | TODO add join with nodeNodeNgram (if it exists)
+getNgramsByNodeIndexed :: NodeId -> NgramsType -> Cmd err [(NodeId, Text)]
+getNgramsByNodeIndexed nId nt = runOpaQuery (select' nId)
+  where
+    select' nId' = proc () -> do
+      (ng,(nng,(_,n))) <- getNgramsByNodeIndexedJoin -< ()
+      restrict          -< _node_id n         .== toNullable (pgNodeId nId')
+      restrict          -< _nn_ngramsType nng .== toNullable (pgNgramsTypeId $ ngramsTypeId nt)
+      returnA           -< (_nn_node_id nng, ngrams_terms ng)
+
+--}
+getNgramsByNodeIndexedJoin :: Query ( NgramsRead
+                                    , (NodeNgramReadNull
+                                      , (NodeNodeReadNull
+                                        , NodeReadNull
+                                        )
+                                      )
+                                    )
+getNgramsByNodeIndexedJoin = leftJoin4 queryNodeTable
+                                       queryNodeNodeTable
+                                       queryNodeNgramTable
+                                       queryNgramsTable
+                                       c1 c2 c3
+  where
+    c1 :: (NodeNodeRead, NodeRead) -> Column PGBool
+    c1 (nn,n)       = nodeNode_node1_id nn .== _node_id n
+
+    c2 :: ( NodeNgramRead
+          , (NodeNodeRead
+            , NodeReadNull
+            )
+          ) -> Column PGBool
+    c2 (nng,(nn',_)) = (_nn_node_id nng)   .== nodeNode_node2_id nn'
+
+    c3 :: ( NgramsRead
+          , ( NodeNgramRead
+            , ( NodeNodeReadNull
+              , NodeReadNull
+              )
+            )
+          ) -> Column PGBool
+    c3 (ng,(nng',(_,_))) = (ngrams_id ng)   .== _nn_ngrams_id nng'
+
+--}
+

src/Gargantext/Database/Queries/Join.hs

@@ -30,7 +30,6 @@ module Gargantext.Database.Queries.Join
 import Control.Applicative ((<*>))
 import Control.Arrow ((>>>))
 import Data.Profunctor.Product.Default
-import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeNode
 import Gargantext.Prelude
@@ -51,32 +50,7 @@ join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
 
 ------------------------------------------------------------------------
 
-leftJoin3Ex :: Query (NodeRead, (NodeNodeReadNull, NodeReadNull))
-leftJoin3Ex = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12 cond23
-    where
-         cond12 = undefined
-         cond23 :: (NodeRead, (NodeNodeRead, NodeReadNull)) -> Column PGBool
-         cond23 = undefined
-
-
-leftJoin3 :: ( Default Unpackspec columnsL1 columnsL1
-             , Default Unpackspec columnsL2 columnsL2
-             , Default Unpackspec columnsL3 columnsL3
-             
-             , Default Unpackspec nullableColumnsL2 nullableColumnsL2
-             
-             , Default NullMaker  columnsL2  nullableColumnsL2
-             , Default NullMaker (columnsL1, nullableColumnsL2) nullableColumnsL3
-             )
-             =>
-              Query columnsL1 -> Query columnsL2 -> Query columnsL3
-                -> ((columnsL1, columnsL2) -> Column PGBool)
-                -> ((columnsL3, (columnsL1, nullableColumnsL2)) -> Column PGBool)
-                -> Query (columnsL3, nullableColumnsL3)
-leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
-
-
-leftJoin3'
+leftJoin3
   :: (Default Unpackspec fieldsL1 fieldsL1,
       Default Unpackspec fieldsL2 fieldsL2,
       Default Unpackspec nullableFieldsR1 nullableFieldsR1,
@@ -89,35 +63,7 @@ leftJoin3'
      -> ((fieldsL2, fieldsR) -> Column PGBool)
      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
      -> Opaleye.Select (fieldsL1, nullableFieldsR2)
-leftJoin3' q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q2 q1 cond12) cond23
-
---{-
-leftJoin4' :: Query (NodeRead, (NodeReadNull, (NgramsReadNull, NodeReadNull)))
-leftJoin4' = leftJoin4 queryNgramsTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
-    where
-         cond12 :: (NgramsRead, NodeRead) -> Column PGBool
-         cond12 = undefined
-         
-         cond23 :: (NodeRead, (NgramsRead, NodeReadNull)) -> Column PGBool
-         cond23 = undefined
-         
-         cond34 :: (NodeRead, (NodeRead, (NgramsReadNull, NodeReadNull))) -> Column PGBool
-         cond34 = undefined
-
-{-
-rightJoin4' :: Query (((NodeReadNull, NodeReadNull), NodeReadNull), NodeRead)
-rightJoin4' = rightJoin4 queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
-    where
-         cond12 :: (NodeRead, NodeRead) -> Column PGBool
-         cond12 = undefined
-         
-         cond23 :: ((NodeReadNull, NodeRead), NodeRead) -> Column PGBool
-         cond23 = undefined
-         
-         cond34 :: (((NodeReadNull, NodeReadNull), NodeRead), NodeRead) -> Column PGBool
-         cond34 = undefined
-
---}
+leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q2 q1 cond12) cond23
 
 
 leftJoin4
@@ -130,18 +76,16 @@ leftJoin4
       Default NullMaker fieldsR nullableFieldsR2,
       Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR3,
       Default NullMaker (fieldsL3, nullableFieldsR2) nullableFieldsR1) =>
-     Opaleye.Select fieldsL3
-     -> Opaleye.Select fieldsR
+     Opaleye.Select fieldsR
+     -> Opaleye.Select fieldsL3
      -> Opaleye.Select fieldsL2
      -> Opaleye.Select fieldsL1
      -> ((fieldsL3, fieldsR) -> Column PGBool)
      -> ((fieldsL2, (fieldsL3, nullableFieldsR2)) -> Column PGBool)
      -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
      -> Opaleye.Select (fieldsL1, nullableFieldsR3)
-leftJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = leftJoin q4 (leftJoin q3 (leftJoin q1 q2 cond12) cond23) cond34
-
+leftJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34
 
--- rightJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = rightJoin q4 (rightJoin q3 (rightJoin q1 q2 cond12) cond23) cond34
 
 --{-
 leftJoin5' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, (NodeNodeReadNull, NodeSearchReadNull))))

src/Gargantext/Database/Schema/Ngrams.hs

@@ -56,8 +56,8 @@ import qualified Data.Set as DS
 import qualified Database.PostgreSQL.Simple as PGS
 
 
-type NgramsTerms = Text
 type NgramsId    = Int
+type NgramsTerms = Text
 type Size        = Int
 
 data NgramsPoly id terms n = NgramsDb { ngrams_id    :: id
@@ -263,12 +263,12 @@ type NgramsTableParamMaster = NgramsTableParam
 
 
 data NgramsTableData = NgramsTableData { _ntd_id        :: Int
-                                         , _ntd_parent_id :: Maybe Int
-                                         , _ntd_terms     :: Text
-                                         , _ntd_n         :: Int
-                                         , _ntd_listType  :: Maybe ListType
-                                         , _ntd_weight    :: Double
-                                         } deriving (Show)
+                                       , _ntd_parent_id :: Maybe Int
+                                       , _ntd_terms     :: Text
+                                       , _ntd_n         :: Int
+                                       , _ntd_listType  :: Maybe ListType
+                                       , _ntd_weight    :: Double
+                                       } deriving (Show)
 
 
 

src/Gargantext/Database/Schema/Node.hs

@@ -102,6 +102,10 @@ instance FromField HyperdataGraph
 instance FromField HyperdataAnnuaire
   where
     fromField = fromField'
+
+instance FromField (NodeId, Text)
+  where
+    fromField = fromField'
 ------------------------------------------------------------------------
 instance QueryRunnerColumnDefault PGJsonb HyperdataAny
   where
@@ -147,6 +151,11 @@ instance QueryRunnerColumnDefault PGInt4 NodeId
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+
 
 ------------------------------------------------------------------------
 -- WIP

src/Gargantext/Text/Flow.hs

@@ -20,26 +20,26 @@ module Gargantext.Text.Flow
 
 --import qualified Data.Array.Accelerate as A
 --import qualified Data.Set as DS
-import Control.Monad.Reader
+--import Control.Monad.Reader
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 import Data.Map.Strict (Map)
-import Data.Maybe (catMaybes)
-import qualified Data.Map.Strict as M
+--import Data.Maybe (catMaybes)
+import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import Data.Text (Text)
-import Data.Text.IO (readFile)
+--import Data.Text.IO (readFile)
 import Database.PostgreSQL.Simple (Connection)
 import GHC.IO (FilePath)
-import Gargantext.Core (Lang)
+--import Gargantext.Core (Lang)
 import Gargantext.Core.Types (CorpusId)
-import Gargantext.Database.Schema.Node
-import Gargantext.Database.Types.Node
+--import Gargantext.Database.Schema.Node
+--import Gargantext.Database.Types.Node
 import Gargantext.Prelude
-import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
+--import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
 import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
-import Gargantext.Text.Metrics.Count (cooc)
-import Gargantext.Text.Parsers.CSV
-import Gargantext.Text.Terms (TermType, extractTerms)
+--import Gargantext.Text.Metrics.Count (coocOn)
+--import Gargantext.Text.Parsers.CSV
+--import Gargantext.Text.Terms (TermType, extractTerms)
 import Gargantext.Viz.Graph (Graph(..), data2graph)
 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
@@ -76,7 +76,7 @@ data TextFlow = CSV FilePath
               | DBV3 Connection CorpusId
               | Query T.Text
 
-
+{-
 textFlow :: TermType Lang -> TextFlow -> IO Graph
 textFlow termType workType = do
   contexts <- case workType of
@@ -104,18 +104,19 @@ textFlow' termType contexts = do
   -- Bulding the map list
   -- compute copresences of terms, i.e. cooccurrences of terms in same context of text
   -- Cooc = Map (Term, Term) Int
-  let myCooc1 = cooc myterms
+  let myCooc1 = coocOn (_terms_label) myterms
   --printDebug "myCooc1 size" (M.size myCooc1)
 
   -- Remove Apax: appears one time only => lighting the matrix
-  let myCooc2 = M.filter (>0) myCooc1
+  let myCooc2 = Map.filter (>0) myCooc1
   --printDebug "myCooc2 size" (M.size myCooc2)
   --printDebug "myCooc2" myCooc2
   g <- cooc2graph myCooc2
   pure g
+-}
 
 -- TODO use Text only here instead of [Text]
-cooc2graph :: (Map ([Text], [Text]) Int) -> IO Graph
+cooc2graph :: (Map (Text, Text) Int) -> IO Graph
 cooc2graph myCooc = do
   --printDebug "myCooc" myCooc
   -- Filtering terms with inclusion/Exclusion and Specificity/Genericity scores
@@ -137,7 +138,7 @@ cooc2graph myCooc = do
   --printDebug "myCooc4 size" $ M.size myCooc4
   --printDebug "myCooc4" myCooc4
 
-  let matCooc = map2mat (0) (M.size ti) myCooc4
+  let matCooc = map2mat (0) (Map.size ti) myCooc4
   --printDebug "matCooc shape" $ A.arrayShape matCooc
   --printDebug "matCooc" matCooc
 
@@ -148,19 +149,19 @@ cooc2graph myCooc = do
   --printDebug "distanceMat" distanceMat
 
   --let distanceMap = M.filter (>0) $ mat2map distanceMat
-  let distanceMap = M.map (\_ -> 1) $ M.filter (>0) $ mat2map distanceMat
+  let distanceMap = Map.map (\_ -> 1) $ Map.filter (>0) $ mat2map distanceMat
   --printDebug "distanceMap size" $ M.size distanceMap
   --printDebug "distanceMap" distanceMap
 
 --  let distance = fromIndex fi distanceMap
   --printDebug "distance" $ M.size distance
 
-  partitions <- case M.size distanceMap > 0 of
+  partitions <- case Map.size distanceMap > 0 of
                   True  -> cLouvain distanceMap
                   False -> panic "Text.Flow: DistanceMap is empty"
 -- Building : -> Graph -> JSON
   --printDebug "partitions" $ DS.size $ DS.fromList $ map (l_community_id) partitions
   --printDebug "partitions" partitions
   let distanceMap' = bridgeness 300 partitions distanceMap
-  pure $ data2graph (M.toList ti) myCooc4 distanceMap' partitions
+  pure $ data2graph (Map.toList ti) myCooc4 distanceMap' partitions
 

src/Gargantext/Text/Metrics/Count.hs

@@ -108,10 +108,10 @@ labelPolicy m g =  case _terms_label <$> fst <$> maximumWith snd <$> DMS.toList
                      Nothing    -> panic $ "Label of Grouped not found: " <> (pack $ show g)
 -}
 
-coocOn :: Ord b => (a -> b) -> [[a]] -> Map (b, b) Coocs
+coocOn :: Ord b => (a -> b) -> [[a]] -> Map (b, b) Int
 coocOn f as = DMS.unionsWith (+) $ map (coocOn' f) as
 
-coocOn' :: Ord b => (a -> b) -> [a] -> Map (b, b) Coocs
+coocOn' :: Ord b => (a -> b) -> [a] -> Map (b, b) Int
 coocOn' fun ts = DMS.fromListWith (+) xs
   where
       ts' = List.nub $ map fun ts

src/Gargantext/Viz/Graph.hs

@@ -36,7 +36,6 @@ import qualified Data.Map.Strict as M
 import Data.Swagger
 
 import Gargantext.Prelude
-import Gargantext.Core.Types (Label)
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Types.Node (NodeId)
 
@@ -164,9 +163,9 @@ $(deriveJSON (unPrefix "go_") ''GraphV3)
 ----------------------------------------------------------
 -- | 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]
+data2graph :: [(Text, Int)] -> Map (Int, Int) Int
+                            -> Map (Int, Int) Double
+                            -> [LouvainNode]
               -> Graph
 data2graph labels coocs distance partitions = Graph nodes edges Nothing
   where
@@ -174,7 +173,7 @@ data2graph labels coocs distance partitions = Graph nodes edges Nothing
     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_label = l
                    , node_attributes =
                      Attributes { clust_default = maybe 0 identity 
                                 (M.lookup n community_id_by_node_id) } }

src/Gargantext/Viz/Phylo/Tools.hs

@@ -32,7 +32,7 @@ module Gargantext.Viz.Phylo.Tools where
 
 import Data.Set (Set)
 import Data.Map (Map)
-import Data.Map as Map hiding (Map)
+import qualified Data.Map as Map hiding (Map)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Example
@@ -44,6 +44,7 @@ type MinSize = Int
 
 -- | Building a phylo
 -- (Indicative and schematic function)
+{-
 buildPhylo :: Support -> MinSize
                       -> Map Clique Support -> Phylo
 buildPhylo s m mcs = level2Phylo
@@ -51,8 +52,9 @@ buildPhylo s m mcs = level2Phylo
                    . clusters2group
                    . map clique2cluster
                    . filterCliques s m
+-}
 
-level2Phylo :: PhyloLevel -> Phylo -> Phylo
+level2Phylo :: [PhyloLevel] -> Phylo -> Phylo
 level2Phylo = undefined
 
 groups2level :: [PhyloGroup] -> PhyloLevel