import Gargantext.Core.Text.Metrics (scored', Scored(..), scored_speExc, scored_genInc, normalizeGlobal, normalizeLocal, scored_terms)
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, getNodesByNgramsOnlyUser)
+import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsUser, getContextsByNgramsOnlyUser)
import Gargantext.Database.Action.Metrics.TFICF (getTficf_withSample)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (CmdM)
, HasTreeError err
, HasNodeError err
)
- => GroupParams
- -> User
+ => User
-> UserCorpusId
-> MasterCorpusId
+ -> Maybe FlowSocialListWith
+ -> GroupParams
-> m (Map NgramsType [NgramsElement])
-buildNgramsLists gp user uCid mCid = do
- ngTerms <- buildNgramsTermsList user uCid mCid gp (NgramsTerms, MapListSize 350)
- othersTerms <- mapM (buildNgramsOthersList user uCid GroupIdentity)
- [ (Authors , MapListSize 9)
- , (Sources , MapListSize 9)
- , (Institutes, MapListSize 9)
+buildNgramsLists user uCid mCid mfslw gp = do
+ ngTerms <- buildNgramsTermsList user uCid mCid mfslw gp (NgramsTerms, MapListSize 350)
+ othersTerms <- mapM (buildNgramsOthersList user uCid mfslw GroupIdentity)
+ [ (Authors , MapListSize 9, MaxListSize 1000)
+ , (Sources , MapListSize 9, MaxListSize 1000)
+ , (Institutes, MapListSize 9, MaxListSize 1000)
]
pure $ Map.unions $ [ngTerms] <> othersTerms
data MapListSize = MapListSize { unMapListSize :: !Int }
-
-buildNgramsOthersList ::( HasNodeError err
- , CmdM env err m
- , HasNodeStory env err m
- , HasTreeError err
- )
- => User
- -> UserCorpusId
- -> GroupParams
- -> (NgramsType, MapListSize)
- -> m (Map NgramsType [NgramsElement])
-buildNgramsOthersList user uCid _groupParams (nt, MapListSize mapListSize) = do
- allTerms :: HashMap NgramsTerm (Set NodeId) <- getNodesByNgramsUser uCid nt
+data MaxListSize = MaxListSize { unMaxListSize :: !Int }
+
+buildNgramsOthersList :: ( HasNodeError err
+ , CmdM env err m
+ , HasNodeStory env err m
+ , HasTreeError err
+ )
+ => User
+ -> UserCorpusId
+ -> Maybe FlowSocialListWith
+ -> GroupParams
+ -> (NgramsType, MapListSize, MaxListSize)
+ -> m (Map NgramsType [NgramsElement])
+buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize, MaxListSize maxListSize) = do
+ allTerms :: HashMap NgramsTerm (Set NodeId) <- getContextsByNgramsUser uCid nt
-- PrivateFirst for first developments since Public NodeMode is not implemented yet
socialLists :: FlowCont NgramsTerm FlowListScores
- <- flowSocialList MySelfFirst user nt ( FlowCont HashMap.empty
+ <- flowSocialList mfslw user nt ( FlowCont HashMap.empty
$ HashMap.fromList
$ List.zip (HashMap.keys allTerms)
(List.cycle [mempty])
- )
+ )
let
groupedWithList = toGroupedTree {- groupParams -} socialLists allTerms
listSize = mapListSize - (List.length mapTerms)
(mapTerms', candiTerms) = both HashMap.fromList
$ List.splitAt listSize
+ $ List.take maxListSize
$ List.sortOn (Down . viewScore . snd)
$ HashMap.toList tailTerms'
- pure $ Map.fromList [( nt, (toNgramsElement stopTerms)
+ pure $ Map.fromList [( nt, List.take maxListSize $ (toNgramsElement stopTerms)
<> (toNgramsElement mapTerms )
<> (toNgramsElement $ setListType (Just MapTerm ) mapTerms' )
<> (toNgramsElement $ setListType (Just CandidateTerm) candiTerms)
, HasNodeStory env err m
, HasTreeError err
)
- => User
- -> UserCorpusId
- -> MasterCorpusId
- -> GroupParams
- -> (NgramsType, MapListSize)
- -> m (Map NgramsType [NgramsElement])
-buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
+ => User
+ -> UserCorpusId
+ -> MasterCorpusId
+ -> Maybe FlowSocialListWith
+ -> GroupParams
+ -> (NgramsType, MapListSize)
+ -> m (Map NgramsType [NgramsElement])
+buildNgramsTermsList user uCid mCid mfslw groupParams (nt, _mapListSize)= do
-- Filter 0 With Double
-- Computing global speGen score
- printDebug "[buldNgramsTermsList: Sample List] / start" nt
+ printDebug "[buildNgramsTermsList: Sample List] / start" nt
allTerms :: HashMap NgramsTerm Double <- getTficf_withSample uCid mCid nt
- printDebug "[buldNgramsTermsList: Sample List / end]" nt
+ printDebug "[buildNgramsTermsList: Sample List / end]" (nt, HashMap.size allTerms)
- printDebug "[buldNgramsTermsList: Flow Social List / start]" nt
+ printDebug "[buildNgramsTermsList: Flow Social List / start]" nt
-- PrivateFirst for first developments since Public NodeMode is not implemented yet
socialLists :: FlowCont NgramsTerm FlowListScores
- <- flowSocialList MySelfFirst user nt ( FlowCont HashMap.empty
+ <- flowSocialList mfslw user nt ( FlowCont HashMap.empty
$ HashMap.fromList
$ List.zip (HashMap.keys allTerms)
(List.cycle [mempty])
- )
- printDebug "[buldNgramsTermsList: Flow Social List / end]" nt
+ )
+ printDebug "[buildNgramsTermsList: Flow Social List / end]" nt
let ngramsKeys = HashMap.keysSet allTerms
userListId <- defaultList uCid
masterListId <- defaultList mCid
- mapTextDocIds <- getNodesByNgramsOnlyUser uCid
+ mapTextDocIds <- getContextsByNgramsOnlyUser uCid
[userListId, masterListId]
nt
selectedTerms
+
+ -- printDebug "mapTextDocIds" mapTextDocIds
+
let
groupedTreeScores_SetNodeId :: HashMap NgramsTerm (GroupedTreeScores (Set NodeId))
groupedTreeScores_SetNodeId = HashMap.filter (\g -> Set.size (view gts'_score g) > 1) -- removing hapax
$ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
- printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId
+ --printDebug "groupedTreeScores_SetNodeId" groupedTreeScores_SetNodeId
-- Coocurrences computation
--, t1 >= t2 -- permute byAxis diag -- since matrix symmetric
let
-- use % of list if to big, or Int if to small
mapSize = 1000 :: Double
- canSize = mapSize * 5 :: Double
+ canSize = mapSize * 2 :: Double
inclSize = 0.4 :: Double
exclSize = 1 - inclSize
<>-} groupedMultTail
-- Quick FIX
- candNgramsElement = List.take 5000
+ candNgramsElement = List.take 1000
$ toNgramsElement cands <> toNgramsElement cands'
result = Map.unionsWith (<>)