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 NoImplicitPrelude #-}
  13 {-# LANGUAGE QuasiQuotes       #-}
  14 {-# LANGUAGE RankNTypes        #-}
  15 {-# LANGUAGE OverloadedStrings #-}
  16 {-# LANGUAGE FlexibleContexts  #-}
  17 {-# LANGUAGE MonoLocalBinds    #-}
  18
  19 module Gargantext.Database.Action.Learn
  20   where
  21
  22 import Data.Maybe
  23 import Data.Text (Text)
  24 import Data.Tuple (snd)
  25 import Gargantext.Core.Types (Offset, Limit)
  26 import Gargantext.Database.Action.Query.Facet
  27 import Gargantext.Database.Admin.Types.Node
  28 import Gargantext.Database.Admin.Utils (Cmd)
  29 import Gargantext.Prelude
  30 import Gargantext.Text.Learn
  31 import qualified Data.List as List
  32 import qualified Data.Text as Text
  33
  34 data FavOrTrash = IsFav | IsTrash
  35   deriving (Eq)
  36
  37
  38 moreLike :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
  39          -> FavOrTrash -> Cmd err [FacetDoc]
  40 moreLike cId o l order ft = do
  41   priors <- getPriors ft cId
  42   moreLikeWith cId o l order ft priors
  43
  44 ---------------------------------------------------------------------------
  45 getPriors :: 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
  50
  51   docs_trash <- List.take (List.length docs_fav)
  52             <$> runViewDocuments cId True 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 :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
  62              -> FavOrTrash -> Events Bool  -> Cmd err [FacetDoc]
  63 moreLikeWith cId o l order ft priors = do
  64
  65   docs_test  <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 1)
  66             <$> runViewDocuments cId False o Nothing order
  67
  68   let results = map fst
  69        $ filter ((==) (Just $ not $ fav2bool ft) . snd)
  70        $ map (\f -> (f, detectDefaultWithPriors text priors f)) docs_test
  71
  72   pure $ List.take (maybe 10 identity l) results
  73
  74 ---------------------------------------------------------------------------
  75 fav2bool :: FavOrTrash -> Bool
  76 fav2bool ft = if (==) ft IsFav then True else False
  77
  78
  79 text :: FacetDoc -> Text
  80 text (FacetDoc _ _ _ h _ _)  = title <> "" <> Text.take 100 abstr
  81   where
  82     title = maybe "" identity (_hyperdataDocument_title    h)
  83     abstr = maybe "" identity (_hyperdataDocument_abstract h)
  84
  85 ---------------------------------------------------------------------------
  86
  87 {-
  88 apply :: (FlowCmdM env e m) => FavOrTrash -> CorpusId -> [NodeId] -> m [Int]
  89 apply favTrash cId ns = case favTrash of
  90       IsFav   -> nodeNodesCategory $ map (\n -> (cId, n, 2)) ns
  91       IsTrash -> nodeNodesCategory $ map (\n -> (cId, n, 0)) ns
  92
  93 moreLikeAndApply :: FlowCmdM DevEnv GargError m => FavOrTrash -> CorpusId -> m [Int]
  94 moreLikeAndApply ft cId = do
  95   priors <- getPriors ft cId
  96   moreLikeWithAndApply priors ft cId
  97
  98 moreLikeWithAndApply :: FlowCmdM DevEnv GargError m => Events Bool -> FavOrTrash -> CorpusId -> m [Int]
  99 moreLikeWithAndApply priors ft cId = do
 100   ids <- map facetDoc_id <$> moreLikeWith cId ft priors
 101   apply ft cId ids
 102 -}