Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
haskell-gargantext
Commits
04da4749
Commit
04da4749
authored
Jan 10, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Requests with Contexts (WIP)
parent
51152a29
Changes
10
Show whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
106 additions
and
108 deletions
+106
-108
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+1
-1
List.hs
src/Gargantext/API/Ngrams/List.hs
+1
-1
Export.hs
src/Gargantext/API/Node/Corpus/Export.hs
+2
-2
List.hs
src/Gargantext/Core/Text/List.hs
+3
-3
Chart.hs
src/Gargantext/Core/Viz/Chart.hs
+4
-4
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+2
-2
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+2
-2
Metrics.hs
src/Gargantext/Database/Action/Metrics.hs
+2
-2
NgramsByContext.hs
src/Gargantext/Database/Action/Metrics/NgramsByContext.hs
+85
-87
TFICF.hs
src/Gargantext/Database/Action/Metrics/TFICF.hs
+4
-4
No files found.
src/Gargantext/API/Ngrams.hs
View file @
04da4749
...
...
@@ -103,7 +103,7 @@ import Gargantext.Core.Mail.Types (HasMail)
import
Gargantext.Core.Types
(
ListType
(
..
),
NodeId
,
ListId
,
DocId
,
Limit
,
Offset
,
TODO
,
assertValid
,
HasInvalidError
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getOccByNgramsOnlyFast'
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getOccByNgramsOnlyFast'
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
..
))
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
...
...
src/Gargantext/API/Ngrams/List.hs
View file @
04da4749
...
...
@@ -36,7 +36,7 @@ import Gargantext.Core.Text.Terms.WithList (buildPatterns, termsInText)
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Database.Action.Flow
(
saveDocNgramsWith
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getOccByNgramsOnlyFast'
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getOccByNgramsOnlyFast'
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Query.Table.NodeNode
(
selectDocNodes
)
...
...
src/Gargantext/API/Node/Corpus/Export.hs
View file @
04da4749
...
...
@@ -32,7 +32,7 @@ import Gargantext.API.Prelude (GargNoServer)
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
Gargantext.Core.Types
import
Gargantext.Core.NodeStory
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getNgramsByNode
OnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getNgramsByContext
OnlyUser
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Prelude
(
Cmd
)
...
...
@@ -94,7 +94,7 @@ getNodeNgrams cId lId nt repo = do
lIds
<-
selectNodesWithUsername
NodeList
userMaster
let
ngs
=
filterListWithRoot
MapTerm
$
mapTermListRoot
[
lId
]
nt
repo
-- TODO HashMap
r
<-
getNgramsBy
Node
OnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
r
<-
getNgramsBy
Context
OnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
pure
r
-- TODO
...
...
src/Gargantext/Core/Text/List.hs
View file @
04da4749
...
...
@@ -34,7 +34,7 @@ import Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.Metrics
(
scored'
,
Scored
(
..
),
scored_speExc
,
scored_genInc
,
normalizeGlobal
,
normalizeLocal
,
scored_terms
)
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getNodesByNgramsUser
,
getNode
sByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getContextsByNgramsUser
,
getContext
sByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.TFICF
(
getTficf_withSample
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Prelude
(
CmdM
)
...
...
@@ -98,7 +98,7 @@ buildNgramsOthersList :: ( HasNodeError err
->
(
NgramsType
,
MapListSize
)
->
m
(
Map
NgramsType
[
NgramsElement
])
buildNgramsOthersList
user
uCid
mfslw
_groupParams
(
nt
,
MapListSize
mapListSize
)
=
do
allTerms
::
HashMap
NgramsTerm
(
Set
NodeId
)
<-
get
Node
sByNgramsUser
uCid
nt
allTerms
::
HashMap
NgramsTerm
(
Set
NodeId
)
<-
get
Context
sByNgramsUser
uCid
nt
-- PrivateFirst for first developments since Public NodeMode is not implemented yet
socialLists
::
FlowCont
NgramsTerm
FlowListScores
...
...
@@ -212,7 +212,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, _mapListSize)= do
userListId
<-
defaultList
uCid
masterListId
<-
defaultList
mCid
mapTextDocIds
<-
get
Node
sByNgramsOnlyUser
uCid
mapTextDocIds
<-
get
Context
sByNgramsOnlyUser
uCid
[
userListId
,
masterListId
]
nt
selectedTerms
...
...
src/Gargantext/Core/Viz/Chart.hs
View file @
04da4749
...
...
@@ -36,7 +36,7 @@ import Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Core.Viz.Types
import
qualified
Data.HashMap.Strict
as
HashMap
...
...
@@ -67,8 +67,8 @@ chartData cId nt lt = do
Nothing
->
x
Just
x'
->
maybe
x
identity
x'
(
_total
,
mapTerms
)
<-
count
Node
sByNgramsWith
(
group
dico
)
<$>
get
Node
sByNgramsOnlyUser
cId
(
ls'
<>
ls
)
nt
terms
(
_total
,
mapTerms
)
<-
count
Context
sByNgramsWith
(
group
dico
)
<$>
get
Context
sByNgramsOnlyUser
cId
(
ls'
<>
ls
)
nt
terms
let
(
dates
,
count
)
=
V
.
unzip
$
V
.
fromList
$
List
.
sortOn
snd
$
...
...
@@ -89,7 +89,7 @@ treeData cId nt lt = do
dico
=
filterListWithRoot
lt
ts
terms
=
catMaybes
$
List
.
concat
$
map
(
\
(
a
,
b
)
->
[
Just
a
,
b
])
$
HashMap
.
toList
dico
cs'
<-
get
Node
sByNgramsOnlyUser
cId
(
ls'
<>
ls
)
nt
terms
cs'
<-
get
Context
sByNgramsOnlyUser
cId
(
ls'
<>
ls
)
nt
terms
m
<-
getListNgrams
ls
nt
pure
$
V
.
fromList
$
toTree
lt
cs'
m
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
04da4749
...
...
@@ -31,7 +31,7 @@ import Gargantext.Core.Types.Main
import
Gargantext.Core.Viz.Graph
import
Gargantext.Core.Viz.Graph.GEXF
()
import
Gargantext.Core.Viz.Graph.Tools
-- (cooc2graph)
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getNode
sByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getContext
sByNgramsOnlyUser
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
import
Gargantext.Database.Admin.Config
...
...
@@ -179,7 +179,7 @@ computeGraph cId d nt repo = do
-- <$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False)
<$>
getCoocByNgrams
(
Diagonal
True
)
<$>
groupNodesByNgrams
ngs
<$>
get
Node
sByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
<$>
get
Context
sByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
-- printDebug "myCooc" myCooc
-- saveAsFileDebug "debug/my-cooc" myCooc
...
...
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
04da4749
...
...
@@ -28,7 +28,7 @@ import Gargantext.Core
import
Gargantext.Core.Types
(
TableResult
(
..
))
import
Gargantext.Core.Types.Main
import
Gargantext.Database
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getNode
sByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getContext
sByNgramsOnlyUser
)
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Types.Hyperdata
-- (HyperdataContact(..))
import
Gargantext.Database.Admin.Types.Node
-- (AnnuaireId, CorpusId, ListId, DocId, ContactId, NodeId)
...
...
@@ -190,4 +190,4 @@ getNgramsDocId cId lId nt = do
let
ngs
=
filterListWithRoot
MapTerm
$
mapTermListRoot
[
lId
]
nt
repo
groupNodesByNgrams
ngs
<$>
get
Node
sByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
<$>
get
Context
sByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
src/Gargantext/Database/Action/Metrics.hs
View file @
04da4749
...
...
@@ -22,7 +22,7 @@ import Gargantext.Core.Mail.Types (HasMail)
import
Gargantext.Core.Types
(
ListType
(
..
),
Limit
,
NodeType
(
..
))
import
Gargantext.Core.NodeStory
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getNode
sByNgramsOnlyUser
{-, getTficfWith-}
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getContext
sByNgramsOnlyUser
{-, getTficfWith-}
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Node
(
ListId
,
CorpusId
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
...
...
@@ -57,7 +57,7 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
myCooc
<-
HM
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
True
)
<$>
groupNodesByNgrams
ngs
<$>
get
Node
sByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
(
ngramsTypeFromTabType
tabType
)
<$>
get
Context
sByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
(
ngramsTypeFromTabType
tabType
)
(
take'
maybeLimit
$
HM
.
keys
ngs
)
pure
$
(
ngs'
,
ngs
,
myCooc
)
...
...
src/Gargantext/Database/Action/Metrics/NgramsBy
Node
.hs
→
src/Gargantext/Database/Action/Metrics/NgramsBy
Context
.hs
View file @
04da4749
{-|
Module : Gargantext.Database.Metrics.NgramsBy
Node
Module : Gargantext.Database.Metrics.NgramsBy
Context
Description : Ngrams by Node user and master
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
...
...
@@ -13,7 +13,7 @@ Ngrams by node enable contextual metrics.
{-# LANGUAGE QuasiQuotes #-}
module
Gargantext.Database.Action.Metrics.NgramsBy
Node
module
Gargantext.Database.Action.Metrics.NgramsBy
Context
where
--import Data.Map.Strict.Patch (PatchMap, Replace, diff)
...
...
@@ -39,39 +39,39 @@ import qualified Database.PostgreSQL.Simple as DPS
-- | fst is size of Supra Corpus
-- snd is Texts and size of Occurrences (different docs)
count
Node
sByNgramsWith
::
(
NgramsTerm
->
NgramsTerm
)
->
HashMap
NgramsTerm
(
Set
Node
Id
)
count
Context
sByNgramsWith
::
(
NgramsTerm
->
NgramsTerm
)
->
HashMap
NgramsTerm
(
Set
Context
Id
)
->
(
Double
,
HashMap
NgramsTerm
(
Double
,
Set
NgramsTerm
))
count
Node
sByNgramsWith
f
m
=
(
total
,
m'
)
count
Context
sByNgramsWith
f
m
=
(
total
,
m'
)
where
total
=
fromIntegral
$
Set
.
size
$
Set
.
unions
$
HM
.
elems
m
m'
=
HM
.
map
(
swap
.
second
(
fromIntegral
.
Set
.
size
))
$
group
Node
sByNgramsWith
f
m
$
group
Context
sByNgramsWith
f
m
group
Node
sByNgramsWith
::
(
NgramsTerm
->
NgramsTerm
)
group
Context
sByNgramsWith
::
(
NgramsTerm
->
NgramsTerm
)
->
HashMap
NgramsTerm
(
Set
NodeId
)
->
HashMap
NgramsTerm
(
Set
NgramsTerm
,
Set
Node
Id
)
group
Node
sByNgramsWith
f
m
=
->
HashMap
NgramsTerm
(
Set
NgramsTerm
,
Set
Context
Id
)
group
Context
sByNgramsWith
f
m
=
HM
.
fromListWith
(
<>
)
$
map
(
\
(
t
,
ns
)
->
(
f
t
,
(
Set
.
singleton
t
,
ns
)))
$
HM
.
toList
m
------------------------------------------------------------------------
get
Node
sByNgramsUser
::
HasDBid
NodeType
get
Context
sByNgramsUser
::
HasDBid
NodeType
=>
CorpusId
->
NgramsType
->
Cmd
err
(
HashMap
NgramsTerm
(
Set
Node
Id
))
get
Node
sByNgramsUser
cId
nt
=
->
Cmd
err
(
HashMap
NgramsTerm
(
Set
Context
Id
))
get
Context
sByNgramsUser
cId
nt
=
HM
.
fromListWith
(
<>
)
<$>
map
(
\
(
n
,
t
)
->
(
NgramsTerm
t
,
Set
.
singleton
n
))
<$>
selectNgramsBy
Node
User
cId
nt
<$>
selectNgramsBy
Context
User
cId
nt
where
selectNgramsBy
Node
User
::
HasDBid
NodeType
selectNgramsBy
Context
User
::
HasDBid
NodeType
=>
CorpusId
->
NgramsType
->
Cmd
err
[(
NodeId
,
Text
)]
selectNgramsBy
Node
User
cId'
nt'
=
runPGSQuery
queryNgramsBy
Node
User
selectNgramsBy
Context
User
cId'
nt'
=
runPGSQuery
queryNgramsBy
Context
User
(
cId'
,
toDBid
NodeDocument
,
ngramsTypeId
nt'
...
...
@@ -79,13 +79,13 @@ getNodesByNgramsUser cId nt =
-- , 0 :: Int -- offset
)
queryNgramsBy
Node
User
::
DPS
.
Query
queryNgramsBy
Node
User
=
[
sql
|
queryNgramsBy
Context
User
::
DPS
.
Query
queryNgramsBy
Context
User
=
[
sql
|
SELECT cng.node_id, ng.terms FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN nodes_
nodes nn ON nn.node2_id = cng.node
_id
JOIN
nodes n ON nn.node2
_id = n.id
WHERE nn.node
1
_id = ? -- CorpusId
JOIN nodes_
contexts nn ON nn.context_id = cng.context
_id
JOIN
contexts n ON nn.context
_id = n.id
WHERE nn.node_id = ? -- CorpusId
AND n.typename = ? -- toDBid
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
...
...
@@ -102,7 +102,7 @@ getOccByNgramsOnlyFast :: HasDBid NodeType
->
[
NgramsTerm
]
->
Cmd
err
(
HashMap
NgramsTerm
Int
)
getOccByNgramsOnlyFast
cId
nt
ngs
=
HM
.
fromListWith
(
+
)
<$>
selectNgramsOccurrencesOnlyBy
Node
User
cId
nt
ngs
HM
.
fromListWith
(
+
)
<$>
selectNgramsOccurrencesOnlyBy
Context
User
cId
nt
ngs
getOccByNgramsOnlyFast_withSample
::
HasDBid
NodeType
...
...
@@ -112,9 +112,7 @@ getOccByNgramsOnlyFast_withSample :: HasDBid NodeType
->
[
NgramsTerm
]
->
Cmd
err
(
HashMap
NgramsTerm
Int
)
getOccByNgramsOnlyFast_withSample
cId
int
nt
ngs
=
HM
.
fromListWith
(
+
)
<$>
selectNgramsOccurrencesOnlyByNodeUser_withSample
cId
int
nt
ngs
HM
.
fromListWith
(
+
)
<$>
selectNgramsOccurrencesOnlyByContextUser_withSample
cId
int
nt
ngs
getOccByNgramsOnlyFast'
::
CorpusId
...
...
@@ -165,9 +163,9 @@ getOccByNgramsOnlySlow :: HasDBid NodeType
getOccByNgramsOnlySlow
t
cId
ls
nt
ngs
=
HM
.
map
Set
.
size
<$>
getScore'
t
cId
ls
nt
ngs
where
getScore'
NodeCorpus
=
get
Node
sByNgramsOnlyUser
getScore'
NodeCorpus
=
get
Context
sByNgramsOnlyUser
getScore'
NodeDocument
=
getNgramsByDocOnlyUser
getScore'
_
=
get
Node
sByNgramsOnlyUser
getScore'
_
=
get
Context
sByNgramsOnlyUser
getOccByNgramsOnlySafe
::
HasDBid
NodeType
=>
CorpusId
...
...
@@ -186,14 +184,14 @@ getOccByNgramsOnlySafe cId ls nt ngs = do
pure
slow
selectNgramsOccurrencesOnlyBy
Node
User
::
HasDBid
NodeType
selectNgramsOccurrencesOnlyBy
Context
User
::
HasDBid
NodeType
=>
CorpusId
->
NgramsType
->
[
NgramsTerm
]
->
Cmd
err
[(
NgramsTerm
,
Int
)]
selectNgramsOccurrencesOnlyBy
Node
User
cId
nt
tms
=
selectNgramsOccurrencesOnlyBy
Context
User
cId
nt
tms
=
fmap
(
first
NgramsTerm
)
<$>
runPGSQuery
queryNgramsOccurrencesOnlyBy
Node
User
runPGSQuery
queryNgramsOccurrencesOnlyBy
Context
User
(
Values
fields
((
DPS
.
Only
.
unNgramsTerm
)
<$>
tms
)
,
cId
,
toDBid
NodeDocument
...
...
@@ -207,8 +205,8 @@ selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
-- same as queryNgramsOnlyByNodeUser but using COUNT on the node ids.
-- Question: with the grouping is the result exactly the same (since Set NodeId for
-- equivalent ngrams intersections are not empty)
queryNgramsOccurrencesOnlyBy
Node
User
::
DPS
.
Query
queryNgramsOccurrencesOnlyBy
Node
User
=
[
sql
|
queryNgramsOccurrencesOnlyBy
Context
User
::
DPS
.
Query
queryNgramsOccurrencesOnlyBy
Context
User
=
[
sql
|
WITH input_rows(terms) AS (?)
SELECT ng.terms, COUNT(cng.node_id) FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
...
...
@@ -223,15 +221,15 @@ queryNgramsOccurrencesOnlyByNodeUser = [sql|
|]
selectNgramsOccurrencesOnlyBy
Node
User_withSample
::
HasDBid
NodeType
selectNgramsOccurrencesOnlyBy
Context
User_withSample
::
HasDBid
NodeType
=>
CorpusId
->
Int
->
NgramsType
->
[
NgramsTerm
]
->
Cmd
err
[(
NgramsTerm
,
Int
)]
selectNgramsOccurrencesOnlyBy
Node
User_withSample
cId
int
nt
tms
=
selectNgramsOccurrencesOnlyBy
Context
User_withSample
cId
int
nt
tms
=
fmap
(
first
NgramsTerm
)
<$>
runPGSQuery
queryNgramsOccurrencesOnlyBy
Node
User_withSample
runPGSQuery
queryNgramsOccurrencesOnlyBy
Context
User_withSample
(
int
,
toDBid
NodeDocument
,
cId
...
...
@@ -242,8 +240,8 @@ selectNgramsOccurrencesOnlyByNodeUser_withSample cId int nt tms =
where
fields
=
[
QualifiedIdentifier
Nothing
"text"
]
queryNgramsOccurrencesOnlyBy
Node
User_withSample
::
DPS
.
Query
queryNgramsOccurrencesOnlyBy
Node
User_withSample
=
[
sql
|
queryNgramsOccurrencesOnlyBy
Context
User_withSample
::
DPS
.
Query
queryNgramsOccurrencesOnlyBy
Context
User_withSample
=
[
sql
|
WITH nodes_sample AS (SELECT id FROM nodes n TABLESAMPLE SYSTEM_ROWS (?)
JOIN nodes_nodes nn ON n.id = nn.node2_id
WHERE n.typename = ?
...
...
@@ -262,8 +260,8 @@ queryNgramsOccurrencesOnlyByNodeUser_withSample = [sql|
queryNgramsOccurrencesOnlyBy
Node
User'
::
DPS
.
Query
queryNgramsOccurrencesOnlyBy
Node
User'
=
[
sql
|
queryNgramsOccurrencesOnlyBy
Context
User'
::
DPS
.
Query
queryNgramsOccurrencesOnlyBy
Context
User'
=
[
sql
|
WITH input_rows(terms) AS (?)
SELECT ng.terms, COUNT(cng.node_id) FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
...
...
@@ -278,45 +276,45 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql|
|]
------------------------------------------------------------------------
get
Node
sByNgramsOnlyUser
::
HasDBid
NodeType
get
Context
sByNgramsOnlyUser
::
HasDBid
NodeType
=>
CorpusId
->
[
ListId
]
->
NgramsType
->
[
NgramsTerm
]
->
Cmd
err
(
HashMap
NgramsTerm
(
Set
NodeId
))
get
Node
sByNgramsOnlyUser
cId
ls
nt
ngs
=
get
Context
sByNgramsOnlyUser
cId
ls
nt
ngs
=
HM
.
unionsWith
(
<>
)
.
map
(
HM
.
fromListWith
(
<>
)
.
map
(
second
Set
.
singleton
))
<$>
mapM
(
selectNgramsOnlyBy
Node
User
cId
ls
nt
)
<$>
mapM
(
selectNgramsOnlyBy
Context
User
cId
ls
nt
)
(
splitEvery
1000
ngs
)
getNgramsBy
Node
OnlyUser
::
HasDBid
NodeType
getNgramsBy
Context
OnlyUser
::
HasDBid
NodeType
=>
NodeId
->
[
ListId
]
->
NgramsType
->
[
NgramsTerm
]
->
Cmd
err
(
Map
NodeId
(
Set
NgramsTerm
))
getNgramsBy
Node
OnlyUser
cId
ls
nt
ngs
=
getNgramsBy
Context
OnlyUser
cId
ls
nt
ngs
=
Map
.
unionsWith
(
<>
)
.
map
(
Map
.
fromListWith
(
<>
)
.
map
(
second
Set
.
singleton
)
)
.
map
(
map
swap
)
<$>
mapM
(
selectNgramsOnlyBy
Node
User
cId
ls
nt
)
<$>
mapM
(
selectNgramsOnlyBy
Context
User
cId
ls
nt
)
(
splitEvery
1000
ngs
)
------------------------------------------------------------------------
selectNgramsOnlyBy
Node
User
::
HasDBid
NodeType
selectNgramsOnlyBy
Context
User
::
HasDBid
NodeType
=>
CorpusId
->
[
ListId
]
->
NgramsType
->
[
NgramsTerm
]
->
Cmd
err
[(
NgramsTerm
,
NodeId
)]
selectNgramsOnlyBy
Node
User
cId
ls
nt
tms
=
selectNgramsOnlyBy
Context
User
cId
ls
nt
tms
=
fmap
(
first
NgramsTerm
)
<$>
runPGSQuery
queryNgramsOnlyBy
Node
User
runPGSQuery
queryNgramsOnlyBy
Context
User
(
Values
fields
((
DPS
.
Only
.
unNgramsTerm
)
<$>
tms
)
,
Values
[
QualifiedIdentifier
Nothing
"int4"
]
(
DPS
.
Only
<$>
(
map
(
\
(
NodeId
n
)
->
n
)
ls
))
...
...
@@ -327,17 +325,17 @@ selectNgramsOnlyByNodeUser cId ls nt tms =
where
fields
=
[
QualifiedIdentifier
Nothing
"text"
]
queryNgramsOnlyBy
Node
User
::
DPS
.
Query
queryNgramsOnlyBy
Node
User
=
[
sql
|
queryNgramsOnlyBy
Context
User
::
DPS
.
Query
queryNgramsOnlyBy
Context
User
=
[
sql
|
WITH input_rows(terms) AS (?),
input_list(id) AS (?)
SELECT ng.terms, cng.node_id FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN input_list il ON il.id = cng.context_id
JOIN nodes_
nodes nn ON nn.node2_id = cng.node
_id
JOIN
nodes n ON nn.node2
_id = n.id
WHERE nn.node
1_id
= ? -- CorpusId
JOIN nodes_
contexts nn ON nn.context_id = cng.context
_id
JOIN
contexts n ON nn.context
_id = n.id
WHERE nn.node
_id
= ? -- CorpusId
AND n.typename = ? -- toDBid
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
...
...
@@ -345,14 +343,14 @@ queryNgramsOnlyByNodeUser = [sql|
|]
selectNgramsOnlyBy
Node
User'
::
HasDBid
NodeType
selectNgramsOnlyBy
Context
User'
::
HasDBid
NodeType
=>
CorpusId
->
[
ListId
]
->
NgramsType
->
[
Text
]
->
Cmd
err
[(
Text
,
Int
)]
selectNgramsOnlyBy
Node
User'
cId
ls
nt
tms
=
runPGSQuery
queryNgramsOnlyBy
Node
User
selectNgramsOnlyBy
Context
User'
cId
ls
nt
tms
=
runPGSQuery
queryNgramsOnlyBy
Context
User
(
Values
fields
(
DPS
.
Only
<$>
tms
)
,
Values
[
QualifiedIdentifier
Nothing
"int4"
]
(
DPS
.
Only
<$>
(
map
(
\
(
NodeId
n
)
->
n
)
ls
))
...
...
@@ -363,8 +361,8 @@ selectNgramsOnlyByNodeUser' cId ls nt tms =
where
fields
=
[
QualifiedIdentifier
Nothing
"text"
]
queryNgramsOnlyBy
Node
User'
::
DPS
.
Query
queryNgramsOnlyBy
Node
User'
=
[
sql
|
queryNgramsOnlyBy
Context
User'
::
DPS
.
Query
queryNgramsOnlyBy
Context
User'
=
[
sql
|
WITH input_rows(terms) AS (?),
input_list(id) AS (?)
SELECT ng.terms, cng.weight FROM context_node_ngrams cng
...
...
@@ -422,22 +420,22 @@ queryNgramsOnlyByDocUser = [sql|
------------------------------------------------------------------------
-- | TODO filter by language, database, any social field
get
Node
sByNgramsMaster
::
HasDBid
NodeType
get
Context
sByNgramsMaster
::
HasDBid
NodeType
=>
UserCorpusId
->
MasterCorpusId
->
Cmd
err
(
HashMap
Text
(
Set
NodeId
))
get
Node
sByNgramsMaster
ucId
mcId
=
unionsWith
(
<>
)
get
Context
sByNgramsMaster
ucId
mcId
=
unionsWith
(
<>
)
.
map
(
HM
.
fromListWith
(
<>
)
.
map
(
\
(
n
,
t
)
->
(
t
,
Set
.
singleton
n
)))
-- . takeWhile (not . List.null)
-- . takeWhile (\l -> List.length l > 3)
<$>
mapM
(
selectNgramsBy
Node
Master
1000
ucId
mcId
)
[
0
,
500
..
10000
]
<$>
mapM
(
selectNgramsBy
Context
Master
1000
ucId
mcId
)
[
0
,
500
..
10000
]
selectNgramsBy
Node
Master
::
HasDBid
NodeType
selectNgramsBy
Context
Master
::
HasDBid
NodeType
=>
Int
->
UserCorpusId
->
MasterCorpusId
->
Int
->
Cmd
err
[(
NodeId
,
Text
)]
selectNgramsBy
Node
Master
n
ucId
mcId
p
=
runPGSQuery
queryNgramsBy
Node
Master'
selectNgramsBy
Context
Master
n
ucId
mcId
p
=
runPGSQuery
queryNgramsBy
Context
Master'
(
ucId
,
ngramsTypeId
NgramsTerms
,
toDBid
NodeDocument
...
...
@@ -451,15 +449,15 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
)
-- | TODO fix context_node_ngrams relation
queryNgramsBy
Node
Master'
::
DPS
.
Query
queryNgramsBy
Node
Master'
=
[
sql
|
WITH
node
sByNgramsUser AS (
queryNgramsBy
Context
Master'
::
DPS
.
Query
queryNgramsBy
Context
Master'
=
[
sql
|
WITH
context
sByNgramsUser AS (
SELECT n.id, ng.terms FROM
node
s n
JOIN nodes_
nodes nn ON n.id = nn.node2
_id
JOIN context_node_ngrams cng ON cng.
node
_id = n.id
SELECT n.id, ng.terms FROM
context
s n
JOIN nodes_
contexts nn ON n.id = nn.context
_id
JOIN context_node_ngrams cng ON cng.
context
_id = n.id
JOIN ngrams ng ON cng.ngrams_id = ng.id
WHERE nn.node
1_id
= ? -- UserCorpusId
WHERE nn.node
_id
= ? -- UserCorpusId
-- AND n.typename = ? -- toDBid
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
...
...
@@ -469,10 +467,10 @@ queryNgramsByNodeMaster' = [sql|
),
node
sByNgramsMaster AS (
context
sByNgramsMaster AS (
SELECT n.id, ng.terms FROM
node
s n TABLESAMPLE SYSTEM_ROWS(?)
JOIN context_node_ngrams cng ON n.id = cng.
node
_id
SELECT n.id, ng.terms FROM
context
s n TABLESAMPLE SYSTEM_ROWS(?)
JOIN context_node_ngrams cng ON n.id = cng.
context
_id
JOIN ngrams ng ON ng.id = cng.ngrams_id
WHERE n.parent_id = ? -- Master Corpus toDBid
...
...
@@ -482,5 +480,5 @@ queryNgramsByNodeMaster' = [sql|
)
SELECT m.id, m.terms FROM nodesByNgramsMaster m
RIGHT JOIN
node
sByNgramsUser u ON u.id = m.id
RIGHT JOIN
context
sByNgramsUser u ON u.id = m.id
|]
src/Gargantext/Database/Action/Metrics/TFICF.hs
View file @
04da4749
...
...
@@ -21,10 +21,10 @@ import qualified Data.HashMap.Strict as HM
import
Data.Maybe
(
fromMaybe
)
import
Gargantext.Core
import
Gargantext.Core.Text.Metrics.TFICF
import
Gargantext.Database.Action.Metrics.NgramsBy
Node
(
getNode
sByNgramsUser
,
getOccByNgramsOnlyFast
,
getOccByNgramsOnlyFast_withSample
)
import
Gargantext.Database.Action.Metrics.NgramsBy
Context
(
getContext
sByNgramsUser
,
getOccByNgramsOnlyFast
,
getOccByNgramsOnlyFast_withSample
)
import
Gargantext.Database.Admin.Types.Node
-- (ListId, CorpusId, NodeId)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Query.Table.Node
Node
(
selectCountDocs
)
import
Gargantext.Database.Query.Table.Node
Context
(
selectCountDocs
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.API.Ngrams.Types
import
Gargantext.Prelude
...
...
@@ -38,7 +38,7 @@ getTficf :: HasDBid NodeType
getTficf
cId
mId
nt
=
do
mapTextDoubleLocal
<-
HM
.
filter
(
>
1
)
<$>
HM
.
map
(
fromIntegral
.
Set
.
size
)
<$>
get
Node
sByNgramsUser
cId
nt
<$>
get
Context
sByNgramsUser
cId
nt
mapTextDoubleGlobal
<-
HM
.
map
fromIntegral
<$>
getOccByNgramsOnlyFast
mId
nt
(
HM
.
keys
mapTextDoubleLocal
)
...
...
@@ -62,7 +62,7 @@ getTficf_withSample :: HasDBid NodeType
getTficf_withSample
cId
mId
nt
=
do
mapTextDoubleLocal
<-
HM
.
filter
(
>
1
)
<$>
HM
.
map
(
fromIntegral
.
Set
.
size
)
<$>
get
Node
sByNgramsUser
cId
nt
<$>
get
Context
sByNgramsUser
cId
nt
countLocal
<-
selectCountDocs
cId
let
countGlobal
=
countLocal
*
10
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment