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.Node
  24 import Gargantext.Database.Prelude (Cmd)
  25 import Gargantext.Prelude
  26 import Gargantext.Text.Learn
  27 import qualified Data.List as List
  28 import qualified Data.Text as Text
  29
  30 data FavOrTrash = IsFav | IsTrash
  31   deriving (Eq)
  32
  33
  34 moreLike :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
  35          -> FavOrTrash -> Cmd err [FacetDoc]
  36 moreLike cId o l order ft = do
  37   priors <- getPriors ft cId
  38   moreLikeWith cId o l order ft priors
  39
  40 ---------------------------------------------------------------------------
  41 getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)
  42 getPriors ft cId = do
  43
  44   docs_fav   <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 2)
  45               <$> runViewDocuments cId False Nothing Nothing Nothing
  46
  47   docs_trash <- List.take (List.length docs_fav)
  48             <$> runViewDocuments cId True Nothing Nothing Nothing
  49
  50
  51   let priors = priorEventsWith text (fav2bool ft) (  List.zip (repeat False) docs_fav
  52                                       <> List.zip (repeat True ) docs_trash
  53                                       )
  54   pure priors
  55
  56
  57 moreLikeWith :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
  58              -> FavOrTrash -> Events Bool  -> Cmd err [FacetDoc]
  59 moreLikeWith cId o l order ft priors = do
  60
  61   docs_test  <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 1)
  62             <$> runViewDocuments cId False o Nothing order
  63
  64   let results = map fst
  65        $ filter ((==) (Just $ not $ fav2bool ft) . snd)
  66        $ map (\f -> (f, detectDefaultWithPriors text priors f)) docs_test
  67
  68   pure $ List.take (maybe 10 identity l) results
  69
  70 ---------------------------------------------------------------------------
  71 fav2bool :: FavOrTrash -> Bool
  72 fav2bool ft = if (==) ft IsFav then True else False
  73
  74
  75 text :: FacetDoc -> Text
  76 text (FacetDoc _ _ _ h _ _)  = title <> "" <> Text.take 100 abstr
  77   where
  78     title = maybe "" identity (_hyperdataDocument_title    h)
  79     abstr = maybe "" identity (_hyperdataDocument_abstract h)
  80
  81 ---------------------------------------------------------------------------
  82
  83 {-
  84 apply :: (FlowCmdM env e m) => FavOrTrash -> CorpusId -> [NodeId] -> m [Int]
  85 apply favTrash cId ns = case favTrash of
  86       IsFav   -> nodeNodesCategory $ map (\n -> (cId, n, 2)) ns
  87       IsTrash -> nodeNodesCategory $ map (\n -> (cId, n, 0)) ns
  88
  89 moreLikeAndApply :: FlowCmdM DevEnv GargError m => FavOrTrash -> CorpusId -> m [Int]
  90 moreLikeAndApply ft cId = do
  91   priors <- getPriors ft cId
  92   moreLikeWithAndApply priors ft cId
  93
  94 moreLikeWithAndApply :: FlowCmdM DevEnv GargError m => Events Bool -> FavOrTrash -> CorpusId -> m [Int]
  95 moreLikeWithAndApply priors ft cId = do
  96   ids <- map facetDoc_id <$> moreLikeWith cId ft priors
  97   apply ft cId ids
  98 -}