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
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
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.
19 Source: https://en.wikipedia.org/wiki/Ngrams
23 compute occ by node of Tree
24 group occs according groups
31 {-# LANGUAGE NoImplicitPrelude #-}
32 {-# LANGUAGE TemplateHaskell #-}
34 module Gargantext.Text.Terms
38 import Data.Text (Text)
39 import Data.Traversable
40 import GHC.Base (String)
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)
48 import qualified Data.List as List
49 import qualified Data.Text as Text
50 import Gargantext.Text (sentences)
51 import Gargantext.Text.Terms.Mono.Token.En (tokenize)
52 import Gargantext.Text.Eleve (mainEleve)
55 = Mono { _tt_lang :: lang }
56 | Multi { _tt_lang :: lang }
57 | MonoMulti { _tt_lang :: lang }
61 --group :: [Text] -> [Text]
65 -- map (filter (\t -> not . elem t)) $
66 ------------------------------------------------------------------------
67 -- | Sugar to extract terms from text (hiddeng mapM from end user).
68 --extractTerms :: Traversable t => TermType Lang -> t Text -> IO (t [Terms])
69 extractTerms :: TermType Lang -> [Text] -> IO [[Terms]]
70 extractTerms termTypeLang = mapM (terms termTypeLang)
71 ------------------------------------------------------------------------
74 -- Multi : multi terms
75 -- MonoMulti : mono and multi
76 -- TODO : multi terms should exclude mono (intersection is not empty yet)
77 terms :: TermType Lang -> Text -> IO [Terms]
78 terms (Mono lang) txt = pure $ monoTerms lang txt
79 terms (Multi lang) txt = multiterms lang txt
80 terms (MonoMulti lang) txt = terms (Multi lang) txt
81 -- terms (WithList list) txt = pure . concat $ extractTermsWithList list txt
82 ------------------------------------------------------------------------
84 isPunctuation :: Text -> Bool
85 isPunctuation x = List.elem x $ (Text.pack . pure)
86 <$> ("!?(),;." :: String)
88 -- | Unsupervised ngrams extraction
89 -- language agnostic extraction
92 extractTermsUnsupervised :: Int -> Text -> [[Text]]
93 extractTermsUnsupervised n =
95 . (List.filter (\l -> List.length l > 1))
98 . map (map Text.toLower)
99 . map (List.filter (not . isPunctuation))