2 Module : Gargantext.Core.Text.List.Social
4 Copyright : (c) CNRS, 2018-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
11 module Gargantext.Core.Text.List.Social
15 import Gargantext.Core.Types.Individu
16 import Gargantext.Database.Admin.Config
17 import Gargantext.Database.Admin.Types.Node
18 import Gargantext.Database.Prelude
19 import Gargantext.Database.Query.Table.Node.Error
20 import Gargantext.Database.Query.Tree
21 import Gargantext.Database.Query.Tree.Root (getRootId)
22 import Gargantext.Prelude
25 import Data.Maybe (fromMaybe)
28 import Data.Semigroup (Semigroup(..))
29 import Data.Text (Text)
30 import Gargantext.API.Ngrams.Tools -- (getListNgrams)
31 import Gargantext.API.Ngrams.Types
32 import Gargantext.Core.Types.Main
33 import Gargantext.Database.Schema.Ngrams
34 import Gargantext.Core.Text.List.Social.Find
35 import Gargantext.Core.Text.List.Social.Group
36 import Gargantext.Core.Text.List.Social.ListType
37 import qualified Data.List as List
38 import qualified Data.Map as Map
39 import qualified Data.Set as Set
41 ------------------------------------------------------------------------
42 flowSocialList :: ( RepoCmdM env err m
47 => User -> NgramsType -> Set Text
48 -> m (Map ListType (Set Text))
49 flowSocialList user nt ngrams' = do
50 -- Here preference to privateLists (discutable: let user choice)
51 privateListIds <- findListsId Private user
52 privateLists <- flowSocialListByMode privateListIds nt ngrams'
53 -- printDebug "* privateLists *: \n" privateLists
55 sharedListIds <- findListsId Shared user
56 sharedLists <- flowSocialListByMode sharedListIds nt (termsByList CandidateTerm privateLists)
57 -- printDebug "* sharedLists *: \n" sharedLists
59 -- TODO publicMapList:
60 -- Note: if both produce 3 identic repetition => refactor mode
61 -- publicListIds <- findListsId Public user
62 -- publicLists <- flowSocialListByMode' publicListIds nt (termsByList CandidateTerm privateLists)
64 let result = unions [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
65 , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
66 -- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
68 -- printDebug "* socialLists *: results \n" result
71 ------------------------------------------------------------------------
72 flowSocialListByMode :: ( RepoCmdM env err m
77 => [NodeId]-> NgramsType -> Set Text
78 -> m (Map (Maybe ListType) (Set Text))
79 flowSocialListByMode [] nt ngrams' = pure $ Map.fromList [(Nothing, ngrams')]
80 flowSocialListByMode listIds nt ngrams' = do
81 counts <- countFilterList ngrams' nt listIds Map.empty
82 let r = toSocialList counts ngrams'
86 ------------------------------------------------------------------------
87 -- TODO: maybe use social groups too
88 -- | TODO what if equality ?
89 -- choice depends on Ord instance of ListType
90 -- for now : data ListType = StopTerm | CandidateTerm | MapTerm
91 -- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
92 -- (we minimize errors on MapTerms if doubt)
93 toSocialList :: Map Text (Map ListType Int)
95 -> Map (Maybe ListType) (Set Text)
96 toSocialList m = Map.fromListWith (<>)
98 . Set.map (toSocialList1 m)
100 toSocialList1 :: Map Text (Map ListType Int)
102 -> (Maybe ListType, Set Text)
103 toSocialList1 m t = case Map.lookup t m of
104 Nothing -> (Nothing, Set.singleton t)
105 Just m' -> ( (fst . fst) <$> Map.maxViewWithKey m'
109 toSocialList1_testIsTrue :: Bool
110 toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
112 result = toSocialList1 (Map.fromList [(token, m)]) token
114 m = Map.fromList [ (CandidateTerm, 1)
119 ------------------------------------------------------------------------
122 ------------------------------------------------------------------------
123 termsByList :: ListType -> (Map (Maybe ListType) (Set Text)) -> Set Text
124 termsByList CandidateTerm m = Set.unions
125 $ map (\lt -> fromMaybe Set.empty $ Map.lookup lt m)
126 [ Nothing, Just CandidateTerm ]
128 fromMaybe Set.empty $ Map.lookup (Just l) m
130 ------------------------------------------------------------------------
133 unions :: (Ord a, Semigroup a, Semigroup b, Ord b)
134 => [Map a (Set b)] -> Map a (Set b)
135 unions = invertBack . Map.unionsWith (<>) . map invertForw
137 invertForw :: (Ord b, Semigroup a) => Map a (Set b) -> Map b a
138 invertForw = Map.unionsWith (<>)
139 . (map (\(k,sets) -> Map.fromSet (\_ -> k) sets))
142 invertBack :: (Ord a, Ord b) => Map b a -> Map a (Set b)
143 invertBack = Map.fromListWith (<>)
144 . (map (\(b,a) -> (a, Set.singleton b)))
147 unions_test :: Map ListType (Set Text)
148 unions_test = unions [m1, m2]
150 m1 = Map.fromList [ (StopTerm , Set.singleton "Candidate")]
151 m2 = Map.fromList [ (CandidateTerm, Set.singleton "Candidate")
152 , (MapTerm , Set.singleton "Candidate")