src/Gargantext/Core/Text/List/Social.hs

   1 {-|
   2 Module      : Gargantext.Core.Text.List.Social
   3 Description :
   4 Copyright   : (c) CNRS, 2018-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 module Gargantext.Core.Text.List.Social
  12   where
  13
  14 import Data.Map (Map)
  15 import Data.Maybe (fromMaybe)
  16 import Data.Semigroup (Semigroup(..))
  17 import Data.Set (Set)
  18 import Data.Text (Text)
  19 import Gargantext.API.Ngrams.Tools -- (getListNgrams)
  20 import Gargantext.API.Ngrams.Types
  21 import Gargantext.Core.Text.List.Social.Find
  22 import Gargantext.Core.Text.List.Social.ListType
  23 import Gargantext.Core.Text.List.Social.Prelude
  24 import Gargantext.Core.Text.List.Social.Scores
  25 import Gargantext.Core.Types.Individu
  26 import Gargantext.Core.Types.Main
  27 import Gargantext.Database.Admin.Types.Node
  28 import Gargantext.Database.Prelude
  29 import Gargantext.Database.Query.Table.Node.Error
  30 import Gargantext.Database.Query.Tree
  31 import Gargantext.Database.Schema.Ngrams
  32 import Gargantext.Prelude
  33 import qualified Data.Map   as Map
  34 import qualified Data.Set   as Set
  35
  36 ------------------------------------------------------------------------
  37 flowSocialList :: ( RepoCmdM env err m
  38                   , CmdM     env err m
  39                   , HasNodeError err
  40                   , HasTreeError err
  41                   )
  42                   => User -> NgramsType -> Set Text
  43                   -> m (Map ListType (Set Text))
  44 flowSocialList user nt ngrams' = do
  45   -- Here preference to privateLists (discutable: let user choice)
  46   privateListIds <- findListsId user Private
  47   privateLists <- flowSocialListByMode privateListIds nt ngrams'
  48   -- printDebug "* privateLists *: \n" privateLists
  49
  50   sharedListIds <- findListsId user Shared
  51   sharedLists  <- flowSocialListByMode sharedListIds nt (termsByList CandidateTerm privateLists)
  52   -- printDebug "* sharedLists *: \n" sharedLists
  53
  54   -- TODO publicMapList:
  55   -- Note: if both produce 3 identic repetition => refactor mode
  56   -- publicListIds <- findListsId Public user
  57   -- publicLists   <- flowSocialListByMode' publicListIds nt (termsByList CandidateTerm privateLists)
  58
  59   let result = parentUnionsExcl
  60              [ Map.mapKeys (fromMaybe CandidateTerm) privateLists
  61              , Map.mapKeys (fromMaybe CandidateTerm) sharedLists
  62              -- , Map.mapKeys (fromMaybe CandidateTerm) publicLists
  63              ]
  64   -- printDebug "* socialLists *: results \n" result
  65   pure result
  66
  67 ------------------------------------------------------------------------
  68 ------------------------------------------------------------------------
  69 -- | FlowSocialListPriority
  70 -- Sociological assumption: either private or others (public) first
  71 -- This parameter depends on the user choice
  72 data FlowSocialListPriority = MySelfFirst | OthersFirst
  73
  74 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
  75 flowSocialListPriority MySelfFirst = [Private, Shared{-, Public -}]
  76 flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
  77
  78 ------------------------------------------------------------------------
  79 flowSocialList' :: ( RepoCmdM env err m
  80                    , CmdM     env err m
  81                    , HasNodeError err
  82                    , HasTreeError err
  83                    )
  84                   => FlowSocialListPriority
  85                   -> User -> NgramsType -> Set Text
  86                   -> m (Map Text FlowListScores)
  87 flowSocialList' flowPriority user nt ngrams' =
  88   parentUnionsExcl <$> mapM (flowSocialListByMode' user nt ngrams')
  89                             (flowSocialListPriority flowPriority)
  90
  91 ------------------------------------------------------------------------
  92 flowSocialListByMode :: ( RepoCmdM env err m
  93                         , CmdM     env err m
  94                         , HasNodeError err
  95                         , HasTreeError err
  96                         )
  97                      => [NodeId]-> NgramsType -> Set Text
  98                      -> m (Map (Maybe ListType) (Set Text))
  99 flowSocialListByMode      [] _nt ngrams' = pure $ Map.fromList [(Nothing, ngrams')]
 100 flowSocialListByMode listIds  nt ngrams' = do
 101     counts  <- countFilterList ngrams' nt listIds Map.empty
 102     let r = toSocialList counts ngrams'
 103     pure r
 104
 105
 106 flowSocialListByMode' :: ( RepoCmdM env err m
 107                          , CmdM     env err m
 108                          , HasNodeError err
 109                          , HasTreeError err
 110                          )
 111                       => User -> NgramsType -> Set Text -> NodeMode
 112                       -> m (Map Text FlowListScores)
 113 flowSocialListByMode' user nt st mode =
 114       findListsId user mode
 115   >>= flowSocialListByModeWith nt st
 116
 117
 118 flowSocialListByModeWith :: ( RepoCmdM env err m
 119                             , CmdM     env err m
 120                             , HasNodeError err
 121                             , HasTreeError err
 122                             )
 123                          => NgramsType -> Set Text -> [NodeId]
 124                          -> m (Map Text FlowListScores)
 125 flowSocialListByModeWith nt st ns =
 126       mapM (\l -> getListNgrams [l] nt) ns
 127   >>= pure
 128     . toFlowListScores (keepAllParents nt) st Map.empty
 129
 130
 131 -- | We keep the parents for all ngrams but terms
 132 keepAllParents :: NgramsType -> KeepAllParents
 133 keepAllParents NgramsTerms = KeepAllParents False
 134 keepAllParents _           = KeepAllParents True
 135
 136 ------------------------------------------------------------------------
 137 -- | Choice depends on Ord instance of ListType
 138 -- for now : data ListType  =  StopTerm | CandidateTerm | MapTerm
 139 -- means MapTerm > CandidateTerm > StopTerm in case of equality of counts
 140 -- (we minimize errors on MapTerms if doubt)
 141 --  * TODO what if equality ?
 142 --  * TODO maybe use social groups too
 143 toSocialList :: Map Text (Map ListType Int)
 144              -> Set Text
 145              -> Map (Maybe ListType) (Set Text)
 146 toSocialList m = Map.fromListWith (<>)
 147                . Set.toList
 148                . Set.map (toSocialList1 m)
 149
 150 toSocialList1 :: Map Text (Map ListType Int)
 151              -> Text
 152              -> (Maybe ListType, Set Text)
 153 toSocialList1 m t = case Map.lookup t m of
 154   Nothing -> (Nothing, Set.singleton t)
 155   Just  m' -> ( (fst . fst) <$> Map.maxViewWithKey m'
 156               , Set.singleton t
 157               )
 158
 159 toSocialList1_testIsTrue :: Bool
 160 toSocialList1_testIsTrue = result == (Just MapTerm, Set.singleton token)
 161   where
 162     result = toSocialList1 (Map.fromList [(token, m)]) token
 163     token  = "token"
 164     m = Map.fromList [ (CandidateTerm, 1)
 165                      , (MapTerm      , 2)
 166                      , (StopTerm     , 3)
 167                      ]
 168
 169