src/Gargantext/Database/Action/Learn.hs

   1 {-|
   2 Module      : Gargantext.Database.Learn
   3 Description : Learn Small Data Analytics with big data connection (DB)
   4 opyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE QuasiQuotes       #-}
  13 {-# LANGUAGE MonoLocalBinds    #-}
  14
  15 module Gargantext.Database.Action.Learn
  16   where
  17
  18 import Data.Maybe
  19 import Data.Text (Text)
  20 import Data.Tuple (snd)
  21 import Gargantext.Core.Types (Offset, Limit)
  22 import Gargantext.Database.Query.Facet
  23 import Gargantext.Database.Admin.Types.Hyperdata
  24 import Gargantext.Database.Admin.Types.Node
  25 import Gargantext.Database.Prelude (Cmd)
  26 import Gargantext.Prelude
  27 import Gargantext.Text.Learn
  28 import qualified Data.List as List
  29 import qualified Data.Text as Text
  30
  31 data FavOrTrash = IsFav | IsTrash
  32   deriving (Eq)
  33
  34
  35 moreLike :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
  36          -> FavOrTrash -> Cmd err [FacetDoc]
  37 moreLike cId o l order ft = do
  38   priors <- getPriors ft cId
  39   moreLikeWith cId o l order ft priors
  40
  41 ---------------------------------------------------------------------------
  42 getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)
  43 getPriors ft cId = do
  44
  45   docs_fav   <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 2)
  46               <$> runViewDocuments cId False Nothing Nothing Nothing
  47
  48   docs_trash <- List.take (List.length docs_fav)
  49             <$> runViewDocuments cId True Nothing Nothing Nothing
  50
  51
  52   let priors = priorEventsWith text (fav2bool ft) (  List.zip (repeat False) docs_fav
  53                                       <> List.zip (repeat True ) docs_trash
  54                                       )
  55   pure priors
  56
  57
  58 moreLikeWith :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
  59              -> FavOrTrash -> Events Bool  -> Cmd err [FacetDoc]
  60 moreLikeWith cId o l order ft priors = do
  61
  62   docs_test  <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 1)
  63             <$> runViewDocuments cId False o Nothing order
  64
  65   let results = map fst
  66        $ filter ((==) (Just $ not $ fav2bool ft) . snd)
  67        $ map (\f -> (f, detectDefaultWithPriors text priors f)) docs_test
  68
  69   pure $ List.take (maybe 10 identity l) results
  70
  71 ---------------------------------------------------------------------------
  72 fav2bool :: FavOrTrash -> Bool
  73 fav2bool ft = if (==) ft IsFav then True else False
  74
  75
  76 text :: FacetDoc -> Text
  77 text (FacetDoc _ _ _ h _ _)  = title <> "" <> Text.take 100 abstr
  78   where
  79     title = maybe "" identity (_hyperdataDocument_title    h)
  80     abstr = maybe "" identity (_hyperdataDocument_abstract h)
  81
  82 ---------------------------------------------------------------------------
  83
  84 {-
  85 apply :: (FlowCmdM env e m) => FavOrTrash -> CorpusId -> [NodeId] -> m [Int]
  86 apply favTrash cId ns = case favTrash of
  87       IsFav   -> nodeNodesCategory $ map (\n -> (cId, n, 2)) ns
  88       IsTrash -> nodeNodesCategory $ map (\n -> (cId, n, 0)) ns
  89
  90 moreLikeAndApply :: FlowCmdM DevEnv GargError m => FavOrTrash -> CorpusId -> m [Int]
  91 moreLikeAndApply ft cId = do
  92   priors <- getPriors ft cId
  93   moreLikeWithAndApply priors ft cId
  94
  95 moreLikeWithAndApply :: FlowCmdM DevEnv GargError m => Events Bool -> FavOrTrash -> CorpusId -> m [Int]
  96 moreLikeWithAndApply priors ft cId = do
  97   ids <- map facetDoc_id <$> moreLikeWith cId ft priors
  98   apply ft cId ids
  99 -}