]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Text/Terms.hs
no logs
[gargantext.git] / 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 -- | Terms from Text
88 -- Mono : mono terms
89 -- Multi : multi terms
90 -- MonoMulti : mono and multi
91 -- TODO : multi terms should exclude mono (intersection is not empty yet)
92 terms :: TermType Lang -> Text -> IO [Terms]
93 terms (Mono lang) txt = pure $ monoTerms lang txt
94 terms (Multi lang) txt = multiterms lang txt
95 terms (MonoMulti lang) txt = terms (Multi lang) txt
96 terms (Unsupervised lang n s m) txt = termsUnsupervised (Unsupervised lang n s (Just m')) txt
97 where
98 m' = maybe (newTries n txt) identity m
99 -- terms (WithList list) txt = pure . concat $ extractTermsWithList list txt
100 ------------------------------------------------------------------------
101
102 text2term :: Lang -> [Text] -> Terms
103 text2term _ [] = Terms [] Set.empty
104 text2term lang txt = Terms txt (Set.fromList $ map (stem lang) txt)
105
106 isPunctuation :: Text -> Bool
107 isPunctuation x = List.elem x $ (Text.pack . pure)
108 <$> ("!?(),;." :: String)
109
110 -- | Unsupervised ngrams extraction
111 -- language agnostic extraction
112 -- TODO: remove IO
113 -- TODO: newtype BlockText
114
115 type WindowSize = Int
116 type MinNgramSize = Int
117
118 termsUnsupervised :: TermType Lang -> Text -> IO [Terms]
119 termsUnsupervised (Unsupervised l n s m) =
120 pure
121 . map (text2term l)
122 . List.nub
123 . (List.filter (\l' -> List.length l' >= s))
124 . List.concat
125 . mainEleveWith (maybe (panic "no model") identity m) n
126 . uniText
127 termsUnsupervised _ = undefined
128
129 newTries :: Int -> Text -> Tries Token ()
130 newTries n t = buildTries n (fmap toToken $ uniText t)
131
132 -- | TODO removing long terms > 24
133 uniText :: Text -> [[Text]]
134 uniText = map (List.filter (not . isPunctuation))
135 . map tokenize
136 . sentences -- | TODO get sentences according to lang
137 . Text.toLower
138