Commit d87c0b12 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[METRICS] Fix NaN result, needed diagonal.

parent 14a93ae8
Pipeline #273 failed with stage
......@@ -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_") ''Metrics
deriveJSON (unPrefix "m_") ''Metric
......@@ -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]
]
......@@ -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
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment