From 6296b8284ef7baa544d7b7c9c99749a1a2b40565 Mon Sep 17 00:00:00 2001
From: Nicolas Pouillard <nicolas.pouillard@gmail.com>
Date: Wed, 4 Jul 2018 17:30:44 +0200
Subject: [PATCH] mapConcurrentlyChunked
---
bin/gargantext-cli/Main.hs | 21 ++++++++++++++-------
package.yaml | 1 +
2 files changed, 15 insertions(+), 7 deletions(-)
diff --git a/bin/gargantext-cli/Main.hs b/bin/gargantext-cli/Main.hs
index 892f9621..0652102c 100644
--- a/bin/gargantext-cli/Main.hs
+++ b/bin/gargantext-cli/Main.hs
@@ -32,10 +32,13 @@ import qualified Data.IntMap as DM
import Data.Map (Map)
import Data.Text (Text)
-import Data.List (cycle)
+import Data.List (cycle, concat)
+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)
+import Prelude ((>>))
import Gargantext.Prelude
import Gargantext.Core
@@ -58,18 +61,22 @@ mapMP f xs = do
liftIO $ hFlush stderr
f x
-
-
+mapConcurrentlyChunked :: (a -> IO b) -> [a] -> IO [b]
+mapConcurrentlyChunked f ts = do
+ n <- getNumCapabilities
+ concat <$> mapConcurrently (mapM f) (chunksOf n ts)
filterTermsAndCooc
:: TermType Lang
-> (Int, [Text])
-> IO (Map (Terms, Terms) Coocs)
filterTermsAndCooc patterns (year, ts) = do
- putStrLn $ "start filterTermsAndCooc " <> show year
- r <- coocOn identity <$> mapM (terms patterns) ts
- putStrLn $ "stop filterTermsAndCooc " <> show year
+ log "start"
+ r <- coocOn identity <$> mapM (\x -> {-log "work" >>-} terms patterns x) ts
+ log "stop"
pure r
+ where
+ log m = putStrLn $ "filterTermsAndCooc: " <> m <> " " <> show year
--main :: IO [()]
main = do
@@ -92,6 +99,6 @@ main = do
let corpus' = DMaybe.catMaybes $ map (\k -> DM.lookup k corpus) years
- r <- mapConcurrently (filterTermsAndCooc patterns) (zip years corpus')
+ r <- mapConcurrentlyChunked (filterTermsAndCooc patterns) (zip years corpus')
putStrLn $ show r
--writeFile outputFile cooc
diff --git a/package.yaml b/package.yaml
index 7d2e39f2..60809a27 100644
--- a/package.yaml
+++ b/package.yaml
@@ -168,6 +168,7 @@ executables:
- cassava
- ini
- optparse-generic
+ - split
- unordered-containers
- full-text-search
--
2.21.0