Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
120
Issues
120
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
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
gargantext
haskell-gargantext
Commits
df4a810f
Commit
df4a810f
authored
Nov 10, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[ngrams] refactor some code related to getNgramsTable
parent
403e7324
Pipeline
#3369
passed with stage
in 92 minutes and 7 seconds
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
71 additions
and
46 deletions
+71
-46
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+71
-46
No files found.
src/Gargantext/API/Ngrams.hs
View file @
df4a810f
...
...
@@ -69,6 +69,9 @@ module Gargantext.API.Ngrams
,
tableNgramsPull
,
tableNgramsPut
,
getNgramsTable'
,
setNgramsTableScores
,
Version
,
Versioned
(
..
)
,
VersionedWithCount
(
..
)
...
...
@@ -576,25 +579,6 @@ getTableNgrams _nType nId tabType listId limit_ offset
inners
=
list
&
filter
(
selected_inner
rootsSet
)
---------------------------------------
setScores
::
forall
t
.
Each
t
t
NgramsElement
NgramsElement
=>
Bool
->
t
->
m
t
setScores
False
table
=
pure
table
setScores
True
table
=
do
let
ngrams_terms
=
table
^..
each
.
ne_ngrams
-- printDebug "ngrams_terms" ngrams_terms
t1
<-
getTime
occurrences
<-
getOccByNgramsOnlyFast
nId
listId
ngramsType
--printDebug "occurrences" occurrences
t2
<-
getTime
liftBase
$
hprint
stderr
(
"getTableNgrams/setScores #ngrams="
%
int
%
" time="
%
hasTime
%
"
\n
"
)
(
length
ngrams_terms
)
t1
t2
let
setOcc
ne
=
ne
&
ne_occurrences
.~
sumOf
(
at
(
ne
^.
ne_ngrams
)
.
_Just
)
occurrences
pure
$
table
&
each
%~
setOcc
---------------------------------------
-- lists <- catMaybes <$> listsWith userMaster
-- trace (show lists) $
...
...
@@ -602,56 +586,97 @@ getTableNgrams _nType nId tabType listId limit_ offset
let
scoresNeeded
=
needsScores
orderBy
tableMap1
<-
getNgramsTableMap
listId
ngramsType
t1
<-
getTime
tableMap2
<-
tableMap1
&
v_data
%%~
setScores
scoresNeeded
.
Map
.
mapWithKey
ngramsElementFromRepo
tableMap2
<-
getNgramsTable'
nId
listId
ngramsType
orderBy
-- TODO Refactor: `fltr` and `tableMap3` use very similar functions
let
fmapScores
=
fmap
NgramsTable
.
(
setNgramsTableScores
nId
listId
ngramsType
(
not
scoresNeeded
))
fltr
<-
tableMap2
&
v_data
%%~
fmap
NgramsTable
.
setScores
(
not
scoresNeeded
)
.
filteredNodes
fltr
<-
tableMap2
&
v_data
%%~
fmapScores
.
filteredNodes
let
fltrCount
=
length
$
fltr
^.
v_data
.
_NgramsTable
t2
<-
getTime
tableMap3
<-
tableMap2
&
v_data
%%~
fmap
NgramsTable
.
setScores
(
not
scoresNeeded
)
.
selectAndPaginate
tableMap3
<-
tableMap2
&
v_data
%%~
fmapScores
.
selectAndPaginate
t3
<-
getTime
liftBase
$
hprint
stderr
(
"getTableNgrams total="
%
hasTime
%
" map1="
%
hasTime
%
" map2="
%
hasTime
%
" map3="
%
hasTime
%
" sql="
%
(
if
scoresNeeded
then
"map2"
else
"map3"
)
%
"
\n
"
)
t0
t3
t0
t1
t1
t2
t2
t3
liftBase
$
do
hprint
stderr
(
"getTableNgrams total="
%
hasTime
%
" map1="
%
hasTime
%
" map2="
%
hasTime
%
" map3="
%
hasTime
%
" sql="
%
(
if
scoresNeeded
then
"map2"
else
"map3"
)
%
"
\n
"
)
t0
t3
t0
t1
t1
t2
t2
t3
-- printDebug "[getTableNgrams] tableMap3" $ show tableMap3
pure
$
toVersionedWithCount
fltrCount
tableMap3
getNgramsTable'
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
NodeId
->
ListId
->
TableNgrams
.
NgramsType
->
Maybe
OrderBy
->
m
(
Versioned
(
Map
.
Map
NgramsTerm
NgramsElement
))
getNgramsTable'
nId
listId
ngramsType
orderBy
=
do
let
scoresNeeded
=
needsScores
orderBy
tableMap1
<-
getNgramsTableMap
listId
ngramsType
tableMap1
&
v_data
%%~
(
setNgramsTableScores
nId
listId
ngramsType
scoresNeeded
)
.
Map
.
mapWithKey
ngramsElementFromRepo
---------------------------------------
setNgramsTableScores
::
forall
env
err
m
t
.
(
Each
t
t
NgramsElement
NgramsElement
,
HasNodeStory
env
err
m
,
HasNodeError
err
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
NodeId
->
ListId
->
TableNgrams
.
NgramsType
->
Bool
->
t
->
m
t
setNgramsTableScores
_
_
_
False
table
=
pure
table
setNgramsTableScores
nId
listId
ngramsType
True
table
=
do
let
ngrams_terms
=
table
^..
each
.
ne_ngrams
-- printDebug "ngrams_terms" ngrams_terms
t1
<-
getTime
occurrences
<-
getOccByNgramsOnlyFast
nId
listId
ngramsType
--printDebug "occurrences" occurrences
t2
<-
getTime
liftBase
$
hprint
stderr
(
"getTableNgrams/setScores #ngrams="
%
int
%
" time="
%
hasTime
%
"
\n
"
)
(
length
ngrams_terms
)
t1
t2
let
setOcc
ne
=
ne
&
ne_occurrences
.~
sumOf
(
at
(
ne
^.
ne_ngrams
)
.
_Just
)
occurrences
pure
$
table
&
each
%~
setOcc
scoresRecomputeTableNgrams
::
forall
env
err
m
.
(
HasNodeStory
env
err
m
,
HasNodeError
err
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
NodeId
->
TabType
->
ListId
->
m
Int
scoresRecomputeTableNgrams
nId
tabType
listId
=
do
tableMap
<-
getNgramsTableMap
listId
ngramsType
_
<-
tableMap
&
v_data
%%~
setScores
_
<-
tableMap
&
v_data
%%~
(
setNgramsTableScores
nId
listId
ngramsType
True
)
.
Map
.
mapWithKey
ngramsElementFromRepo
pure
$
1
where
ngramsType
=
ngramsTypeFromTabType
tabType
setScores
::
forall
t
.
Each
t
t
NgramsElement
NgramsElement
=>
t
->
m
t
setScores
table
=
do
occurrences
<-
getOccByNgramsOnlyFast
nId
listId
ngramsType
let
setOcc
ne
=
ne
&
ne_occurrences
.~
sumOf
(
at
(
ne
^.
ne_ngrams
)
.
_Just
)
occurrences
pure
$
table
&
each
%~
setOcc
-- APIs
...
...
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