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