Skip to content

H
haskell-gargantext
Commit 4264b3ae authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[TEXT FLOW] checking all

parent 670bc6c8
Hide whitespace changes
Inline Side-by-side
Showing with 205 additions and 135 deletions
src/Gargantext/Database/Action/Flow/List.hs
View file @ 4264b3ae
......@@ -26,22 +26,76 @@ module Gargantext.Database.Action.Flow.List
import Control.Monad (mapM_)
import Data.Map (Map, toList)
import Data.Either
import Data.Maybe (Maybe(..), catMaybes)
import Data.Set (Set)
import Data.Text (Text)
import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams)
import Gargantext.Core.Types.Main (ListType(CandidateTerm))
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types.Individu
import Gargantext.Core.Flow.Types
import Gargantext.Core.Types.Main (ListType(CandidateTerm))
import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Admin.Utils (Cmd)
import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId)
import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
import Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams -- (insert_Node_NodeNgrams_NodeNgrams, Node_NodeNgrams_NodeNgrams(..))
import Gargantext.Prelude
import Gargantext.Text.List
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Gargantext.Database.Action.Metrics.NgramsByNode
import Gargantext.Database.Action.Query.Tree.Root (getOrMk_RootWithCorpus)
-- FLOW LIST
-- 1. select specific terms of the corpus when compared with others langs
-- (for now, suppose english)
-- 2. select specific terms of the corpus when compared with others corpora (same database)
-- 3. select clusters of terms (generic and specific)
{-
data FlowList = FlowListLang
| FlowListTficf
| FlowListSpeGen
flowList_Tficf :: UserCorpusId
-> MasterCorpusId
-> NgramsType
-> (Text -> Text)
-> Cmd err (Map Text (Double, Set Text))
flowList_Tficf u m nt f = do
u' <- Map.filter (\s -> Set.size s > 1) <$> getNodesByNgramsUser u nt
m' <- Map.filter (\s -> Set.size s > 1) <$> getNodesByNgramsMaster u m
pure $ sortTficf Down
$ toTficfData (countNodesByNgramsWith f u')
(countNodesByNgramsWith f m')
flowList_Tficf' :: UserCorpusId
-> MasterCorpusId
-> NgramsType
-> Cmd err (Map Text (Double, Set Text))
flowList_Tficf' u m nt f = do
u' <- Map.filter (\s -> Set.size s > 1) <$> getNodesByNgramsUser u nt
m' <- Map.filter (\s -> Set.size s > 1) <$> getNodesByNgramsMaster u m
pure $ sortTficf Down
$ toTficfData (countNodesByNgramsWith f u')
(countNodesByNgramsWith f m')
-}
-- | TODO check optimization
mapNodeIdNgrams :: [DocumentIdWithNgrams a]
-> Map Ngrams (Map NgramsType (Map NodeId Int))
......
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @ 4264b3ae
......@@ -71,8 +71,8 @@ lastName texte = DT.toLower
where
lastName' = lastMay . DT.splitOn " "
-- TODO: this method is dangerous (maybe equalities of the result are not taken into account
-- emergency demo plan...)
-- TODO: this method is dangerous (maybe equalities of the result are
-- not taken into account emergency demo plan...)
pairingPolicyToMap :: (Terms -> Terms)
-> Map (NgramsT Ngrams) a
-> Map (NgramsT Ngrams) a
......
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @ 4264b3ae
......@@ -212,7 +212,7 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
JOIN input_rows ir ON ir.terms = ng.terms
WHERE nng.node1_id = ? -- CorpusId
AND nng.node2_id = ? -- ListId
AND nng.ngrams_type = ? -- NgramsTypeId
AND nng.ngrams_type = ? -- NgramsTypeId
-- AND nn.category > 0 -- TODO
GROUP BY ng.terms, nng.weight
|]
......
src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs
View file @ 4264b3ae
......@@ -65,7 +65,10 @@ triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId Nod
|]
triggerCountInsert2 :: Cmd err Int64
triggerCountInsert2 = execPGSQuery query (nodeTypeId NodeCorpus, nodeTypeId NodeDocument, nodeTypeId NodeList)
triggerCountInsert2 = execPGSQuery query ( nodeTypeId NodeCorpus
, nodeTypeId NodeDocument
, nodeTypeId NodeList
)
where
query :: DPS.Query
query = [sql|
......
src/Gargantext/Database/Schema/Node.hs
View file @ 4264b3ae
......@@ -39,6 +39,112 @@ import Opaleye.Internal.QueryArr (Query)
import Prelude hiding (null, id, map, sum)
------------------------------------------------------------------------
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
$(makeLensesWith abbreviatedFields ''NodePolySearch)
------------------------------------------------------------------------
nodeTable :: Table NodeWrite NodeRead
nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_typename = required "typename"
, _node_userId = required "user_id"
, _node_parentId = optional "parent_id"
, _node_name = required "name"
, _node_date = optional "date"
, _node_hyperdata = required "hyperdata"
-- ignoring ts_vector field here
}
)
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
------------------------------------------------------------------------
type NodeWrite = NodePoly (Maybe (Column PGInt4) )
(Column PGInt4)
(Column PGInt4)
(Maybe (Column PGInt4) )
(Column PGText)
(Maybe (Column PGTimestamptz))
(Column PGJsonb)
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGText )
(Column PGTimestamptz )
(Column PGJsonb )
type NodeReadNull = NodePoly (Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGText))
(Column (Nullable PGTimestamptz))
(Column (Nullable PGJsonb))
------------------------------------------------------------------------
-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
-- for full text search only
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
type NodeSearchWrite =
NodePolySearch
(Maybe (Column PGInt4) )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4) )
(Column PGText )
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
(Maybe (Column PGTSVector) )
type NodeSearchRead =
NodePolySearch
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column PGText )
(Column PGTimestamptz )
(Column PGJsonb )
(Column PGTSVector )
type NodeSearchReadNull =
NodePolySearch
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGText) )
(Column (Nullable PGTimestamptz))
(Column (Nullable PGJsonb) )
(Column (Nullable PGTSVector) )
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
instance FromField HyperdataAny where
fromField = fromField'
......@@ -140,101 +246,4 @@ instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
queryRunnerColumnDefault = fieldQueryRunnerColumn
------------------------------------------------------------------------
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
$(makeLensesWith abbreviatedFields ''NodePolySearch)
type NodeWrite = NodePoly (Maybe (Column PGInt4) )
(Column PGInt4)
(Column PGInt4)
(Maybe (Column PGInt4) )
(Column PGText)
(Maybe (Column PGTimestamptz))
(Column PGJsonb)
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGText )
(Column PGTimestamptz )
(Column PGJsonb )
type NodeReadNull = NodePoly (Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGText))
(Column (Nullable PGTimestamptz))
(Column (Nullable PGJsonb))
nodeTable :: Table NodeWrite NodeRead
nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_typename = required "typename"
, _node_userId = required "user_id"
, _node_parentId = optional "parent_id"
, _node_name = required "name"
, _node_date = optional "date"
, _node_hyperdata = required "hyperdata"
}
)
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
------------------------------------------------------------------------
-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
-- for full text search only
type NodeSearchWrite =
NodePolySearch
(Maybe (Column PGInt4) )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4) )
(Column PGText )
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
(Maybe (Column PGTSVector) )
type NodeSearchRead =
NodePolySearch
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column PGText )
(Column PGTimestamptz )
(Column PGJsonb )
(Column PGTSVector )
type NodeSearchReadNull =
NodePolySearch
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGText) )
(Column (Nullable PGTimestamptz))
(Column (Nullable PGJsonb) )
(Column (Nullable PGTSVector) )
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
View file @ 4264b3ae
......@@ -33,15 +33,15 @@ import Opaleye
import Prelude
data NodeNodeNgrams2Poly node_id nodengrams_id w
= NodeNodeNgrams2 { _nnng2_node_id :: node_id
= NodeNodeNgrams2 { _nnng2_node_id :: node_id
, _nnng2_nodengrams_id :: nodengrams_id
, _nnng2_weight :: w
} deriving (Show)
type NodeNodeNgrams2Write =
NodeNodeNgrams2Poly (Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
(Column PGInt4 )
(Column PGFloat8)
type NodeNodeNgrams2Read =
NodeNodeNgrams2Poly (Column PGInt4 )
......@@ -50,8 +50,8 @@ type NodeNodeNgrams2Read =
type NodeNodeNgrams2ReadNull =
NodeNodeNgrams2Poly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
type NodeNodeNgrams2 =
NodeNodeNgrams2Poly DocId NodeNgramsId Double
......@@ -63,8 +63,8 @@ makeLenses ''NodeNodeNgrams2Poly
nodeNodeNgrams2Table :: Table NodeNodeNgrams2Write NodeNodeNgrams2Read
nodeNodeNgrams2Table = Table "node_node_ngrams2"
( pNodeNodeNgrams2 NodeNodeNgrams2
{ _nnng2_node_id = required "node_id"
, _nnng2_nodengrams_id = required "nodengrams_id"
{ _nnng2_node_id = required "node_id"
, _nnng2_nodengrams_id = required "nodengrams_id"
, _nnng2_weight = required "weight"
}
)
......@@ -77,16 +77,16 @@ insertNodeNodeNgrams2 :: [NodeNodeNgrams2] -> Cmd err Int
insertNodeNodeNgrams2 = insertNodeNodeNgrams2W
. map (\(NodeNodeNgrams2 n1 n2 w) ->
NodeNodeNgrams2 (pgNodeId n1)
(pgInt4 n2)
(pgDouble w)
)
(pgInt4 n2)
(pgDouble w)
)
insertNodeNodeNgrams2W :: [NodeNodeNgrams2Write] -> Cmd err Int
insertNodeNodeNgrams2W nnnw =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
where
insertNothing = (Insert { iTable = nodeNodeNgrams2Table
insertNothing = Insert { iTable = nodeNodeNgrams2Table
, iRows = nnnw
, iReturning = rCount
, iOnConflict = (Just DoNothing)
})
}
src/Gargantext/Database/Schema/User.hs
View file @ 4264b3ae
......@@ -47,20 +47,21 @@ toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
data UserPoly id pass llogin suser
uname fname lname
mail staff active djoined = UserDB { user_id :: id
, user_password :: pass
, user_lastLogin :: llogin
, user_isSuperUser :: suser
, user_username :: uname
, user_firstName :: fname
, user_lastName :: lname
, user_email :: mail
, user_isStaff :: staff
, user_isActive :: active
, user_dateJoined :: djoined
} deriving (Show)
mail staff active djoined =
UserDB { user_id :: id
, user_password :: pass
, user_lastLogin :: llogin
, user_isSuperUser :: suser
, user_username :: uname
, user_firstName :: fname
, user_lastName :: lname
, user_email :: mail
, user_isStaff :: staff
, user_isActive :: active
, user_dateJoined :: djoined
} deriving (Show)
type UserWrite = UserPoly (Maybe (Column PGInt4)) (Column PGText)
(Maybe (Column PGTimestamptz)) (Column PGBool)
......
src/Gargantext/Text/List.hs
View file @ 4264b3ae
......@@ -131,6 +131,9 @@ buildNgramsTermsList' uCid groupIt stop gls is = do
pure $ Map.fromList [(NgramsTerms, ngs')]
-}
buildNgramsTermsList :: Lang
-> Int
-> Int
......@@ -152,8 +155,8 @@ buildNgramsTermsList l n m s uCid mCid = do
termList =
-- (toTermList a b ((isStopTerm s) . fst) candidatesHead)
(map (toList ((isStopTerm s) .fst) GraphTerm) candidatesHead)
<> (map (toList ((isStopTerm s) .fst) CandidateTerm) candidatesTail)
(map (toGargList ((isStopTerm s) .fst) GraphTerm) candidatesHead)
<> (map (toGargList ((isStopTerm s) .fst) CandidateTerm) candidatesTail)
ngs = List.concat $ map toNgramsElement termList
......@@ -167,8 +170,8 @@ toTermList :: Int
-> [(ListType, a)]
toTermList _ _ _ [] = []
toTermList a b stop ns = -- trace ("computing toTermList") $
map (toList stop CandidateTerm) xs
<> map (toList stop GraphTerm) ys
map (toGargList stop CandidateTerm) xs
<> map (toGargList stop GraphTerm) ys
<> toTermList a b stop zs
where
xs = take a ns
......@@ -194,8 +197,8 @@ toNgramsElement (listType, (_stem, (_score, setNgrams))) =
) children
toList :: (b -> Bool) -> ListType -> b -> (ListType, b)
toList stop l n = case stop n of
toGargList :: (b -> Bool) -> ListType -> b -> (ListType, b)
toGargList stop l n = case stop n of
True -> (StopTerm, n)
False -> (l, n)
......
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