diff --git a/src/Gargantext/Core/Text/Group.hs b/src/Gargantext/Core/Text/Group.hs
index 124b75e7681c3d5093e5eed2a2ee708ae5ef66e4..13ef21e1b23dc3e2b0f4014ac496f98ad5e91dbe 100644
--- a/src/Gargantext/Core/Text/Group.hs
+++ b/src/Gargantext/Core/Text/Group.hs
@@ -20,10 +20,9 @@ import Data.Map (Map)
import Data.Text (Text)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text (size)
-import Gargantext.Core.Types (ListType(..))
+import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId)
import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Core.Text.List.Learn (Model(..))
-import Gargantext.Core.Types (MasterCorpusId, UserCorpusId)
+-- import Gargantext.Core.Text.List.Learn (Model(..))
import Gargantext.Core.Text.Terms.Mono.Stem (stem)
import Gargantext.Prelude
import qualified Data.Set as Set
@@ -31,7 +30,7 @@ import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.Text as Text
-
+{-
data NgramsListBuilder = BuilderStepO { stemSize :: !Int
, stemX :: !Int
, stopSize :: !StopSize
@@ -45,6 +44,7 @@ data NgramsListBuilder = BuilderStepO { stemSize :: !Int
, nlb_userCorpusId :: !UserCorpusId
, nlb_masterCorpusId :: !MasterCorpusId
}
+-}
data StopSize = StopSize {unStopSize :: !Int}
@@ -52,13 +52,12 @@ data StopSize = StopSize {unStopSize :: !Int}
-- discussed. Main purpose of this is offering
-- a first grouping option to user and get some
-- enriched data to better learn and improve that algo
-
data GroupParams = GroupParams { unGroupParams_lang :: !Lang
, unGroupParams_len :: !Int
, unGroupParams_limit :: !Int
, unGroupParams_stopSize :: !StopSize
}
- | GroupIdentity
+ | GroupIdentity
ngramsGroup :: GroupParams
-> Text
@@ -72,7 +71,7 @@ ngramsGroup (GroupParams l _m _n _) = Text.intercalate " "
. Text.splitOn " "
. Text.replace "-" " "
-------------------------------------------------------------------------------
+------------------------------------------------------------------------
toGroupedText :: Ord b
=> (Text -> Text)
-> (a -> b)
@@ -108,7 +107,7 @@ groupStems' = Map.fromListWith grouping
gr = Set.union group1 group2
nodes = Set.union nodes1 nodes2
-------------------------------------------------------------------------------
+------------------------------------------------------------------------
type Group = Lang -> Int -> Int -> Text -> Text
type Stem = Text
type Label = Text
@@ -137,18 +136,15 @@ instance (Eq a, Ord a) => Ord (GroupedText a) where
-- Lenses Instances
makeLenses 'GroupedText
-------------------------------------------------------------------------------
+------------------------------------------------------------------------
addListType :: Map Text ListType -> GroupedText a -> GroupedText a
addListType m g = set gt_listType (hasListType m g) g
where
hasListType :: Map Text ListType -> GroupedText a -> Maybe ListType
hasListType m' (GroupedText _ label _ g' _ _ _) =
- List.foldl' (<>) Nothing
+ List.foldl' (<>) Nothing
$ map (\t -> Map.lookup t m')
$ Set.toList
$ Set.insert label g'
-
-
-
diff --git a/src/Gargantext/Core/Text/List/Social.hs b/src/Gargantext/Core/Text/List/Social.hs
index 6b0d4bc7e542f4a20f7b4c29d1229378b5fedfa3..77abb3c8088d2e09ee9c04c9a7b2dadef228b2ba 100644
--- a/src/Gargantext/Core/Text/List/Social.hs
+++ b/src/Gargantext/Core/Text/List/Social.hs
@@ -35,6 +35,7 @@ import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
+------------------------------------------------------------------------
flowSocialList :: ( RepoCmdM env err m
, CmdM env err m
, HasNodeError err
@@ -108,7 +109,7 @@ flowSocialListByMode mode user nt ngrams' = do
-- printDebug "flowSocialListByMode r" r
pure r
----------------------------------------------------------------------------
+------------------------------------------------------------------------
-- TODO: maybe use social groups too
toSocialList :: Map Text (Map ListType Int)
-> Set Text
@@ -141,7 +142,7 @@ toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
, (StopTerm , 3)
]
----------------------------------------------------------------------------
+------------------------------------------------------------------------
-- | [ListId] does not merge the lists (it is for Master and User lists
-- here we need UserList only
countFilterList :: RepoCmdM env err m
@@ -161,14 +162,60 @@ countFilterList' st nt ls input = do
-- printDebug "countFilterList'" ml
pure $ Set.foldl' (\m t -> countList t ml m) input st
----------------------------------------------------------------------------
+------------------------------------------------------------------------
-- FIXME children have to herit the ListType of the parent
toMapTextListType :: Map Text NgramsRepoElement -> Map Text ListType
toMapTextListType m = Map.fromListWith (<>)
- $ List.concat
- $ (map (toList m))
- $ Map.toList m
+ $ List.concat
+ $ map (toList m)
+ $ Map.toList m
+
+----------------------
+type Parent = Text
+
+hasParent :: Text
+ -> Map Text (Map Parent Int)
+ -> Maybe Parent
+hasParent t m = case Map.lookup t m of
+ Nothing -> Nothing
+ Just m' -> (fst . fst) <$> Map.maxViewWithKey m'
+
+
+toMapTextParent :: Set Text
+ -> Map Text (Map Parent Int)
+ -> [Map Text NgramsRepoElement]
+ -> Map Text (Map Parent Int)
+toMapTextParent ts = foldl' (toMapTextParent' ts)
+ where
+
+ toMapTextParent' :: Set Text
+ -> Map Text (Map Parent Int)
+ -> Map Text NgramsRepoElement
+ -> Map Text (Map Parent Int)
+ toMapTextParent' ts' to from = Set.foldl' (toMapTextParent'' from) to ts'
+
+
+ toMapTextParent'' :: Map Text NgramsRepoElement
+ -> Map Text (Map Parent Int)
+ -> Text
+ -> Map Text (Map Parent Int)
+ toMapTextParent'' from to t = case Map.lookup t from of
+ Nothing -> to
+ Just nre -> case _nre_parent nre of
+ Just (NgramsTerm p') -> Map.alter (addParent p') t to
+ where
+ addParent p'' Nothing = Just $ addCountParent p'' Map.empty
+ addParent p'' (Just ps) = Just $ addCountParent p'' ps
+ _ -> to
+
+addCountParent :: Parent -> Map Parent Int -> Map Parent Int
+addCountParent p m = Map.alter addCount p m
+ where
+ addCount Nothing = Just 1
+ addCount (Just n) = Just $ n + 1
+
+------------------------------------------------------------------------
toList :: Map Text NgramsRepoElement -> (Text, NgramsRepoElement) -> [(Text, ListType)]
toList m (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) =
List.zip terms (List.cycle [lt'])
@@ -184,9 +231,10 @@ listOf m ng = case _nre_parent ng of
Nothing -> _nre_list ng
Just p -> case Map.lookup (unNgramsTerm p) m of
Just ng' -> listOf m ng'
- Nothing -> panic "CandidateTerm -- Should Not happen"
+ Nothing -> CandidateTerm
+ -- panic "[G.C.T.L.Social.listOf] Nothing: Should Not happen"
----------------------------------------------------------------------------
+------------------------------------------------------------------------
countList :: Text
-> Map Text ListType
-> Map Text (Map ListType Int)
@@ -195,11 +243,11 @@ countList t m input = case Map.lookup t m of
Nothing -> input
Just l -> Map.alter addList t input
where
- addList Nothing = Just $ addCount l Map.empty
- addList (Just lm) = Just $ addCount l lm
+ addList Nothing = Just $ addCountList l Map.empty
+ addList (Just lm) = Just $ addCountList l lm
-addCount :: ListType -> Map ListType Int -> Map ListType Int
-addCount l m = Map.alter (plus l) l m
+addCountList :: ListType -> Map ListType Int -> Map ListType Int
+addCountList l m = Map.alter (plus l) l m
where
plus CandidateTerm Nothing = Just 1
plus CandidateTerm (Just x) = Just $ x + 1
@@ -228,5 +276,3 @@ findNodes' Public r = findNodes Public r $ [NodeFolderPublic ] <> commonNodes
commonNodes:: [NodeType]
commonNodes = [NodeFolder, NodeCorpus, NodeList]
-
-