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
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
14
Merge Requests
14
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
ee1b45b3
Commit
ee1b45b3
authored
Sep 23, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] Backend NLP French tested
parent
91a63511
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
39 additions
and
34 deletions
+39
-34
backup
bin/backup
+1
-1
removeUnusedDocuments.sql
devops/postgres/tools/removeUnusedDocuments.sql
+8
-7
Core.hs
src/Gargantext/Core.hs
+4
-2
NodeStory.hs
src/Gargantext/Core/NodeStory.hs
+10
-6
Multi.hs
src/Gargantext/Core/Text/Terms/Multi.hs
+8
-8
PosTagging.hs
src/Gargantext/Core/Text/Terms/Multi/PosTagging.hs
+4
-6
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+4
-4
No files found.
bin/backup
View file @
ee1b45b3
...
...
@@ -3,7 +3,7 @@
# 0 3 * * * pg_dump --dbname=$MYDB | gzip > ~/backup/db/$(date +%Y-%m-%d).psql.gz
if
[[
$1
==
""
||
$2
==
""
]]
then
echo
"USAGE : ./
psql
gargantext.ini backup_directory"
then
echo
"USAGE : ./
bin/backup
gargantext.ini backup_directory"
else
INIFILE
=
$1
...
...
devops/postgres/tools/removeUnusedDocuments.sql
View file @
ee1b45b3
WITH
repeated
AS
(
select
nn
.
node2_id
AS
id
,
count
(
*
)
AS
c
FROM
nodes_nodes
nn
GROUP
BY
nn
.
node2_id
(
select
nn
.
context_id
AS
id
,
count
(
*
)
AS
c
FROM
nodes_contexts
nn
GROUP
BY
nn
.
context_id
)
DELETE
FROM
nodes
n
DELETE
FROM
contexts
c
USING
repeated
r
WHERE
n
.
id
=
r
.
id
AND
r
.
c
<
=
1
AND
n
.
typename
=
4
c
.
id
=
r
.
id
AND
r
.
c
=
1
AND
c
.
typename
=
4
;
src/Gargantext/Core.hs
View file @
ee1b45b3
...
...
@@ -77,15 +77,17 @@ instance HasDBid Lang where
type
Form
=
Text
type
Lem
=
Text
------------------------------------------------------------------------
data
PosTagAlgo
=
CoreNLP
|
JohnSnowServer
data
PosTagAlgo
=
CoreNLP
|
JohnSnowServer
|
Spacy
deriving
(
Show
,
Read
,
Eq
,
Ord
,
Generic
)
instance
Hashable
PosTagAlgo
instance
HasDBid
PosTagAlgo
where
toDBid
CoreNLP
=
1
toDBid
CoreNLP
=
1
toDBid
JohnSnowServer
=
2
toDBid
Spacy
=
3
fromDBid
1
=
CoreNLP
fromDBid
2
=
JohnSnowServer
fromDBid
3
=
Spacy
fromDBid
_
=
panic
"HasDBid posTagAlgo : Not implemented"
src/Gargantext/Core/NodeStory.hs
View file @
ee1b45b3
...
...
@@ -254,9 +254,7 @@ makeLenses ''NodeStoryEnv
makeLenses
''
N
odeStory
makeLenses
''
A
rchive
-----------------------------------------
----------------------------------------------------------------------
data
NodeStoryPoly
nid
v
ngtid
ngid
nre
=
NodeStoryDB
{
node_id
::
nid
,
version
::
v
...
...
@@ -614,14 +612,20 @@ readNodeStoryEnv pool = do
pure
$
NodeStoryEnv
{
_nse_var
=
mvar
,
_nse_saver
=
saver
,
_nse_saver_immediate
=
saver_immediate
,
_nse_getter
=
nodeStoryVar
pool
(
Just
mvar
)
}
,
_nse_getter
=
nodeStoryVar
pool
(
Just
mvar
)
}
nodeStoryVar
::
Pool
PGS
.
Connection
->
Maybe
(
MVar
NodeListStory
)
->
[
NodeId
]
->
IO
(
MVar
NodeListStory
)
nodeStoryVar
::
Pool
PGS
.
Connection
->
Maybe
(
MVar
NodeListStory
)
->
[
NodeId
]
->
IO
(
MVar
NodeListStory
)
nodeStoryVar
pool
Nothing
nIds
=
do
state
<-
withResource
pool
$
\
c
->
nodeStoryIncs
c
Nothing
nIds
newMVar
state
nodeStoryVar
pool
(
Just
mv
)
nIds
=
do
_
<-
withResource
pool
$
\
c
->
modifyMVar_
mv
$
\
nsl
->
(
nodeStoryIncs
c
(
Just
nsl
)
nIds
)
_
<-
withResource
pool
$
\
c
->
modifyMVar_
mv
$
\
nsl
->
(
nodeStoryIncs
c
(
Just
nsl
)
nIds
)
pure
mv
-- Debounce is useful since it could delay the saving to some later
...
...
src/Gargantext/Core/Text/Terms/Multi.hs
View file @
ee1b45b3
...
...
@@ -29,6 +29,7 @@ import qualified Gargantext.Core.Text.Terms.Multi.Lang.Fr as Fr
import
Gargantext.Core.Text.Terms.Multi.RAKE
(
multiterms_rake
)
-- import qualified Gargantext.Utils.JohnSnowNLP as JohnSnow
import
qualified
Gargantext.Utils.SpacyNLP
as
SpacyNLP
...
...
@@ -36,15 +37,14 @@ import qualified Gargantext.Utils.SpacyNLP as SpacyNLP
type
NLP_API
=
Lang
->
Text
->
IO
PosSentences
-------------------------------------------------------------------
-- To be removed
multiterms
::
Lang
->
Text
->
IO
[
Terms
]
multiterms
=
multiterms'
tokenTag2terms
multiterms'
::
(
TokenTag
->
a
)
->
Lang
->
Text
->
IO
[
a
]
multiterms'
f
lang
txt
=
concat
<$>
map
(
map
f
)
<$>
map
(
filter
(
\
t
->
_my_token_pos
t
==
Just
NP
))
<$>
tokenTags
lang
txt
where
multiterms'
::
(
TokenTag
->
a
)
->
Lang
->
Text
->
IO
[
a
]
multiterms'
f
lang
txt
=
concat
<$>
map
(
map
f
)
<$>
map
(
filter
(
\
t
->
_my_token_pos
t
==
Just
NP
))
<$>
tokenTags
lang
txt
-------------------------------------------------------------------
tokenTag2terms
::
TokenTag
->
Terms
...
...
@@ -53,7 +53,7 @@ tokenTag2terms (TokenTag ws t _ _) = Terms ws t
tokenTags
::
Lang
->
Text
->
IO
[[
TokenTag
]]
tokenTags
EN
txt
=
tokenTagsWith
EN
txt
corenlp
tokenTags
FR
txt
=
tokenTagsWith
FR
txt
SpacyNLP
.
nlp
tokenTags
_
_
=
panic
"[G.C.T.T.Multi] NLP API not implemented yet"
tokenTags
l
_
=
panic
$
"[G.C.T.T.Multi] Lang NLP API not implemented yet "
<>
(
cs
$
show
l
)
tokenTagsWith
::
Lang
->
Text
->
NLP_API
->
IO
[[
TokenTag
]]
tokenTagsWith
lang
txt
nlp
=
map
(
groupTokens
lang
)
...
...
src/Gargantext/Core/Text/Terms/Multi/PosTagging.hs
View file @
ee1b45b3
...
...
@@ -35,6 +35,10 @@ import Gargantext.Core.Types
import
Gargantext.Prelude
import
Network.HTTP.Simple
-- import qualified Gargantext.Utils.SpacyNLP as SpacyNLP
------------------------------------------------------------------------
------------------------------------------------------------------------
tokens2tokensTags
::
[
Token
]
->
[
TokenTag
]
...
...
@@ -73,18 +77,12 @@ corenlp' :: ( FromJSON a
corenlp'
lang
txt
=
do
let
properties
=
case
lang
of
EN
->
"{
\"
annotators
\"
:
\"
tokenize,ssplit,pos,ner
\"
,
\"
outputFormat
\"
:
\"
json
\"
}"
-- FR -> "{\"annotators\": \"tokenize,ssplit,pos,ner\", \"outputFormat\": \"json\"}"
FR
->
"{
\"
annotators
\"
:
\"
tokenize,ssplit,pos,lemma,ner
\"
,
\"
parse.model
\"
:
\"
edu/stanford/nlp/models/lexparser/frenchFactored.ser.gz
\"
,
\"
pos.model
\"
:
\"
edu/stanford/nlp/models/pos-tagger/french/french.tagger
\"
,
\"
tokenize.language
\"
:
\"
fr
\"
,
\"
outputFormat
\"
:
\"
json
\"
}"
_
->
panic
$
pack
"not implemented yet"
url
<-
parseRequest
$
"POST http://localhost:9000/?properties="
<>
properties
let
request
=
setRequestBodyLBS
(
cs
txt
)
url
httpJSON
request
corenlpRaw
::
Lang
->
Text
->
IO
Value
corenlpRaw
lang
txt
=
do
response
<-
corenlp'
lang
txt
pure
(
getResponseBody
response
)
corenlp
::
Lang
->
Text
->
IO
PosSentences
corenlp
lang
txt
=
do
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
ee1b45b3
...
...
@@ -318,9 +318,9 @@ flowCorpusUser l user corpusName ctype ids mfslw = do
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
Left
""
)
ctype
--let gp = (GroupParams l 2 3 (StopSize 3))
-- Here the PosTagAlgo should be chosen according the Lang
let
gp
=
GroupWithPosTag
l
CoreNLP
HashMap
.
empty
ngs
<-
buildNgramsLists
user
userCorpusId
masterCorpusId
mfslw
gp
-- Here the PosTagAlgo should be chosen according t
o t
he Lang
let
gp
=
GroupWithPosTag
l
CoreNLP
HashMap
.
empty
ngs
<-
buildNgramsLists
user
userCorpusId
masterCorpusId
mfslw
gp
-- printDebug "flowCorpusUser:ngs" ngs
...
...
@@ -329,8 +329,8 @@ flowCorpusUser l user corpusName ctype ids mfslw = do
-- _ <- insertOccsUpdates userCorpusId mastListId
-- printDebug "userListId" userListId
-- User Graph Flow
_
<-
insertDefaultNodeIfNotExists
NodeDashboard
userCorpusId
userId
_
<-
insertDefaultNodeIfNotExists
NodeGraph
userCorpusId
userId
_
<-
insertDefaultNodeIfNotExists
NodeDashboard
userCorpusId
userId
--
_
<-
mkPhylo
userCorpusId
userId
-- Annuaire Flow
-- _ <- mkAnnuaire rootUserId userId
...
...
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