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
8
Merge Requests
8
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
b6b50641
Commit
b6b50641
authored
Mar 19, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Metrics Charts + Grammar rules + ngrams groups.
parent
1441aa53
Pipeline
#287
failed with stage
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
19 additions
and
19 deletions
+19
-19
Node.hs
src/Gargantext/API/Node.hs
+2
-6
Metrics.hs
src/Gargantext/Database/Metrics.hs
+9
-5
NgramsByNode.hs
src/Gargantext/Database/Metrics/NgramsByNode.hs
+3
-2
List.hs
src/Gargantext/Text/List.hs
+4
-5
Fr.hs
src/Gargantext/Text/Terms/Multi/Lang/Fr.hs
+1
-1
No files found.
src/Gargantext/API/Node.hs
View file @
b6b50641
...
...
@@ -395,18 +395,14 @@ type MetricsAPI = Summary "SepGen IncExc metrics"
getMetrics
::
NodeId
->
GargServer
MetricsAPI
getMetrics
cId
maybeListId
maybeTabType
maybeLimit
=
do
(
ngs'
,
scores
)
<-
getMetrics'
cId
maybeListId
maybeTabType
(
ngs'
,
scores
)
<-
getMetrics'
cId
maybeListId
maybeTabType
maybeLimit
let
metrics
=
map
(
\
(
Scored
t
s1
s2
)
->
Metric
t
s1
s2
(
listType
t
ngs'
))
scores
errorMsg
=
"API.Node.metrics: key absent"
listType
t
m
=
maybe
(
panic
errorMsg
)
fst
$
Map
.
lookup
t
m
metricsFiltered
=
case
maybeLimit
of
Nothing
->
metrics
Just
l
->
take
l
metrics
pure
$
Metrics
metricsFiltered
pure
$
Metrics
metrics
...
...
src/Gargantext/Database/Metrics.hs
View file @
b6b50641
...
...
@@ -22,7 +22,7 @@ import Data.Map (Map)
import
Data.Text
(
Text
)
import
Gargantext.API.Ngrams
(
TabType
(
..
),
ngramsTypeFromTabType
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.Core.Types
(
ListType
(
..
))
import
Gargantext.Core.Types
(
ListType
(
..
)
,
Limit
)
import
Gargantext.Database.Flow
(
FlowCmdM
)
import
Gargantext.Database.Metrics.NgramsByNode
(
getNodesByNgramsOnlyUser
)
import
Gargantext.Database.Schema.Node
(
defaultList
)
...
...
@@ -33,9 +33,9 @@ import Servant (ServantErr)
import
qualified
Data.Map
as
Map
getMetrics'
::
FlowCmdM
env
ServantErr
m
=>
CorpusId
->
Maybe
ListId
->
Maybe
TabType
=>
CorpusId
->
Maybe
ListId
->
Maybe
TabType
->
Maybe
Limit
->
m
(
Map
Text
(
ListType
,
Maybe
Text
),
[
Scored
Text
])
getMetrics'
cId
maybeListId
maybeTabType
=
do
getMetrics'
cId
maybeListId
maybeTabType
maybeLimit
=
do
lId
<-
case
maybeListId
of
Nothing
->
defaultList
cId
...
...
@@ -46,10 +46,14 @@ getMetrics' cId maybeListId maybeTabType = do
ngs'
<-
mapTermListRoot
[
lId
]
ngramsType
let
ngs
=
Map
.
unions
$
map
(
\
t
->
filterListWithRoot
t
ngs'
)
[
GraphTerm
,
StopTerm
,
CandidateTerm
]
let
take'
Nothing
xs
=
xs
take'
(
Just
n
)
xs
=
take
n
xs
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
True
<$>
groupNodesByNgrams
ngs
<$>
getNodesByNgramsOnlyUser
cId
ngramsType
(
Map
.
keys
ngs
)
<$>
getNodesByNgramsOnlyUser
cId
ngramsType
(
take'
maybeLimit
$
Map
.
keys
ngs
)
pure
$
(
ngs'
,
scored
myCooc
)
...
...
src/Gargantext/Database/Metrics/NgramsByNode.hs
View file @
b6b50641
...
...
@@ -43,11 +43,12 @@ import qualified Database.PostgreSQL.Simple as DPS
-- discussed. Main purpose of this is offering
-- a first grouping option to user and get some
-- enriched data to better learn and improve that algo
ngramsGroup
::
Lang
->
Int
->
Text
->
Text
ngramsGroup
l
n
=
Text
.
intercalate
" "
ngramsGroup
::
Lang
->
Int
->
Int
->
Text
->
Text
ngramsGroup
l
m
n
=
Text
.
intercalate
" "
.
map
(
stem
l
)
.
take
n
.
List
.
sort
.
(
List
.
filter
(
\
t
->
Text
.
length
t
>
m
))
.
Text
.
splitOn
" "
.
Text
.
replace
"-"
" "
...
...
src/Gargantext/Text/List.hs
View file @
b6b50641
...
...
@@ -56,7 +56,7 @@ buildNgramsOthersList uCid groupIt nt = do
buildNgramsTermsList
::
UserCorpusId
->
MasterCorpusId
->
Cmd
err
(
Map
NgramsType
[
NgramsElement
])
buildNgramsTermsList
uCid
mCid
=
do
candidates
<-
sortTficf
<$>
getTficf'
uCid
mCid
(
ngramsGroup
EN
2
)
candidates
<-
sortTficf
<$>
getTficf'
uCid
mCid
(
ngramsGroup
EN
4
2
)
--printDebug "candidate" (length candidates)
let
termList
=
toTermList
(
isStopTerm
.
fst
)
candidates
...
...
@@ -105,8 +105,7 @@ isStopTerm :: Text -> Bool
isStopTerm
x
=
Text
.
length
x
<
3
||
not
(
all
Char
.
isAlpha
(
Text
.
unpack
x'
))
where
x'
=
(
Text
.
replace
"-"
""
.
Text
.
replace
" "
""
.
Text
.
replace
"/"
""
)
x
x'
=
foldl
(
\
t
->
Text
.
replace
t
""
)
x
[
"-"
,
" "
,
"/"
,
"("
,
")"
]
src/Gargantext/Text/Terms/Multi/Lang/Fr.hs
View file @
b6b50641
...
...
@@ -27,7 +27,7 @@ group :: [TokenTag] -> [TokenTag]
group
[]
=
[]
group
ntags
=
group2
NP
NP
$
group2
NP
VB
$
group2
NP
IN
--
$ group2 NP IN
-- - $ group2 IN DT
$
group2
VB
NP
$
group2
JJ
NP
...
...
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