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
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