[FIX] mime files for a dependency (servant-static).
[gargantext.git] / src / Gargantext / Text.hs
index fb1ef4aacf3bf0209c9d5bd0226b6ea45d1f032c..814741447f1656341a20297ff2b719aba474134b 100644 (file)
@@ -7,162 +7,78 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Ngrams exctration.
-
-Definitions of ngrams.
-n non negative integer
+Text gathers terms in unit of contexts.
 
 -}
 
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 
-module Gargantext.Text ( module Gargantext.Text.Letters
-                              --, module Gargantext.Text.Hetero
-                         , module Gargantext.Text.CoreNLP
-                         , module Gargantext.Text.Parser
-                         , module Gargantext.Text.Occurrences
-                         , module Gargantext.Text.TextMining
-                         , module Gargantext.Text.Metrics
-                         , Ngrams(..), ngrams, occ, sumOcc, text2fis, clean
-                         , ListName(..), equivNgrams, isGram, sentences
-                         , ngramsTest
-                         ) where
-
-import Gargantext.Text.Letters
---import Gargantext.Text.Hetero
-import Gargantext.Text.CoreNLP
-import Gargantext.Text.Parser
-
-import Gargantext.Text.Occurrences
-import Gargantext.Text.TextMining
---import Gargantext.Text.Words
-
-import Gargantext.Text.Metrics
-import qualified Gargantext.Text.FrequentItemSet as FIS
------------------------------------------------------------------
-
-import Data.List (sort)
-import Data.Char (Char, isAlphaNum, isSpace)
-import Data.Text (Text, filter, toLower, split, lines, concat)
-import qualified Data.Text as DT
-import Data.Text.IO (readFile)
-
-import Data.Map.Strict  (Map
-                        , empty
-                        , insertWith, unionWith
-                        , lookupIndex
-                        --, fromList, keys
-                        )
-import qualified Data.Map.Strict as M (filter)
-import Data.Foldable (foldl')
-import Gargantext.Prelude hiding (filter)
-
--- Maybe useful later:
---import NLP.Stemmer (stem, Stemmer(..))
---import Language.Aspell (check, suggest, spellChecker, spellCheckerWithOptions)
---import Language.Aspell.Options (ACOption(..))
-
-
-data ListName = Stop | Candidate | Graph
-  deriving (Show, Eq)
-
-data Ngrams = Ngrams { _ngramsNgrams   :: [Text]
-                     , _ngramsStem     :: [Text]
-                     , _ngramsListName :: Maybe ListName
-                     } deriving (Show)
-
-equivNgrams :: Ngrams -> Ngrams -> Bool
-equivNgrams  (Ngrams n1 s1 _) (Ngrams n2 s2 _)
-  = (sort n1) == (sort n2) || (sort s1) == (sort s2)
-
-type Occ     = Int
---type Index   = Int
-
--- Data Ngrams = Monograms | MultiGrams
-
-ngrams :: Text -> [Text]
-ngrams xs = monograms $ toLower $ filter isGram xs
-
-clean :: Text -> Text
-clean txt = DT.map clean' txt
-  where
-    clean' '’' = '\''
-    clean' c  = c
-
-monograms :: Text -> [Text]
-monograms txt = split isWord txt
+module Gargantext.Text
   where
-    isWord c = c `elem` [' ', '\'', ',', ';']
-
-isGram :: Char -> Bool
-isGram  c  = isAlphaNum c || isSpace c || c `elem` ['-','/','\'']
 
--- | Compute the occurrences (occ)
-occ :: Ord a => [a] -> Map a Occ
-occ xs = foldl' (\x y -> insertWith (+) y 1 x) empty xs
-
--- TODO add groups and filter stops
-sumOcc :: Ord a => [Map a Occ] -> Map a Occ
-sumOcc xs = foldl' (unionWith (+)) empty xs
-
---noApax :: Ord a => Map a Occ -> Map a Occ
---noApax m = M.filter (>1) m
-
--- | /!\ indexes are not the same:
+import Data.Maybe
+import qualified Data.Text as DT
 
--- | Index ngrams from Map
---indexNgram :: Ord a => Map a Occ -> Map Index a
---indexNgram m = fromList (zip [1..] (keys m))
+import qualified Data.Set as S
+import Data.Text (Text, split)
 
--- | Index ngrams from Map
---ngramIndex :: Ord a => Map a Occ -> Map a Index
---ngramIndex m = fromList (zip (keys m) [1..])
+import NLP.FullStop (segment)
+-----------------------------------------------------------------
+import Gargantext.Core
+import Gargantext.Core.Types
+import Gargantext.Text.Metrics.Count (Occ, occurrences, cooc)
+import Gargantext.Prelude hiding (filter)
+-----------------------------------------------------------------
 
-indexWith :: Ord a => Map a Occ -> [a] -> [Int]
-indexWith m xs = unMaybe $ map (\x -> lookupIndex x m) xs
+type Config  = Lang -> Context
 
-indexIt :: Ord a => [[a]] -> (Map a Int, [[Int]])
-indexIt xs = (m, is)
-  where
-    m  = sumOcc (map occ  xs)
-    is = map    (indexWith m) xs
+type Context = Text -> [Text]
 
-list2fis :: Ord a => FIS.Frequency -> [[a]] -> (Map a Int, [FIS.Fis])
-list2fis n xs = (m', fs)
-  where
-    (m, is) = indexIt xs
-    m'      = M.filter (>50000) m
-    fs      = FIS.all n is
+data Viz = Graph | Phylo | Chart
 
-text2fis :: FIS.Frequency -> [Text] -> (Map Text Int, [FIS.Fis])
-text2fis n xs = list2fis n (map ngrams xs)
-
---text2fisWith :: FIS.Size -> FIS.Frequency -> [Text] -> (Map Text Int, [FIS.Fis])
---text2fisWith = undefined
 
+-----------------------------------------------------------------
 -------------------------------------------------------------------
 -- Contexts of text
-
 sentences :: Text -> [Text]
-sentences txt = split isStop txt
+sentences txt = map DT.pack $ segment $ DT.unpack txt
+
+sentences' :: Text -> [Text]
+sentences' txt = split isStop txt
 
 isStop :: Char -> Bool
 isStop c = c `elem` ['.','?','!']
 
-
--- | Tests
-ngramsTest fp =  ws
-  where
-    txt = concat <$> lines <$> clean <$> readFile fp
-    -- | Number of sentences
-    ls   = sentences <$> txt
-    -- | Number of monograms used in the full text
-    ws   = ngrams    <$> txt
-    -- | stem ngrams
+unsentences :: [Text] -> Text
+unsentences txts = DT.intercalate " " txts
+
+-- | https://en.wikipedia.org/wiki/Text_mining
+testText_en :: Text
+testText_en = DT.pack "Text mining, also referred to as text data mining, roughly equivalent to text analytics, is the process of deriving high-quality information from text. High-quality information is typically derived through the devising of patterns and trends through means such as statistical pattern learning. Text mining usually involves the process of structuring the input text (usually parsing, along with the addition of some derived linguistic features and the removal of others, and subsequent insertion into a database), deriving patterns within the structured data, and finally evaluation and interpretation of the output. 'High quality' in text mining usually refers to some combination of relevance, novelty, and interestingness. Typical text mining tasks include text categorization, text clustering, concept/entity extraction, production of granular taxonomies, sentiment analysis, document summarization, and entity relation modeling (i.e., learning relations between named entities). Text analysis involves information retrieval, lexical analysis to study word frequency distributions, pattern recognition, tagging/annotation, information extraction, data mining techniques including link and association analysis, visualization, and predictive analytics. The overarching goal is, essentially, to turn text into data for analysis, via application of natural language processing (NLP) and analytical methods. A typical application is to scan a set of documents written in a natural language and either model the document set for predictive classification purposes or populate a database or search index with the information extracted."
+
+-- | https://fr.wikipedia.org/wiki/Fouille_de_textes
+testText_fr :: Text
+testText_fr = DT.pack "La fouille de textes ou « l'extraction de connaissances » dans les textes est une spécialisation de la fouille de données et fait partie du domaine de l'intelligence artificielle. Cette technique est souvent désignée sous l'anglicisme text mining. Elle désigne un ensemble de traitements informatiques consistant à extraire des connaissances selon un critère de nouveauté ou de similarité dans des textes produits par des humains pour des humains. Dans la pratique, cela revient à mettre en algorithme un modèle simplifié des théories linguistiques dans des systèmes informatiques d'apprentissage et de statistiques. Les disciplines impliquées sont donc la linguistique calculatoire, l'ingénierie des langues, l'apprentissage artificiel, les statistiques et l'informatique."
+
+termTests :: Text
+termTests = "It is hard to detect important articles in a specific context. Information retrieval techniques based on full text search can be inaccurate to identify main topics and they are not able to provide an indication about the importance of the article. Generating a citation network is a good way to find most popular articles but this approach is not context aware. The text around a citation mark is generally a good summary of the referred article. So citation context analysis presents an opportunity to use the wisdom of crowd for detecting important articles in a context sensitive way. In this work, we analyze citation contexts to rank articles properly for a given topic. The model proposed uses citation contexts in order to create a directed and edge-labeled citation network based on the target topic. Then we apply common ranking algorithms in order to find important articles in this newly created network. We showed that this method successfully detects a good subset of most prominent articles in a given topic. The biggest contribution of this approach is that we are able to identify important articles for a given search term even though these articles do not contain this search term. This technique can be used in other linked documents including web pages, legal documents, and patents as well as scientific papers."
+
+
+-- | Ngrams Test
+-- >>> ngramsTest testText
+-- 248
+--ngramsTest :: Text -> Int
+--ngramsTest x =  length ws
+--  where
+--    --txt = concat <$> lines <$> clean <$> readFile filePath
+--    txt = clean x
+--    -- | Number of sentences
+--    --ls   = sentences $ txt
+--    -- | Number of monograms used in the full text
+--    ws   = ngrams    $ txt
+--    -- | stem ngrams
     -- TODO
     -- group ngrams
-    ocs  = occ       <$> ws
-
--- 
-
+    --ocs  = occ       $ ws