src/Gargantext/Database/Learn.hs

   1 {-|
   2 Module      : Gargantext.Database.Learn
   3 Description : Learn Small Data Analytics with big data connection (DB)
   4 Copyright   : (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
  17 module Gargantext.Database.Learn where
  18
  19 import Data.Text (Text)
  20 import Data.Tuple (snd)
  21 import Data.Maybe
  22 import Gargantext.Database.Facet
  23 import Gargantext.Database.Types.Node
  24 import Gargantext.Prelude
  25 import Gargantext.Text.Learn
  26 import qualified Data.List as List
  27 import qualified Data.Text as Text
  28 import Gargantext.Database.Schema.NodeNode (nodesToFavorite)
  29 import Gargantext.API.Node (delDocs, Documents(..))
  30 import Gargantext.Database.Utils (Cmd)
  31 import Gargantext.Database.Schema.Node (HasNodeError)
  32
  33 text :: FacetDoc -> (NodeId, Text)
  34 text (FacetDoc nId _ _ h _ _)  = (nId, title <> "" <> Text.take 100 abstr)
  35   where
  36     title = maybe "" identity (_hyperdataDocument_title    h)
  37     abstr = maybe "" identity (_hyperdataDocument_abstract h)
  38
  39 --moreLike docs_fav docs_trash docs_test = do
  40 data FavTrash = IsFav | IsTrash
  41   deriving (Eq)
  42
  43 moreLike :: HasNodeError err => FavTrash -> CorpusId -> Cmd err [(NodeId, Maybe Bool)]
  44 moreLike ft cId = do
  45   let b = if (==) ft IsFav then True else False
  46
  47   docs_trash <- map text <$> runViewDocuments cId True Nothing Nothing Nothing
  48   docs_fav   <- map text <$> filter (\(FacetDoc _ _ _ _ f _) -> f == True)  <$> runViewDocuments cId False Nothing Nothing Nothing
  49   docs_test  <- map text <$> filter (\(FacetDoc _ _ _ _ f _) -> f == False) <$> runViewDocuments cId False Nothing Nothing Nothing
  50
  51   let priors = priorEventsWith snd b (  List.zip (repeat False) docs_fav
  52                                      <> List.zip (repeat True ) docs_trash
  53                                      )
  54
  55   pure $ filter ((==) (Just $ not b) . snd) $ map (\x -> (fst x, detectDefaultWithPriors snd priors x)) docs_test
  56
  57 learnModify :: HasNodeError err => FavTrash -> CorpusId -> [NodeId] -> Cmd err [Int]
  58 learnModify favTrash cId ns = case favTrash of
  59       IsFav   -> nodesToFavorite $ map (\n -> (cId, n, True)) ns
  60       IsTrash -> delDocs cId (Documents ns)
  61
  62 learnAndApply :: HasNodeError err => FavTrash -> CorpusId -> Cmd err [Int]
  63 learnAndApply ft cId = do
  64   ids <- map fst <$> moreLike ft cId
  65   learnModify ft cId ids
  66
  67
  68