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 TemplateHaskell   #-}
  33
  34 module Gargantext.Text.Terms
  35   where
  36
  37 import Control.Lens
  38 import Data.Text (Text)
  39 import Data.Traversable
  40 import GHC.Base (String)
  41
  42 import Gargantext.Prelude
  43 import Gargantext.Core
  44 import Gargantext.Core.Types
  45 import Gargantext.Text.Terms.Multi (multiterms)
  46 import Gargantext.Text.Terms.Mono  (monoTerms)
  47 import Gargantext.Text.Terms.Mono.Stem (stem)
  48
  49 import qualified Data.Set  as Set
  50 import qualified Data.List as List
  51 import qualified Data.Text as Text
  52 import Gargantext.Text (sentences)
  53 import Gargantext.Text.Terms.Mono.Token.En (tokenize)
  54 import Gargantext.Text.Terms.Eleve (mainEleveWith, Tries, Token, buildTries, toToken)
  55
  56 data TermType lang
  57   = Mono      { _tt_lang :: lang }
  58   | Multi     { _tt_lang :: lang }
  59   | MonoMulti { _tt_lang :: lang }
  60   | Unsupervised { _tt_lang  :: lang
  61                  , _tt_size  :: Int
  62                  , _tt_model :: Maybe (Tries Token ())
  63   }
  64 makeLenses ''TermType
  65
  66 --group :: [Text] -> [Text]
  67 --group = undefined
  68
  69 -- remove Stop Words
  70 -- map (filter (\t -> not . elem t)) $
  71 ------------------------------------------------------------------------
  72 -- | Sugar to extract terms from text (hiddeng mapM from end user).
  73 --extractTerms :: Traversable t => TermType Lang -> t Text -> IO (t [Terms])
  74 extractTerms :: TermType Lang -> [Text] -> IO [[Terms]]
  75 extractTerms (Unsupervised l n m) xs = mapM (terms (Unsupervised l n m')) xs
  76   where
  77     m' = maybe (Just $ newTries n (Text.intercalate " " xs)) Just m
  78 extractTerms termTypeLang xs = mapM (terms termTypeLang) xs
  79 ------------------------------------------------------------------------
  80 -- | Terms from Text
  81 -- Mono : mono terms
  82 -- Multi : multi terms
  83 -- MonoMulti : mono and multi
  84 -- TODO : multi terms should exclude mono (intersection is not empty yet)
  85 terms :: TermType Lang -> Text -> IO [Terms]
  86 terms (Mono      lang) txt = pure $ monoTerms lang txt
  87 terms (Multi     lang) txt = multiterms lang txt
  88 terms (MonoMulti lang) txt = terms (Multi lang) txt
  89 terms (Unsupervised lang n m) txt = termsUnsupervised m' n lang txt
  90   where
  91     m' = maybe (newTries n txt) identity m
  92 -- terms (WithList  list) txt = pure . concat $ extractTermsWithList list txt
  93 ------------------------------------------------------------------------
  94
  95 text2term :: Lang -> [Text] -> Terms
  96 text2term _ [] = Terms [] Set.empty
  97 text2term lang txt = Terms txt (Set.fromList $ map (stem lang) txt)
  98
  99 isPunctuation :: Text -> Bool
 100 isPunctuation x = List.elem x $  (Text.pack . pure)
 101                              <$> ("!?(),;." :: String)
 102
 103 -- | Unsupervised ngrams extraction
 104 -- language agnostic extraction
 105 -- TODO: remove IO
 106 -- TODO: newtype BlockText
 107 termsUnsupervised :: Tries Token () -> Int -> Lang -> Text -> IO [Terms]
 108 termsUnsupervised m n l =
 109                pure
 110              . map (text2term l)
 111              . List.nub
 112              . (List.filter (\l' -> List.length l' > 1))
 113              . List.concat
 114              . mainEleveWith m n
 115              . uniText
 116
 117 newTries :: Int -> Text -> Tries Token ()
 118 newTries n t = buildTries n (fmap toToken $ uniText t)
 119
 120 uniText :: Text -> [[Text]]
 121 uniText = map (List.filter (not . isPunctuation))
 122         . map tokenize
 123         . sentences   -- | TODO get sentences according to lang
 124
 125