src/Gargantext/Text/Terms.hs

   1 {-|
   2 Module      : Gargantext.Text.Ngrams
   3 Description : Ngrams definition and tools
   4 Copyright   : (c) CNRS, 2017 - present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 An @n-gram@ is a contiguous sequence of n items from a given sample of
  11 text. In Gargantext application the items are words, n is a non negative
  12 integer.
  13
  14 Using Latin numerical prefixes, an n-gram of size 1 is referred to as a
  15 "unigram"; size 2 is a "bigram" (or, less commonly, a "digram"); size
  16 3 is a "trigram". English cardinal numbers are sometimes used, e.g.,
  17 "four-gram", "five-gram", and so on.
  18
  19 Source: https://en.wikipedia.org/wiki/Ngrams
  20
  21 TODO
  22 group Ngrams -> Tree
  23 compute occ by node of Tree
  24 group occs according groups
  25
  26 compute cooccurrences
  27 compute graph
  28
  29 -}
  30
  31 {-# LANGUAGE NoImplicitPrelude #-}
  32 {-# LANGUAGE OverloadedStrings #-}
  33 {-# LANGUAGE TemplateHaskell   #-}
  34
  35 module Gargantext.Text.Terms
  36   where
  37
  38 import Control.Lens
  39 import Data.Text (Text)
  40 import Data.Traversable
  41 import GHC.Base (String)
  42
  43 import Gargantext.Prelude
  44 import Gargantext.Core
  45 import Gargantext.Core.Types
  46 import Gargantext.Text.Terms.Multi (multiterms)
  47 import Gargantext.Text.Terms.Mono  (monoTerms)
  48 import Gargantext.Text.Terms.Mono.Stem (stem)
  49
  50 import qualified Data.Set  as Set
  51 import qualified Data.List as List
  52 import qualified Data.Text as Text
  53 import Gargantext.Text (sentences)
  54 import Gargantext.Text.Terms.Mono.Token.En (tokenize)
  55 import Gargantext.Text.Terms.Eleve (mainEleveWith, Tries, Token, buildTries, toToken)
  56
  57 data TermType lang
  58   = Mono      { _tt_lang :: lang }
  59   | Multi     { _tt_lang :: lang }
  60   | MonoMulti { _tt_lang :: lang }
  61   | Unsupervised { _tt_lang  :: lang
  62                  , _tt_windoSize  :: Int
  63                  , _tt_ngramsSize :: Int
  64                  , _tt_model :: Maybe (Tries Token ())
  65   }
  66 makeLenses ''TermType
  67
  68 --group :: [Text] -> [Text]
  69 --group = undefined
  70
  71 -- remove Stop Words
  72 -- map (filter (\t -> not . elem t)) $
  73 ------------------------------------------------------------------------
  74 -- | Sugar to extract terms from text (hiddeng mapM from end user).
  75 --extractTerms :: Traversable t => TermType Lang -> t Text -> IO (t [Terms])
  76 extractTerms :: TermType Lang -> [Text] -> IO [[Terms]]
  77
  78 extractTerms (Unsupervised l n s m) xs = mapM (terms (Unsupervised l n s (Just m'))) xs
  79   where
  80     m' = case m of
  81       Just m''-> m''
  82       Nothing -> newTries n (Text.intercalate " " xs)
  83
  84 extractTerms termTypeLang xs = mapM (terms termTypeLang) xs
  85
  86
  87
  88 ------------------------------------------------------------------------
  89 -- | Terms from Text
  90 -- Mono : mono terms
  91 -- Multi : multi terms
  92 -- MonoMulti : mono and multi
  93 -- TODO : multi terms should exclude mono (intersection is not empty yet)
  94 terms :: TermType Lang -> Text -> IO [Terms]
  95 terms (Mono      lang) txt = pure $ monoTerms lang txt
  96 terms (Multi     lang) txt = multiterms lang txt
  97 terms (MonoMulti lang) txt = terms (Multi lang) txt
  98 terms (Unsupervised lang n s m) txt = termsUnsupervised (Unsupervised lang n s (Just m')) txt
  99   where
 100     m' = maybe (newTries n txt) identity m
 101 -- terms (WithList  list) txt = pure . concat $ extractTermsWithList list txt
 102 ------------------------------------------------------------------------
 103
 104 text2term :: Lang -> [Text] -> Terms
 105 text2term _ [] = Terms [] Set.empty
 106 text2term lang txt = Terms txt (Set.fromList $ map (stem lang) txt)
 107
 108 isPunctuation :: Text -> Bool
 109 isPunctuation x = List.elem x $  (Text.pack . pure)
 110                              <$> ("!?(),;." :: String)
 111
 112 -- | Unsupervised ngrams extraction
 113 -- language agnostic extraction
 114 -- TODO: remove IO
 115 -- TODO: newtype BlockText
 116
 117 type WindowSize = Int
 118 type MinNgramSize = Int
 119
 120 termsUnsupervised :: TermType Lang -> Text -> IO [Terms]
 121 termsUnsupervised (Unsupervised l n s m) =
 122                pure
 123              . map (text2term l)
 124              . List.nub
 125              . (List.filter (\l' -> List.length l' > s))
 126              . List.concat
 127              . mainEleveWith (maybe (panic "no model") identity m) n
 128              . uniText
 129 termsUnsupervised _ = undefined
 130
 131 newTries :: Int -> Text -> Tries Token ()
 132 newTries n t = buildTries n (fmap toToken $ uniText t)
 133
 134 uniText :: Text -> [[Text]]
 135 uniText = map (List.filter (not . isPunctuation))
 136         . map tokenize
 137         . sentences   -- | TODO get sentences according to lang
 138
 139