[OPTIM][FIX] serialise/deserialise without encode/decode json
[gargantext.git] / bin / gargantext-cli / Main.hs
index 524f936a7c647653e1465b4d06b856d753e7233e..3ce1c69a5e666632c3664fa6e4206d06d17f6bf8 100644 (file)
@@ -22,73 +22,145 @@ Main specifications to index a corpus with a term list
 
 module Main where
 
+import Data.ByteString.Lazy (writeFile)
+
+import Data.Maybe (catMaybes)
+import Data.Text (pack)
+import qualified Data.Text as DT
+
+import Data.Tuple.Extra (both)
 import qualified Data.Vector as DV
 import qualified Data.Maybe  as DMaybe
 
 import Control.Monad (zipWithM)
 import Control.Monad.IO.Class
 
-import qualified Data.IntMap as DM
-
 import Data.Map (Map)
+import qualified Data.IntMap as DIM
+import qualified Data.Map    as DM
+
+import GHC.Generics
+import Data.Aeson
+
 import Data.Text (Text)
-import Data.List (cycle)
+import Data.List (cycle, concat, unwords)
+import Data.List.Split (chunksOf)
 import System.IO (hPutStr, hFlush, stderr)
 import System.Environment
 import Control.Concurrent.Async as CCA (mapConcurrently)
+import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability)
+import Prelude ((>>))
 
 import Gargantext.Prelude
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Text.Terms
+import Gargantext.Text.Context
 import Gargantext.Text.Terms.WithList
-import Gargantext.Text.Parsers.CSV (readCsv, csv_title, csv_abstract, csv_publication_year)
+import Gargantext.Text.Corpus.Parsers.CSV (readFile, csv_title, csv_abstract, csv_publication_year)
 import Gargantext.Text.List.CSV (csvGraphTermList)
 import Gargantext.Text.Terms (terms)
-import Gargantext.Text.Metrics.Count (coocOn, Coocs)
+import Gargantext.Text.Metrics.Count (coocOnContexts, Coocs)
 
-mapMP :: MonadIO m => (a -> m b) -> [a] -> m [b]
-mapMP f xs = do
-    bs <- zipWithM g (cycle "-\\|/") xs
-    liftIO $ hPutStr stderr "\rDone\n"
-    pure bs
-  where
-    g c x = do
-      liftIO $ hPutStr stderr ['\r',c]
-      liftIO $ hFlush  stderr
-      f x
+------------------------------------------------------------------------
+-- OUTPUT format
 
+data CoocByYear = CoocByYear { year         :: Int
+                             , nbContexts   :: NbContexts
+                             , coocurrences :: Map (Text, Text) Coocs
+                             } deriving (Show, Generic)
 
+data CoocByYears = CoocByYears { years :: [CoocByYear] }
+  deriving (Show, Generic)
 
+type NbContexts = Int
+
+instance ToJSON CoocByYear
+instance ToJSON CoocByYears
+------------------------------------------------------------------------
 
 filterTermsAndCooc
-  :: TermType Lang
-     -> [Text]
-     -> IO (Map (Terms, Terms) Coocs)
-filterTermsAndCooc patterns ts = coocOn identity <$> mapM (terms patterns) ts
+  :: Patterns
+     -> (Int, [Text])
+     -> IO CoocByYear -- (Int, (Map (Text, Text) Coocs))
+filterTermsAndCooc patterns (year, ts) = do
+  log "start"
+  r <- coocOnContexts identity <$> mapM (\x -> {-log "work" >>-} terms' patterns x) ts
+  log "stop"
+  pure $ CoocByYear year (length ts) (DM.mapKeys (both DT.unwords) r)
+  where
 
+    log m = do
+      tid    <- myThreadId
+      (p, _) <- threadCapability tid
+      putStrLn . unwords $
+        ["filterTermsAndCooc:", m, show year, "on proc", show p]
 
---main :: IO [()]
+main :: IO ()
 main = do
-  [corpusFile, termListFile, _] <- getArgs
+  [corpusFile, termListFile, outputFile] <- getArgs
 
   --corpus :: IO (DM.IntMap [[Text]])
   corpus <- DM.fromListWith (<>)
-                           <$> DV.toList
-                           <$> DV.map (\n -> (csv_publication_year n, [(csv_title n) <> " " <> (csv_abstract n)]))
-                           <$> snd
-                           <$> readCsv corpusFile
+                             . DV.toList
+                             . DV.map (\n -> (csv_publication_year n, [(csv_title n) <> " " <> (csv_abstract n)]))
+                             . snd
+                           <$> readFile corpusFile
 
   -- termListMap :: [Text]
   termList <- csvGraphTermList termListFile
 
   putStrLn $ show $ length termList
 
-  let years = DM.keys corpus
-  let patterns = WithList $ buildPatterns termList
-  let corpus' = DMaybe.catMaybes $ map (\k -> DM.lookup k corpus) years
+  let patterns = buildPatterns termList
+
+  -- r <- mapConcurrentlyChunked (filterTermsAndCooc patterns) (DM.toList corpus)
+  r <-  mapConcurrently (filterTermsAndCooc patterns) (DM.toList corpus)
+  writeFile outputFile $ encode (CoocByYears r)
+
+
+
+------------------------------------------------------------------------
+-- | Tools
+mapMP :: MonadIO m => (a -> m b) -> [a] -> m [b]
+mapMP f xs = do
+    bs <- zipWithM g (cycle "-\\|/") xs
+    liftIO $ hPutStr stderr "\rDone\n"
+    pure bs
+  where
+    g c x = do
+      liftIO $ hPutStr stderr ['\r',c]
+      liftIO $ hFlush  stderr
+      f x
+
+-- | Optimi that need further developments (not used yet)
+mapConcurrentlyChunked :: (a -> IO b) -> [a] -> IO [b]
+mapConcurrentlyChunked f ts = do
+  caps <- getNumCapabilities
+  let n = 1 `max` (length ts `div` caps)
+  concat <$> mapConcurrently (mapM f) (chunksOf n ts)
+
+
+--terms' :: Patterns -> Text -> Corpus [[Text]]
+terms' pats txt = pure $ concat $ extractTermsWithList pats txt
+
+
+-- | TODO Minimal Example
+--testCooc = do
+--  let patterns = buildPatterns testTermList
+--  mapM (\x -> {-log "work" >>-} terms' patterns x) $ catMaybes $ map (head . snd) testCorpus
+--  --mapConcurrently (filterTermsAndCooc patterns) testCorpus
+
+
+testCorpus :: [(Int, [Text])]
+testCorpus = [ (1998, [pack "The beees"])
+             , (1999, [ pack "The bees and the flowers" 
+                      --, pack "The bees and the flowers" 
+                      ])
+             ]
 
+testTermList :: TermList
+testTermList = [ ([pack "bee"], [[pack "bees"]])
+               , ([pack "flower"], [[pack "flowers"]])
+               ]
 
-  r <- zip years <$> mapConcurrently (filterTermsAndCooc patterns) corpus'
-  putStrLn $ show r
-  --writeFile outputFile cooc