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
  16 module Gargantext.Database.Learn where
  17
  18 import Data.Text (Text)
  19 import Data.Tuple (snd)
  20 import Data.Maybe
  21 import Gargantext.Database.Facet
  22 import Gargantext.Database.Types.Node
  23 import Gargantext.Prelude
  24 import Gargantext.Text.Learn
  25 import qualified Data.List as List
  26 import qualified Data.Text as Text
  27 import Gargantext.Database.Schema.NodeNode (nodesToFavorite)
  28 import Gargantext.API.Node (delDocs, Documents(..))
  29 import Gargantext.Database.Utils (Cmd)
  30 import Gargantext.Database.Schema.Node (HasNodeError)
  31
  32 text :: FacetDoc -> (NodeId, Text)
  33 text (FacetDoc nId _ _ h _ _)  = (nId, title <> "" <> Text.take 100 abstr)
  34   where
  35     title = maybe "" identity (_hyperdataDocument_title    h)
  36     abstr = maybe "" identity (_hyperdataDocument_abstract h)
  37
  38 --moreLike docs_fav docs_trash docs_test = do
  39 data FavTrash = IsFav | IsTrash
  40   deriving (Eq)
  41
  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 --}