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
150
Issues
150
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
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
12dd69a3
Commit
12dd69a3
authored
Jan 19, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] insertion is ok now.
parent
97edf05f
Changes
3
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
22 additions
and
14 deletions
+22
-14
List.hs
src/Gargantext/Core/Text/List.hs
+13
-7
WithStem.hs
src/Gargantext/Core/Text/List/Group/WithStem.hs
+3
-1
NgramsPostag.hs
src/Gargantext/Database/Query/Table/NgramsPostag.hs
+6
-6
No files found.
src/Gargantext/Core/Text/List.hs
View file @
12dd69a3
...
...
@@ -17,6 +17,7 @@ module Gargantext.Core.Text.List
import
Control.Lens
hiding
(
both
)
-- ((^.), view, over, set, (_1), (_2))
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashSet
(
HashSet
)
import
Data.Map
(
Map
)
import
Data.Monoid
(
mempty
)
import
Data.Ord
(
Down
(
..
))
...
...
@@ -36,6 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, ge
import
Gargantext.Database.Action.Metrics.TFICF
(
getTficf
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Prelude
(
CmdM
)
import
Gargantext.Database.Query.Table.Ngrams
(
text2ngrams
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.NgramsPostag
(
selectLems
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
())
...
...
@@ -47,6 +49,7 @@ import qualified Data.List as List
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Gargantext.Data.HashMap.Strict.Utils
as
HashMap
import
qualified
Data.HashSet
as
HashSet
{-
-- TODO maybe useful for later
...
...
@@ -138,9 +141,10 @@ getGroupParams :: ( HasNodeError err
,
RepoCmdM
env
err
m
,
HasTreeError
err
)
=>
GroupParams
->
Set
Ngrams
->
m
GroupParams
=>
GroupParams
->
Hash
Set
Ngrams
->
m
GroupParams
getGroupParams
gp
@
(
GroupWithPosTag
l
a
_m
)
ng
=
do
hashMap
<-
HashMap
.
fromList
<$>
selectLems
l
a
(
Set
.
toList
ng
)
hashMap
<-
HashMap
.
fromList
<$>
selectLems
l
a
(
HashSet
.
toList
ng
)
printDebug
"hashMap"
hashMap
pure
$
over
gwl_map
(
\
x
->
x
<>
hashMap
)
gp
getGroupParams
gp
_
=
pure
gp
...
...
@@ -172,9 +176,11 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
$
List
.
zip
(
HashMap
.
keys
allTerms
)
(
List
.
cycle
[
mempty
])
)
let
ngramsKeys
=
HashMap
.
keysSet
allTerms
let
socialLists_Stemmed
=
addScoreStem
groupParams
(
HashMap
.
keysSet
allTerms
)
socialLists
printDebug
"socialLists_Stemmed"
socialLists_Stemmed
groupParams'
<-
getGroupParams
groupParams
(
HashSet
.
map
(
text2ngrams
.
unNgramsTerm
)
ngramsKeys
)
let
socialLists_Stemmed
=
addScoreStem
groupParams'
ngramsKeys
socialLists
--printDebug "socialLists_Stemmed" socialLists_Stemmed
let
groupedWithList
=
toGroupedTree
socialLists_Stemmed
allTerms
(
stopTerms
,
candidateTerms
)
=
HashMap
.
partition
((
==
Just
StopTerm
)
.
viewListType
)
$
view
flc_scores
groupedWithList
...
...
src/Gargantext/Core/Text/List/Group/WithStem.hs
View file @
12dd69a3
...
...
@@ -77,12 +77,14 @@ groupWith (GroupParams l _m _n _) t =
$
Text
.
intercalate
" "
$
map
(
stem
l
)
-- . take n
$
List
.
sort
$
Set
.
toList
$
Set
.
fromList
-- . (List.filter (\t -> Text.length t > m))
$
Text
.
splitOn
" "
$
Text
.
replace
"-"
" "
$
unNgramsTerm
t
-- | This lemmatization group done with CoreNLP algo (or others)
groupWith
(
GroupWithPosTag
_
_
m
)
t
=
case
HashMap
.
lookup
(
unNgramsTerm
t
)
m
of
Nothing
->
t
...
...
src/Gargantext/Database/Query/Table/NgramsPostag.hs
View file @
12dd69a3
...
...
@@ -72,14 +72,14 @@ insertNgramsPostag xs =
let
(
ns
,
nps
)
=
List
.
partition
(
\
np
->
np
^.
np_form
.
ngramsTerms
/
=
np
^.
np_lem
.
ngramsTerms
=
=
np
^.
np_lem
.
ngramsTerms
)
xs
ns'
<-
insertNgrams
(
map
(
view
np_form
)
ns
)
nps'
<-
HashMap
.
fromList
<$>
map
(
\
(
Indexed
t
i
)
->
(
t
,
i
))
<$>
insertNgramsPostag'
(
map
toInsert
ns
)
<$>
insertNgramsPostag'
(
map
toInsert
n
p
s
)
pure
$
HashMap
.
union
ns'
nps'
...
...
@@ -134,13 +134,13 @@ queryInsertNgramsPostag = [sql|
------------------------------------------------
, ins_postag AS (
INSERT INTO ngrams_postag (lang_id, algo_id, postag, ngrams_id, lemm_id,score)
SELECT ir.lang_id, ir.algo_id, ir.postag, form.id, lem.id, count(*) as s
SELECT ir.lang_id, ir.algo_id, ir.postag, form.id, lem.id,
1 --
count(*) as s
FROM input_rows ir
JOIN ins_form_ret form ON form.terms = ir.form
JOIN ins_lem_ret lem ON lem.terms = ir.lem
GROUP BY ir.lang_id, ir.algo_id, ir.postag, form.id, lem.id
ORDER BY s DESC
LIMIT 1
--
GROUP BY ir.lang_id, ir.algo_id, ir.postag, form.id, lem.id
--
ORDER BY s DESC
--
LIMIT 1
ON CONFLICT (lang_id,algo_id,postag,ngrams_id,lemm_id)
DO UPDATE SET score = ngrams_postag.score + 1
)
...
...
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