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