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

[FIX] Metrics adding filtering.

parent 8804c4e7
Pipeline #829 failed with stage
...@@ -71,8 +71,8 @@ getTficf :: UserCorpusId ...@@ -71,8 +71,8 @@ getTficf :: UserCorpusId
-> (Text -> Text) -> (Text -> Text)
-> Cmd err (Map Text (Double, Set Text)) -> Cmd err (Map Text (Double, Set Text))
getTficf u m nt f = do getTficf u m nt f = do
u' <- getNodesByNgramsUser u nt u' <- Map.filter (\s -> Set.size s > 1) <$> getNodesByNgramsUser u nt
m' <- getNodesByNgramsMaster u m m' <- Map.filter (\s -> Set.size s > 1) <$> getNodesByNgramsMaster u m
pure $ toTficfData (countNodesByNgramsWith f u') pure $ toTficfData (countNodesByNgramsWith f u')
(countNodesByNgramsWith f m') (countNodesByNgramsWith f m')
...@@ -92,8 +92,7 @@ getTficfWith u m ls nt mtxt = do ...@@ -92,8 +92,7 @@ getTficfWith u m ls nt mtxt = do
Nothing -> x Nothing -> x
Just x' -> maybe x identity x' Just x' -> maybe x identity x'
pure $ toTficfData (countNodesByNgramsWith f u') pure $ toTficfData (countNodesByNgramsWith f u') (countNodesByNgramsWith f m')
(countNodesByNgramsWith f m')
-} -}
type Context = (Double, Map Text (Double, Set Text)) type Context = (Double, Map Text (Double, Set Text))
...@@ -183,7 +182,7 @@ getOccByNgramsOnlyFast' :: CorpusId ...@@ -183,7 +182,7 @@ getOccByNgramsOnlyFast' :: CorpusId
-> NgramsType -> NgramsType
-> [Text] -> [Text]
-> Cmd err (Map Text Int) -> Cmd err (Map Text Int)
getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
fromListWith (+) <$> map (second round) <$> run cId lId nt tms fromListWith (+) <$> map (second round) <$> run cId lId nt tms
where where
......
...@@ -86,5 +86,12 @@ mkNodeWithParent NodeAnnuaire (Just i) uId name = ...@@ -86,5 +86,12 @@ mkNodeWithParent NodeAnnuaire (Just i) uId name =
where where
hd = defaultAnnuaire hd = defaultAnnuaire
{-
mkNodeWithParent NodeList (Just i) uId name =
insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
where
hd = defaultList
-}
mkNodeWithParent _ _ _ _ = nodeError NotImplYet mkNodeWithParent _ _ _ _ = nodeError NotImplYet
...@@ -416,12 +416,21 @@ instance MkCorpus HyperdataAnnuaire ...@@ -416,12 +416,21 @@ instance MkCorpus HyperdataAnnuaire
mk n h p u = insertNodesR [nodeAnnuaireW n h p u] mk n h p u = insertNodesR [nodeAnnuaireW n h p u]
getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err ListId getOrMkList :: HasNodeError err
=> ParentId
-> UserId
-> Cmd err ListId
getOrMkList pId uId = getOrMkList pId uId =
maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
where where
mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkNode NodeList pId uId mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkNode NodeList pId uId
mkList :: HasNodeError err
=> ParentId
-> UserId
-> Cmd err [ListId]
mkList pId uId = mkNode NodeList pId uId
-- | TODO remove defaultList -- | TODO remove defaultList
defaultList :: HasNodeError err => CorpusId -> Cmd err ListId defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
defaultList cId = defaultList cId =
......
...@@ -376,8 +376,9 @@ instance Arbitrary HyperdataCorpus where ...@@ -376,8 +376,9 @@ instance Arbitrary HyperdataCorpus where
------------------------------------------------------------------------ ------------------------------------------------------------------------
data HyperdataList = HyperdataList {hd_list :: !(Maybe Text) data HyperdataList =
} deriving (Show, Generic) HyperdataList { hd_list :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hd_") ''HyperdataList) $(deriveJSON (unPrefix "hd_") ''HyperdataList)
instance Hyperdata HyperdataList instance Hyperdata HyperdataList
...@@ -412,10 +413,11 @@ instance Arbitrary HyperdataList' where ...@@ -412,10 +413,11 @@ instance Arbitrary HyperdataList' where
-} -}
---- ----
data HyperdataListModel = HyperdataListModel { _hlm_params :: !(Int, Int) data HyperdataListModel =
, _hlm_path :: !Text HyperdataListModel { _hlm_params :: !(Int, Int)
, _hlm_score :: !(Maybe Double) , _hlm_path :: !Text
} deriving (Show, Generic) , _hlm_score :: !(Maybe Double)
} deriving (Show, Generic)
instance Hyperdata HyperdataListModel instance Hyperdata HyperdataListModel
instance Arbitrary HyperdataListModel where instance Arbitrary HyperdataListModel where
...@@ -432,7 +434,6 @@ $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore) ...@@ -432,7 +434,6 @@ $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
instance Hyperdata HyperdataScore instance Hyperdata HyperdataScore
------------------------------------------------------------------------ ------------------------------------------------------------------------
data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text) data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: !(Maybe Text)
} deriving (Show, Generic) } deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource) $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
...@@ -448,7 +449,6 @@ $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard) ...@@ -448,7 +449,6 @@ $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
instance Hyperdata HyperdataDashboard instance Hyperdata HyperdataDashboard
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO add the Graph Structure here -- TODO add the Graph Structure here
data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text) data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: !(Maybe Text)
, hyperdataPhylo_data :: !(Maybe Phylo) , hyperdataPhylo_data :: !(Maybe Phylo)
...@@ -475,8 +475,6 @@ $(deriveJSON (unPrefix "hd_") ''HyperData) ...@@ -475,8 +475,6 @@ $(deriveJSON (unPrefix "hd_") ''HyperData)
instance Hyperdata HyperData instance Hyperdata HyperData
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Then a Node can be either a Folder or a Corpus or a Document -- | Then a Node can be either a Folder or a Corpus or a Document
data NodeType = NodeUser data NodeType = NodeUser
......
...@@ -17,20 +17,20 @@ Portability : POSIX ...@@ -17,20 +17,20 @@ Portability : POSIX
module Gargantext.Text.List module Gargantext.Text.List
where where
import Data.Either (partitionEithers, Either(..)) -- import Data.Either (partitionEithers, Either(..))
import Data.Map (Map) import Data.Map (Map)
import Data.Set (Set) import Data.Set (Set)
import Data.Text (Text) import Data.Text (Text)
import Gargantext.API.Ngrams (NgramsElement, mkNgramsElement, RootParent(..), mSetFromList) import Gargantext.API.Ngrams (NgramsElement, mkNgramsElement, RootParent(..), mSetFromList)
import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..)) -- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId, NodeId) import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
import Gargantext.Database.Action.Metrics.NgramsByNode (getTficf, sortTficf, ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith) import Gargantext.Database.Action.Metrics.NgramsByNode (getTficf, sortTficf, ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith)
import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Admin.Utils (Cmd)
import Gargantext.Database.Schema.Ngrams (NgramsType(..)) import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Text.List.Learn (Model(..)) import Gargantext.Text.List.Learn (Model(..))
import Gargantext.Text.Metrics (takeScored) -- import Gargantext.Text.Metrics (takeScored)
import qualified Data.Char as Char import qualified Data.Char as Char
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map import qualified Data.Map as Map
...@@ -78,17 +78,20 @@ buildNgramsOthersList uCid groupIt nt = do ...@@ -78,17 +78,20 @@ buildNgramsOthersList uCid groupIt nt = do
let let
listSize = 9 listSize = 9
all' = List.reverse $ List.sortOn (Set.size . snd . snd) $ Map.toList ngs all' = List.reverse $ List.sortOn (Set.size . snd . snd) $ Map.toList ngs
graphTerms = List.take listSize all' graphTerms = List.take listSize all'
candiTerms = List.drop listSize all' candiTerms = List.drop listSize all'
pure $ Map.unionsWith (<>) [ toElements GraphTerm graphTerms pure $ Map.unionsWith (<>) [ toElements GraphTerm graphTerms
, toElements CandidateTerm candiTerms] , toElements CandidateTerm candiTerms
]
where where
toElements nType x = Map.fromList [(nt, [ mkNgramsElement t nType Nothing (mSetFromList []) toElements nType x =
| (t,_ns) <- x Map.fromList [(nt, [ mkNgramsElement t nType Nothing (mSetFromList [])
] | (t,_ns) <- x
) ]
] )]
{- {-
buildNgramsTermsList' :: UserCorpusId buildNgramsTermsList' :: UserCorpusId
...@@ -121,9 +124,9 @@ buildNgramsTermsList' uCid groupIt stop gls is = do ...@@ -121,9 +124,9 @@ buildNgramsTermsList' uCid groupIt stop gls is = do
let ngs' = List.concat let ngs' = List.concat
$ map toNgramsElement $ map toNgramsElement
$ map (\t -> (StopTerm, toList' t)) s $ map (\t -> (StopTerm , toList' t)) s
<> map (\t -> (CandidateTerm, toList' t)) c <> map (\t -> (CandidateTerm, toList' t)) c
<> map (\t -> (GraphTerm, toList' t)) m <> map (\t -> (GraphTerm , toList' t)) m
pure $ Map.fromList [(NgramsTerms, ngs')] pure $ Map.fromList [(NgramsTerms, ngs')]
-} -}
......
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