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
161
Issues
161
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
d87c0b12
Commit
d87c0b12
authored
Mar 13, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[METRICS] Fix NaN result, needed diagonal.
parent
14a93ae8
Pipeline
#273
failed with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
13 additions
and
10 deletions
+13
-10
Metrics.hs
src/Gargantext/API/Metrics.hs
+5
-2
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+1
-1
Node.hs
src/Gargantext/API/Node.hs
+5
-5
Metrics.hs
src/Gargantext/Text/Metrics.hs
+2
-2
No files found.
src/Gargantext/API/Metrics.hs
View file @
d87c0b12
...
...
@@ -37,7 +37,7 @@ import Data.Swagger
data
Metrics
=
Metrics
{
metrics_data
::
[
Metric
]}
deriving
(
Generic
)
deriving
(
Generic
,
Show
)
instance
ToSchema
Metrics
instance
Arbitrary
Metrics
...
...
@@ -49,7 +49,7 @@ data Metric = Metric
,
m_x
::
!
Double
,
m_y
::
!
Double
,
m_cat
::
!
ListType
}
deriving
(
Generic
)
}
deriving
(
Generic
,
Show
)
instance
ToSchema
Metric
instance
Arbitrary
Metric
...
...
@@ -61,3 +61,6 @@ instance Arbitrary Metric
deriveJSON
(
unPrefix
"metrics_"
)
''
M
etrics
deriveJSON
(
unPrefix
"m_"
)
''
M
etric
src/Gargantext/API/Ngrams/Tools.hs
View file @
d87c0b12
...
...
@@ -91,7 +91,7 @@ getCoocByNgrams m =
,
maybe
0
Set
.
size
$
Set
.
intersection
<$>
Map
.
lookup
t1
m
<*>
Map
.
lookup
t2
m
)
|
(
t1
,
t2
)
<-
listToCombi
identity
$
Map
.
keys
m
)
|
(
t1
,
t2
)
<-
[
(
x
,
y
)
|
x
<-
Map
.
keys
m
,
y
<-
Map
.
keys
m
,
x
<=
y
]
]
src/Gargantext/API/Node.hs
View file @
d87c0b12
...
...
@@ -39,7 +39,6 @@ import Data.Aeson (FromJSON, ToJSON)
import
Data.Swagger
import
Data.Text
(
Text
())
import
Data.Time
(
UTCTime
)
import
Debug.Trace
(
trace
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Ngrams
(
TabType
(
..
),
TableNgramsApi
,
TableNgramsApiGet
,
tableNgramsPatch
,
getTableNgrams
,
HasRepo
,
ngramsTypeFromTabType
)
import
Gargantext.API.Ngrams.Tools
...
...
@@ -68,7 +67,6 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import
qualified
Data.Map
as
Map
import
qualified
Gargantext.Database.Node.Update
as
U
(
update
,
Update
(
..
))
type
GargServer
api
=
forall
env
m
.
(
CmdM
env
ServantErr
m
,
HasRepo
env
)
...
...
@@ -295,7 +293,7 @@ graphAPI nId = do
<$>
groupNodesByNgrams
ngs
<$>
getNodesByNgramsOnlyUser
cId
NgramsTerms
(
Map
.
keys
ngs
)
liftIO
$
trace
(
show
myCooc
)
$
set
graph_metadata
(
Just
metadata
)
<$>
cooc2graph
myCooc
liftIO
$
set
graph_metadata
(
Just
metadata
)
<$>
cooc2graph
myCooc
instance
HasNodeError
ServantErr
where
...
...
@@ -396,13 +394,13 @@ type MetricsAPI = Summary "SepGen IncExc metrics"
getMetrics
::
NodeId
->
GargServer
MetricsAPI
getMetrics
cId
maybeListId
maybeTabType
maybeLimit
=
do
lId
<-
case
maybeListId
of
Nothing
->
defaultList
cId
Just
lId'
->
pure
lId'
let
ngramsType
=
ngramsTypeFromTabType
maybeTabType
-- TODO all terms
ngs'
<-
mapTermListRoot
[
lId
]
ngramsType
let
ngs
=
Map
.
unions
$
map
(
\
t
->
filterListWithRoot
t
ngs'
)
[
GraphTerm
,
StopTerm
,
CandidateTerm
]
...
...
@@ -411,7 +409,8 @@ getMetrics cId maybeListId maybeTabType maybeLimit = do
<$>
getNodesByNgramsOnlyUser
cId
ngramsType
(
Map
.
keys
ngs
)
let
metrics
=
map
(
\
(
Scored
t
s1
s2
)
->
Metric
t
s1
s2
(
listType
t
ngs'
))
$
scored
myCooc
scores
=
scored
myCooc
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
...
...
@@ -421,3 +420,4 @@ getMetrics cId maybeListId maybeTabType maybeLimit = do
pure
$
Metrics
metricsFiltered
src/Gargantext/Text/Metrics.hs
View file @
d87c0b12
...
...
@@ -19,7 +19,7 @@ module Gargantext.Text.Metrics
where
--import Data.Array.Accelerate ((:.)(..), Z(..))
--
import Debug.Trace (trace)
import
Debug.Trace
(
trace
)
--import Math.KMeans (kmeans, euclidSq, elements)
import
Data.Map
(
Map
)
import
Data.List.Extra
(
sortOn
)
...
...
@@ -57,7 +57,7 @@ scored m = zipWith (\(_,t) (inc,spe) -> Scored t inc spe) (M.toList fi) scores
where
(
ti
,
fi
)
=
createIndices
m
(
is
,
ss
)
=
incExcSpeGen
$
cooc2mat
ti
m
scores
=
DAA
.
toList
scores
=
trace
(
show
is
)
$
DAA
.
toList
$
DAA
.
run
$
DAA
.
zip
(
DAA
.
use
is
)
(
DAA
.
use
ss
)
...
...
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