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
198
Issues
198
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
c72309dd
Verified
Commit
c72309dd
authored
Mar 20, 2024
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[refactoring] some fixes of imports according to lsp suggestions
parent
574631df
Pipeline
#5789
passed with stages
in 135 minutes and 34 seconds
Changes
9
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
84 additions
and
95 deletions
+84
-95
NodeStory.hs
src/Gargantext/Core/NodeStory.hs
+3
-3
List.hs
src/Gargantext/Core/Text/List.hs
+32
-33
Group.hs
src/Gargantext/Core/Text/List/Group.hs
+6
-12
Terms.hs
src/Gargantext/Core/Text/Terms.hs
+1
-2
Multi.hs
src/Gargantext/Core/Text/Terms/Multi.hs
+5
-9
En.hs
src/Gargantext/Core/Text/Terms/Multi/Lang/En.hs
+3
-4
Extract.hs
src/Gargantext/Database/Action/Flow/Extract.hs
+10
-7
Search.hs
src/Gargantext/Database/Action/Search.hs
+10
-9
SpacyNLP.hs
src/Gargantext/Utils/SpacyNLP.hs
+14
-16
No files found.
src/Gargantext/Core/NodeStory.hs
View file @
c72309dd
...
@@ -235,9 +235,9 @@ fixChildrenInNgrams ns = archiveStateFromList $ nsParents <> nsChildrenFixed
...
@@ -235,9 +235,9 @@ fixChildrenInNgrams ns = archiveStateFromList $ nsParents <> nsChildrenFixed
)
)
)
<$>
nsChildren
)
<$>
nsChildren
-- |
Sometimes, when we upload a new list, a child can be left withou
t
-- |
(#281) Sometimes, when we upload a new list, a child can be lef
t
--
a parent. Find such ngrams and set their 'root' and 'parent' to
--
without a parent. Find such ngrams and set their 'root' and
-- 'Nothing'.
-- '
parent' to '
Nothing'.
fixChildrenWithNoParent
::
NgramsState'
->
NgramsState'
fixChildrenWithNoParent
::
NgramsState'
->
NgramsState'
fixChildrenWithNoParent
ns
=
archiveStateFromList
$
nsParents
<>
nsChildrenFixed
fixChildrenWithNoParent
ns
=
archiveStateFromList
$
nsParents
<>
nsChildrenFixed
where
where
...
...
src/Gargantext/Core/Text/List.hs
View file @
c72309dd
...
@@ -9,14 +9,13 @@ Portability : POSIX
...
@@ -9,14 +9,13 @@ Portability : POSIX
-}
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module
Gargantext.Core.Text.List
module
Gargantext.Core.Text.List
where
where
import
Control.Lens
hiding
(
both
)
-- ((^.), view, over, set, (_1), (_2))
import
Control.Lens
(
view
,
over
)
-- ((^.), view, over, set, (_1), (_2))
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashSet
(
HashSet
)
import
Data.HashSet
(
HashSet
)
...
@@ -27,26 +26,26 @@ import Data.Set qualified as Set
...
@@ -27,26 +26,26 @@ import Data.Set qualified as Set
import
Data.Tuple.Extra
(
both
)
import
Data.Tuple.Extra
(
both
)
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
NgramsTerm
(
..
))
import
Gargantext.API.Ngrams.Types
(
NgramsElement
,
NgramsTerm
(
..
))
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NLP
(
HasNLPServer
)
import
Gargantext.Core.NodeStory
import
Gargantext.Core.NodeStory
.Types
(
HasNodeStory
)
import
Gargantext.Core.Text
(
size
)
import
Gargantext.Core.Text
(
size
)
import
Gargantext.Core.Text.List.Group
import
Gargantext.Core.Text.List.Group
(
toGroupedTree
,
setScoresWithMap
)
import
Gargantext.Core.Text.List.Group.Prelude
import
Gargantext.Core.Text.List.Group.Prelude
import
Gargantext.Core.Text.List.Group.WithStem
import
Gargantext.Core.Text.List.Group.WithStem
import
Gargantext.Core.Text.List.Social
import
Gargantext.Core.Text.List.Social
(
FlowSocialListWith
,
flowSocialList
)
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Prelude
(
FlowListScores
,
FlowCont
(
FlowCont
),
flc_scores
)
import
Gargantext.Core.Text.Metrics
(
scored'
,
Scored
(
..
),
scored_speExc
,
scored_genInc
,
normalizeGlobal
,
normalizeLocal
,
scored_terms
)
import
Gargantext.Core.Text.Metrics
(
scored'
,
Scored
(
..
),
scored_speExc
,
scored_genInc
,
normalizeGlobal
,
normalizeLocal
,
scored_terms
)
import
Gargantext.Core.Types
(
ListType
(
..
),
MasterCorpusId
,
UserCorpusId
,
ContextId
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
..
)
)
import
Gargantext.Data.HashMap.Strict.Utils
qualified
as
HashMap
import
Gargantext.Data.HashMap.Strict.Utils
qualified
as
HashMap
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsUser
,
getContextsByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsUser
,
getContextsByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.TFICF
(
getTficf_withSample
)
import
Gargantext.Database.Action.Metrics.TFICF
(
getTficf_withSample
)
import
Gargantext.Database.Admin.Types.Node
(
MasterCorpusId
,
UserCorpusId
,
ContextId
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Query.Table.Ngrams
(
text2ngrams
)
import
Gargantext.Database.Query.Table.NgramsPostag
(
selectLems
)
import
Gargantext.Database.Query.Table.NgramsPostag
(
selectLems
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
())
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
())
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
),
Ngrams
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
),
Ngrams
(
..
)
,
text2ngrams
)
import
Gargantext.Prelude
import
Gargantext.Prelude
{-
{-
...
@@ -81,8 +80,8 @@ buildNgramsLists user uCid mCid mfslw gp = do
...
@@ -81,8 +80,8 @@ buildNgramsLists user uCid mCid mfslw gp = do
pure
$
Map
.
unions
$
[
ngTerms
]
<>
othersTerms
pure
$
Map
.
unions
$
[
ngTerms
]
<>
othersTerms
data
MapListSize
=
MapListSize
{
unMapListSize
::
!
Int
}
newtype
MapListSize
=
MapListSize
{
unMapListSize
::
Int
}
data
MaxListSize
=
MaxListSize
{
unMaxListSize
::
!
Int
}
newtype
MaxListSize
=
MaxListSize
{
unMaxListSize
::
Int
}
buildNgramsOthersList
::
(
HasNodeError
err
buildNgramsOthersList
::
(
HasNodeError
err
,
HasNLPServer
env
,
HasNLPServer
env
...
@@ -103,7 +102,7 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
...
@@ -103,7 +102,7 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
<-
flowSocialList
mfslw
user
nt
(
FlowCont
HashMap
.
empty
<-
flowSocialList
mfslw
user
nt
(
FlowCont
HashMap
.
empty
$
HashMap
.
fromList
$
HashMap
.
fromList
$
List
.
zip
(
HashMap
.
keys
allTerms
)
$
List
.
zip
(
HashMap
.
keys
allTerms
)
(
List
.
cycle
[
mempty
]
)
(
repeat
mempty
)
)
)
let
let
groupedWithList
=
toGroupedTree
{- groupParams -}
socialLists
allTerms
groupedWithList
=
toGroupedTree
{- groupParams -}
socialLists
allTerms
...
@@ -113,7 +112,7 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
...
@@ -113,7 +112,7 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
(
mapTerms
,
tailTerms'
)
=
HashMap
.
partition
((
==
Just
MapTerm
)
.
viewListType
)
tailTerms
(
mapTerms
,
tailTerms'
)
=
HashMap
.
partition
((
==
Just
MapTerm
)
.
viewListType
)
tailTerms
listSize
=
mapListSize
-
(
List
.
length
mapTerms
)
listSize
=
mapListSize
-
List
.
length
mapTerms
(
mapTerms'
,
candiTerms
)
=
both
HashMap
.
fromList
(
mapTerms'
,
candiTerms
)
=
both
HashMap
.
fromList
$
List
.
splitAt
listSize
$
List
.
splitAt
listSize
$
List
.
take
maxListSize
$
List
.
take
maxListSize
...
@@ -121,10 +120,10 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
...
@@ -121,10 +120,10 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
$
HashMap
.
toList
tailTerms'
$
HashMap
.
toList
tailTerms'
pure
$
Map
.
fromList
[(
nt
,
List
.
take
maxListSize
$
(
toNgramsElement
stopTerms
)
pure
$
Map
.
fromList
[(
nt
,
List
.
take
maxListSize
$
toNgramsElement
stopTerms
<>
(
toNgramsElement
mapTerms
)
<>
toNgramsElement
mapTerms
<>
(
toNgramsElement
$
setListType
(
Just
MapTerm
)
mapTerms'
)
<>
toNgramsElement
(
setListType
(
Just
MapTerm
)
mapTerms'
)
<>
(
toNgramsElement
$
setListType
(
Just
CandidateTerm
)
candiTerms
)
<>
toNgramsElement
(
setListType
(
Just
CandidateTerm
)
candiTerms
)
)]
)]
...
@@ -135,7 +134,7 @@ getGroupParams :: ( HasNodeError err
...
@@ -135,7 +134,7 @@ getGroupParams :: ( HasNodeError err
getGroupParams
gp
@
(
GroupWithPosTag
l
nsc
_m
)
ng
=
do
getGroupParams
gp
@
(
GroupWithPosTag
l
nsc
_m
)
ng
=
do
!
hashMap
<-
HashMap
.
fromList
<$>
selectLems
l
nsc
(
HashSet
.
toList
ng
)
!
hashMap
<-
HashMap
.
fromList
<$>
selectLems
l
nsc
(
HashSet
.
toList
ng
)
-- printDebug "hashMap" hashMap
-- printDebug "hashMap" hashMap
pure
$
over
gwl_map
(
\
x
->
x
<>
hashMap
)
gp
pure
$
over
gwl_map
(
<>
hashMap
)
gp
getGroupParams
gp
_
=
pure
gp
getGroupParams
gp
_
=
pure
gp
...
@@ -168,7 +167,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
...
@@ -168,7 +167,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
<-
flowSocialList
mfslw
user
nt
(
FlowCont
HashMap
.
empty
<-
flowSocialList
mfslw
user
nt
(
FlowCont
HashMap
.
empty
$
HashMap
.
fromList
$
HashMap
.
fromList
$
List
.
zip
(
HashMap
.
keys
allTerms
)
$
List
.
zip
(
HashMap
.
keys
allTerms
)
(
List
.
cycle
[
mempty
]
)
(
repeat
mempty
)
)
)
-- printDebug "[buildNgramsTermsList: Flow Social List / end]" nt
-- printDebug "[buildNgramsTermsList: Flow Social List / end]" nt
...
@@ -187,7 +186,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
...
@@ -187,7 +186,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
!
socialLists_Stemmed
=
addScoreStem
groupParams'
ngramsKeys
socialLists
!
socialLists_Stemmed
=
addScoreStem
groupParams'
ngramsKeys
socialLists
!
groupedWithList
=
toGroupedTree
socialLists_Stemmed
allTerms
!
groupedWithList
=
toGroupedTree
socialLists_Stemmed
allTerms
!
(
stopTerms
,
candidateTerms
)
=
HashMap
.
partition
((
==
Just
StopTerm
)
.
viewListType
)
!
(
stopTerms
,
candidateTerms
)
=
HashMap
.
partition
((
==
Just
StopTerm
)
.
viewListType
)
$
HashMap
.
filter
(
\
g
->
(
view
gts'_score
g
)
>
1
)
$
HashMap
.
filter
(
\
g
->
view
gts'_score
g
>
1
)
$
view
flc_scores
groupedWithList
$
view
flc_scores
groupedWithList
!
(
groupedMono
,
groupedMult
)
=
HashMap
.
partitionWithKey
(
\
(
NgramsTerm
t
)
_v
->
size
t
<
2
)
candidateTerms
!
(
groupedMono
,
groupedMult
)
=
HashMap
.
partitionWithKey
(
\
(
NgramsTerm
t
)
_v
->
size
t
<
2
)
candidateTerms
...
@@ -269,8 +268,8 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
...
@@ -269,8 +268,8 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
!
(
monoScored
,
multScored
)
=
HashMap
.
partitionWithKey
(
\
(
NgramsTerm
t
)
_v
->
size
t
<
2
)
groupedTreeScores_SpeGen
!
(
monoScored
,
multScored
)
=
HashMap
.
partitionWithKey
(
\
(
NgramsTerm
t
)
_v
->
size
t
<
2
)
groupedTreeScores_SpeGen
-- filter with max score
-- filter with max score
partitionWithMaxScore
=
HashMap
.
partition
(
\
g
->
(
view
scored_genInc
$
view
gts'_score
g
)
partitionWithMaxScore
=
HashMap
.
partition
(
\
g
->
view
scored_genInc
(
view
gts'_score
g
)
>
(
view
scored_speExc
$
view
gts'_score
g
)
>
view
scored_speExc
(
view
gts'_score
g
)
)
)
!
(
monoScoredIncl
,
monoScoredExcl
)
=
partitionWithMaxScore
monoScored
!
(
monoScoredIncl
,
monoScoredExcl
)
=
partitionWithMaxScore
monoScored
...
@@ -285,25 +284,25 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
...
@@ -285,25 +284,25 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
!
inclSize
=
0.4
::
Double
!
inclSize
=
0.4
::
Double
!
exclSize
=
1
-
inclSize
!
exclSize
=
1
-
inclSize
splitAt''
max'
n'
=
(
both
(
HashMap
.
fromList
))
.
(
List
.
splitAt
(
round
$
n'
*
max'
)
)
splitAt''
max'
n'
=
both
HashMap
.
fromList
.
List
.
splitAt
(
round
$
n'
*
max'
)
sortOn'
f
=
(
List
.
sortOn
(
Down
.
(
view
(
gts'_score
.
f
))
.
snd
)
)
.
HashMap
.
toList
sortOn'
f
=
List
.
sortOn
(
Down
.
view
(
gts'_score
.
f
)
.
snd
)
.
HashMap
.
toList
monoInc_size
n
=
splitAt''
n
$
monoSize
*
inclSize
/
2
monoInc_size
n
=
splitAt''
n
$
monoSize
*
inclSize
/
2
multExc_size
n
=
splitAt''
n
$
multSize
*
exclSize
/
2
multExc_size
n
=
splitAt''
n
$
multSize
*
exclSize
/
2
!
(
mapMonoScoredInclHead
,
monoScoredInclTail
)
=
monoInc_size
mapSize
$
(
sortOn'
scored_genInc
)
monoScoredIncl
!
(
mapMonoScoredInclHead
,
monoScoredInclTail
)
=
monoInc_size
mapSize
$
sortOn'
scored_genInc
monoScoredIncl
!
(
mapMonoScoredExclHead
,
monoScoredExclTail
)
=
monoInc_size
mapSize
$
(
sortOn'
scored_speExc
)
monoScoredExcl
!
(
mapMonoScoredExclHead
,
monoScoredExclTail
)
=
monoInc_size
mapSize
$
sortOn'
scored_speExc
monoScoredExcl
!
(
mapMultScoredInclHead
,
multScoredInclTail
)
=
multExc_size
mapSize
$
(
sortOn'
scored_genInc
)
multScoredIncl
!
(
mapMultScoredInclHead
,
multScoredInclTail
)
=
multExc_size
mapSize
$
sortOn'
scored_genInc
multScoredIncl
!
(
mapMultScoredExclHead
,
multScoredExclTail
)
=
multExc_size
mapSize
$
(
sortOn'
scored_speExc
)
multScoredExcl
!
(
mapMultScoredExclHead
,
multScoredExclTail
)
=
multExc_size
mapSize
$
sortOn'
scored_speExc
multScoredExcl
!
(
canMonoScoredIncHead
,
_
)
=
monoInc_size
canSize
$
(
sortOn'
scored_genInc
)
monoScoredInclTail
!
(
canMonoScoredIncHead
,
_
)
=
monoInc_size
canSize
$
sortOn'
scored_genInc
monoScoredInclTail
!
(
canMonoScoredExclHead
,
_
)
=
monoInc_size
canSize
$
(
sortOn'
scored_speExc
)
monoScoredExclTail
!
(
canMonoScoredExclHead
,
_
)
=
monoInc_size
canSize
$
sortOn'
scored_speExc
monoScoredExclTail
!
(
canMulScoredInclHead
,
_
)
=
multExc_size
canSize
$
(
sortOn'
scored_genInc
)
multScoredInclTail
!
(
canMulScoredInclHead
,
_
)
=
multExc_size
canSize
$
sortOn'
scored_genInc
multScoredInclTail
!
(
canMultScoredExclHead
,
_
)
=
multExc_size
canSize
$
(
sortOn'
scored_speExc
)
multScoredExclTail
!
(
canMultScoredExclHead
,
_
)
=
multExc_size
canSize
$
sortOn'
scored_speExc
multScoredExclTail
------------------------------------------------------------
------------------------------------------------------------
-- Final Step building the Typed list
-- Final Step building the Typed list
...
...
src/Gargantext/Core/Text/List/Group.hs
View file @
c72309dd
...
@@ -9,11 +9,8 @@ Portability : POSIX
...
@@ -9,11 +9,8 @@ Portability : POSIX
-}
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs #-}
module
Gargantext.Core.Text.List.Group
module
Gargantext.Core.Text.List.Group
where
where
...
@@ -23,8 +20,8 @@ import Data.HashMap.Strict (HashMap)
...
@@ -23,8 +20,8 @@ import Data.HashMap.Strict (HashMap)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashMap.Strict
qualified
as
HashMap
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.Core.Text.List.Group.Prelude
import
Gargantext.Core.Text.List.Group.Prelude
import
Gargantext.Core.Text.List.Group.WithScores
import
Gargantext.Core.Text.List.Group.WithScores
(
groupWithScores'
)
import
Gargantext.Core.Text.List.Social.Prelude
import
Gargantext.Core.Text.List.Social.Prelude
(
FlowListScores
,
FlowCont
)
import
Gargantext.Prelude
import
Gargantext.Prelude
------------------------------------------------------------------------
------------------------------------------------------------------------
toGroupedTree
::
(
Ord
a
,
Monoid
a
,
HasSize
a
)
toGroupedTree
::
(
Ord
a
,
Monoid
a
,
HasSize
a
)
...
@@ -43,9 +40,7 @@ setScoresWithMap :: (Ord a, Ord b, Monoid b) => HashMap NgramsTerm b
...
@@ -43,9 +40,7 @@ setScoresWithMap :: (Ord a, Ord b, Monoid b) => HashMap NgramsTerm b
->
HashMap
NgramsTerm
(
GroupedTreeScores
b
)
->
HashMap
NgramsTerm
(
GroupedTreeScores
b
)
setScoresWithMap
m
=
setScoresWith
(
score
m
)
setScoresWithMap
m
=
setScoresWith
(
score
m
)
where
where
score
m'
t
=
case
HashMap
.
lookup
t
m'
of
score
m'
t
=
fromMaybe
mempty
(
HashMap
.
lookup
t
m'
)
Nothing
->
mempty
Just
r
->
r
setScoresWith
::
(
Ord
a
,
Ord
b
)
setScoresWith
::
(
Ord
a
,
Ord
b
)
=>
(
NgramsTerm
->
b
)
=>
(
NgramsTerm
->
b
)
...
@@ -58,8 +53,7 @@ setScoresWith f = Map.mapWithKey (\k v -> over gts'_children (setScoresWith f)
...
@@ -58,8 +53,7 @@ setScoresWith f = Map.mapWithKey (\k v -> over gts'_children (setScoresWith f)
)
)
-}
-}
setScoresWith
f
=
HashMap
.
mapWithKey
(
\
k
v
->
v
{
_gts'_score
=
f
k
setScoresWith
f
=
HashMap
.
mapWithKey
(
\
k
v
->
v
{
_gts'_score
=
f
k
,
_gts'_children
=
setScoresWith
f
,
_gts'_children
=
setScoresWith
f
$
view
gts'_children
v
$
view
gts'_children
v
}
}
)
)
------------------------------------------------------------------------
------------------------------------------------------------------------
src/Gargantext/Core/Text/Terms.hs
View file @
c72309dd
...
@@ -103,8 +103,7 @@ withLang (Unsupervised {..}) ns = Unsupervised { _tt_model = m', .. }
...
@@ -103,8 +103,7 @@ withLang (Unsupervised {..}) ns = Unsupervised { _tt_model = m', .. }
$
fmap
toToken
$
fmap
toToken
$
uniText
$
uniText
$
Text
.
intercalate
" . "
$
Text
.
intercalate
" . "
$
List
.
concat
$
concatMap
hasText
ns
$
map
hasText
ns
just_m
->
just_m
just_m
->
just_m
withLang
l
_
=
l
withLang
l
_
=
l
...
...
src/Gargantext/Core/Text/Terms/Multi.hs
View file @
c72309dd
...
@@ -11,25 +11,21 @@ Multi-terms are ngrams where n > 1.
...
@@ -11,25 +11,21 @@ Multi-terms are ngrams where n > 1.
-}
-}
{-# LANGUAGE OverloadedStrings #-}
module
Gargantext.Core.Text.Terms.Multi
(
multiterms
,
multiterms_rake
,
tokenTagsWith
,
tokenTags
,
cleanTextForNLP
)
module
Gargantext.Core.Text.Terms.Multi
(
multiterms
,
multiterms_rake
,
tokenTagsWith
,
tokenTags
,
cleanTextForNLP
)
where
where
import
Control.Applicative
import
Data.Attoparsec.Text
as
DAT
(
digit
,
space
,
notChar
,
string
)
import
Data.Attoparsec.Text
as
DAT
import
Data.Text
hiding
(
map
,
group
,
filter
,
concat
)
import
Gargantext.Core
(
Lang
(
..
),
NLPServerConfig
(
..
),
PosTagAlgo
(
..
))
import
Gargantext.Core
(
Lang
(
..
),
NLPServerConfig
(
..
),
PosTagAlgo
(
..
))
import
Gargantext.Core.Text.Terms.Multi.Lang.En
qualified
as
En
import
Gargantext.Core.Text.Terms.Multi.Lang.En
qualified
as
En
import
Gargantext.Core.Text.Terms.Multi.Lang.Fr
qualified
as
Fr
import
Gargantext.Core.Text.Terms.Multi.Lang.Fr
qualified
as
Fr
import
Gargantext.Core.Text.Terms.Multi.PosTagging
import
Gargantext.Core.Text.Terms.Multi.PosTagging
(
corenlp
,
tokens2tokensTags
)
import
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
import
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
(
PosSentences
(
_sentences
),
Sentence
(
_sentenceTokens
)
)
import
Gargantext.Core.Text.Terms.Multi.RAKE
(
multiterms_rake
)
import
Gargantext.Core.Text.Terms.Multi.RAKE
(
multiterms_rake
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
(
POS
(
NP
),
Terms
(
Terms
),
TermsWithCount
,
TokenTag
(
TokenTag
,
_my_token_pos
)
)
import
Gargantext.Core.Utils
(
groupWithCounts
)
import
Gargantext.Core.Utils
(
groupWithCounts
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Utils.SpacyNLP
qualified
as
SpacyNLP
import
Gargantext.Utils.SpacyNLP
qualified
as
SpacyNLP
import
Replace.Attoparsec.Text
as
RAT
import
Replace.Attoparsec.Text
as
RAT
(
streamEdit
)
-------------------------------------------------------------------
-------------------------------------------------------------------
type
NLP_API
=
Lang
->
Text
->
IO
PosSentences
type
NLP_API
=
Lang
->
Text
->
IO
PosSentences
...
...
src/Gargantext/Core/Text/Terms/Multi/Lang/En.hs
View file @
c72309dd
...
@@ -17,8 +17,8 @@ module Gargantext.Core.Text.Terms.Multi.Lang.En (groupTokens)
...
@@ -17,8 +17,8 @@ module Gargantext.Core.Text.Terms.Multi.Lang.En (groupTokens)
where
where
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Types
import
Gargantext.Core.Types
(
POS
(
CC
,
IN
,
DT
,
NP
,
JJ
),
TokenTag
)
import
Gargantext.Core.Text.Terms.Multi.Group
import
Gargantext.Core.Text.Terms.Multi.Group
(
group2
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Rule grammar to group tokens
-- | Rule grammar to group tokens
...
@@ -31,8 +31,7 @@ groupTokens ntags = group2 NP NP
...
@@ -31,8 +31,7 @@ groupTokens ntags = group2 NP NP
-- $ group2 VB NP
-- $ group2 VB NP
$
group2
JJ
NP
$
group2
JJ
NP
$
group2
JJ
JJ
$
group2
JJ
JJ
$
group2
JJ
CC
$
group2
JJ
CC
ntags
$
ntags
------------------------------------------------------------------------
------------------------------------------------------------------------
--groupNgrams ((x,_,"PERSON"):(y,yy,"PERSON"):xs) = groupNgrams ((x <> " " <> y,yy,"PERSON"):xs)
--groupNgrams ((x,_,"PERSON"):(y,yy,"PERSON"):xs) = groupNgrams ((x <> " " <> y,yy,"PERSON"):xs)
...
...
src/Gargantext/Database/Action/Flow/Extract.hs
View file @
c72309dd
...
@@ -20,15 +20,16 @@ module Gargantext.Database.Action.Flow.Extract
...
@@ -20,15 +20,16 @@ module Gargantext.Database.Action.Flow.Extract
import
Control.Lens
((
^.
),
_Just
,
view
)
import
Control.Lens
((
^.
),
_Just
,
view
)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.Map.Strict
qualified
as
DM
import
Data.Map.Strict
qualified
as
DM
import
Gargantext.Core
(
Lang
,
NLPServerConfig
,
PosTagAlgo
(
CoreNLP
))
import
Gargantext.Core
(
Lang
,
NLPServerConfig
,
PosTagAlgo
(
CoreNLP
))
import
Gargantext.Core.Text
(
HasText
(
..
))
import
Gargantext.Core.Text
(
HasText
(
..
))
import
Gargantext.Core.Text.Corpus.Parsers
(
splitOn
)
import
Gargantext.Core.Text.Corpus.Parsers
(
splitOn
)
import
Gargantext.Core.Text.Terms
(
ExtractNgramsT
,
ExtractedNgrams
(
..
),
TermType
,
cleanExtractedNgrams
,
enrichedTerms
,
extractNgramsT
,
extractTerms
,
tt_lang
)
import
Gargantext.Core.Text.Terms
(
ExtractNgramsT
,
ExtractedNgrams
(
..
),
TermType
,
cleanExtractedNgrams
,
enrichedTerms
,
extractNgramsT
,
extractTerms
,
tt_lang
)
import
Gargantext.Core.Types
(
POS
(
NP
),
TermsCount
)
import
Gargantext.Core.Types
(
POS
(
NP
),
TermsCount
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataContact
,
HyperdataDocument
,
cw_lastName
,
hc_who
,
hd_authors
,
hd_bdd
,
hd_institutes
,
hd_source
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
,
cw_lastName
,
hc_who
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
hd_authors
,
hd_bdd
,
hd_institutes
,
hd_source
)
import
Gargantext.Database.Admin.Types.Node
(
Node
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
),
text2ngrams
)
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
))
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
...
@@ -49,6 +50,9 @@ instance ExtractNgramsT HyperdataContact
...
@@ -49,6 +50,9 @@ instance ExtractNgramsT HyperdataContact
pure
$
HashMap
.
fromList
$
[(
SimpleNgrams
a'
,
(
DM
.
singleton
Authors
1
,
1
))
|
a'
<-
authors
]
pure
$
HashMap
.
fromList
$
[(
SimpleNgrams
a'
,
(
DM
.
singleton
Authors
1
,
1
))
|
a'
<-
authors
]
-- | Main ngrams extraction functionality.
-- For NgramsTerms, this calls NLP server under the hood.
-- For Sources, Institutes, Authors, this uses simple split on " ".
instance
ExtractNgramsT
HyperdataDocument
instance
ExtractNgramsT
HyperdataDocument
where
where
extractNgramsT
::
NLPServerConfig
extractNgramsT
::
NLPServerConfig
...
@@ -72,9 +76,8 @@ instance ExtractNgramsT HyperdataDocument
...
@@ -72,9 +76,8 @@ instance ExtractNgramsT HyperdataDocument
$
maybe
[
"Nothing"
]
(
splitOn
Authors
(
doc
^.
hd_bdd
))
$
maybe
[
"Nothing"
]
(
splitOn
Authors
(
doc
^.
hd_bdd
))
$
doc
^.
hd_authors
$
doc
^.
hd_authors
termsWithCounts'
<-
map
(
\
(
t
,
cnt
)
->
(
enrichedTerms
(
lang
^.
tt_lang
)
CoreNLP
NP
t
,
cnt
))
termsWithCounts'
<-
map
(
first
(
enrichedTerms
(
lang
^.
tt_lang
)
CoreNLP
NP
))
.
concat
<$>
<$>
concat
liftBase
(
extractTerms
ncs
lang
$
hasText
doc
)
<$>
liftBase
(
extractTerms
ncs
lang
$
hasText
doc
)
pure
$
HashMap
.
fromList
pure
$
HashMap
.
fromList
$
[(
SimpleNgrams
source
,
(
DM
.
singleton
Sources
1
,
1
))
]
$
[(
SimpleNgrams
source
,
(
DM
.
singleton
Sources
1
,
1
))
]
...
...
src/Gargantext/Database/Action/Search.hs
View file @
c72309dd
...
@@ -23,7 +23,7 @@ module Gargantext.Database.Action.Search (
...
@@ -23,7 +23,7 @@ module Gargantext.Database.Action.Search (
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
((
^.
),
view
)
import
Control.Lens
((
^.
),
view
)
import
Data.BoolExpr
import
Data.BoolExpr
(
BoolExpr
(
..
),
Signed
(
Negative
,
Positive
)
)
import
Data.List
qualified
as
List
import
Data.List
qualified
as
List
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict
qualified
as
Map
import
Data.Profunctor.Product
(
p4
)
import
Data.Profunctor.Product
(
p4
)
...
@@ -31,25 +31,26 @@ import Data.Set qualified as Set
...
@@ -31,25 +31,26 @@ import Data.Set qualified as Set
import
Data.Text
(
unpack
)
import
Data.Text
(
unpack
)
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
Gargantext.Core
import
Gargantext.Core
(
Lang
(
EN
),
HasDBid
(
toDBid
)
)
import
Gargantext.Core.Text.Corpus.Query
qualified
as
API
import
Gargantext.Core.Text.Corpus.Query
qualified
as
API
import
Gargantext.Core.Text.Terms.Mono.Stem
(
stem
,
StemmingAlgorithm
(
..
))
import
Gargantext.Core.Text.Terms.Mono.Stem
(
stem
,
StemmingAlgorithm
(
..
))
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
IsTrash
,
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
IsTrash
,
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
),
HyperdataContact
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
(
..
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
)
)
import
Gargantext.Database.Prelude
(
runOpaQuery
,
runCountOpaQuery
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runOpaQuery
,
runCountOpaQuery
,
DBCmd
)
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.Context
import
Gargantext.Database.Query.Table.Context
(
queryContextSearchTable
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams
(
queryContextNodeNgramsTable
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams
(
queryContextNodeNgramsTable
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
(
queryNodeSearchTable
,
defaultList
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
())
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
())
import
Gargantext.Database.Query.Table.NodeContext
import
Gargantext.Database.Query.Table.NodeContext
import
Gargantext.Database.
Query.Table.NodeContext_NodeContext
import
Gargantext.Database.
Schema.NodeContext_NodeContext
(
NodeContext_NodeContextRead
,
queryNodeContext_NodeContextTable
,
ncnc_nodecontext2
,
ncnc_nodecontext1
)
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.ContextNodeNgrams
(
ContextNodeNgramsPoly
(
..
))
import
Gargantext.Database.Schema.ContextNodeNgrams
(
ContextNodeNgramsPoly
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
(
NodePolySearch
(
_ns_hyperdata
,
_ns_search
,
_ns_typename
,
_ns_id
)
)
import
Gargantext.Prelude
hiding
(
groupBy
)
import
Gargantext.Prelude
hiding
(
groupBy
)
import
Opaleye
hiding
(
Order
)
import
Opaleye
hiding
(
Order
)
import
Opaleye
qualified
as
O
hiding
(
Order
)
import
Opaleye
qualified
as
O
hiding
(
Order
)
...
@@ -59,7 +60,7 @@ import Opaleye qualified as O hiding (Order)
...
@@ -59,7 +60,7 @@ import Opaleye qualified as O hiding (Order)
--
--
queryToTsSearch
::
API
.
Query
->
Field
SqlTSQuery
queryToTsSearch
::
API
.
Query
->
Field
SqlTSQuery
queryToTsSearch
q
=
sqlToTSQuery
$
T
.
unpack
$
(
API
.
interpretQuery
q
transformAST
)
queryToTsSearch
q
=
sqlToTSQuery
$
T
.
unpack
$
API
.
interpretQuery
q
transformAST
where
where
-- It's important to understand how things work under the hood: When we perform
-- It's important to understand how things work under the hood: When we perform
...
...
src/Gargantext/Utils/SpacyNLP.hs
View file @
c72309dd
...
@@ -13,7 +13,6 @@ Server to be used: https://gitlab.iscpif.fr/gargantext/spacy-server
...
@@ -13,7 +13,6 @@ Server to be used: https://gitlab.iscpif.fr/gargantext/spacy-server
-}
-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Utils.SpacyNLP
(
module
Gargantext.Utils.SpacyNLP
(
module
Gargantext
.
Utils
.
SpacyNLP
.
Types
module
Gargantext
.
Utils
.
SpacyNLP
.
Types
...
@@ -24,9 +23,8 @@ module Gargantext.Utils.SpacyNLP (
...
@@ -24,9 +23,8 @@ module Gargantext.Utils.SpacyNLP (
)
where
)
where
import
Data.Aeson
(
encode
)
import
Data.Aeson
(
encode
)
import
Data.Text
hiding
(
map
,
group
,
filter
,
concat
,
zip
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
import
Gargantext.Core.Text.Terms.Multi.PosTagging.Types
(
PosSentences
(
PosSentences
),
Sentence
(
Sentence
),
Token
(
Token
)
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Network.HTTP.Simple
(
parseRequest
,
httpJSON
,
setRequestBodyLBS
,
getResponseBody
,
Response
)
import
Network.HTTP.Simple
(
parseRequest
,
httpJSON
,
setRequestBodyLBS
,
getResponseBody
,
Response
)
import
Network.URI
(
URI
(
..
))
import
Network.URI
(
URI
(
..
))
...
@@ -42,22 +40,22 @@ spacyRequest uri txt = do
...
@@ -42,22 +40,22 @@ spacyRequest uri txt = do
----------------------------------------------------------------
----------------------------------------------------------------
spacyTagsToToken
::
SpacyTags
->
Token
spacyTagsToToken
::
SpacyTags
->
Token
spacyTagsToToken
st
=
Token
(
_spacyTags_index
st
)
spacyTagsToToken
st
=
(
_spacyTags_normalized
st
)
Token
(
_spacyTags_index
st
)
(
_spacyTags_text
st
)
(
_spacyTags_normalized
st
)
(
_spacyTags_lemma
st
)
(
_spacyTags_text
st
)
(
_spacyTags_head_index
st
)
(
_spacyTags_lemma
st
)
(
_spacyTags_char_offset
st
)
(
_spacyTags_head_index
st
)
(
Just
$
_spacyTags_pos
st
)
(
_spacyTags_char_offset
st
)
(
Just
$
_spacyTags_ent_type
st
)
(
Just
$
_spacyTags_pos
st
)
(
Just
$
_spacyTags_prefix
st
)
(
Just
$
_spacyTags_ent_type
st
)
(
Just
$
_spacyTags_suffix
st
)
(
Just
$
_spacyTags_prefix
st
)
(
Just
$
_spacyTags_suffix
st
)
spacyDataToPosSentences
::
SpacyData
->
PosSentences
spacyDataToPosSentences
::
SpacyData
->
PosSentences
spacyDataToPosSentences
(
SpacyData
ds
)
=
PosSentences
spacyDataToPosSentences
(
SpacyData
ds
)
=
PosSentences
$
map
(
\
(
i
,
ts
)
->
Sentence
i
ts
)
$
zipWith
Sentence
[
1
..
]
$
zip
[
1
..
]
(
map
(
\
(
SpacyText
_
tags
)
->
map
spacyTagsToToken
tags
)
ds
)
$
map
(
\
(
SpacyText
_
tags
)
->
map
spacyTagsToToken
tags
)
ds
-----------------------------------------------------------------
-----------------------------------------------------------------
...
...
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