Report separate timing stats for initialize and refine

This splits the previous stat values "refine-duration" into
"initialize-duration" and "refine-duration". The sum of those (plus
measurement overhead, etc) is still reported as "algorithm-duration".

copar.cabal

@@ -64,6 +64,7 @@ library
                      , Copar.Dot
                      , Copar.PrettyShow
                      , Copar.RewriteFunctors
+                     , Copar.Timing
   default-extensions:  GADTs
                      , StandaloneDeriving
                      , DeriveFunctor
@@ -96,6 +97,7 @@ library
                      , deriving-compat
                      , ieee754 >= 0.8.0 && <0.9
                      , vector-th-unbox >= 0.2 && <0.3
+                     , scientific >= 0.3.6 && < 0.4
   ghc-options:         -Wall -Wno-name-shadowing
   if flag(release)
     cpp-options:       -DRELEASE
@@ -113,7 +115,7 @@ executable copar
                      , deepseq
                      , optparse-applicative
                      , json
-                     , scientific
+                     , scientific >= 0.3.6 && < 0.4
                      , prettyprinter
                      , prettyprinter-ansi-terminal
                      , prettyprinter-convert-ansi-wl-pprint

src/Copar/Algorithm.hs

@@ -7,8 +7,6 @@ module Copar.Algorithm
 import           Control.Monad.ST
 import           Data.STRef
 import           Data.Proxy
-import           Data.Bifunctor (second)
-import           Data.Maybe (fromJust)
 
 import           Control.Monad.Extra (whileM)
 import           Control.Monad.Reader
@@ -23,11 +21,16 @@ import           Copar.Coalgebra.RefinementTypes
 import           Copar.Algorithm.Types
 import           Copar.Algorithm.Initialize
 import           Copar.Algorithm.Split
+import           Copar.Timing
 
 -- | Metrics about the algorithm's execution.
 data AlgoStatistics = AlgoStatistics
   { initialBlocks :: Int -- ^ Size of the initial partition
   , splitCount :: Int -- ^ Overall count of 'split' operations
+  , initTime :: Integer -- ^ Time in picoseconds spend in the initialize
+                        -- procedure
+  , refineTime :: Integer -- ^ Time in picoseconds spend in the rest of the
+                          -- algorithm (calling split until the queue is empty)
   }
 
 -- | Returns the count of 'split' calls
@@ -47,37 +50,34 @@ refine :: forall f s.
   => Proxy f
   -> Encoding (Label f) (F1 f)
   -> ST s Partition
-refine Proxy = fmap fst . refineImpl False (Proxy @f)
+refine Proxy encoding = do
+  queue <- Queue.empty (size encoding)
+  (blocks, state) <- initialize @f encoding
+  mapM_ (Queue.enqueue queue) blocks
+
+  _ <- processQueue queue state
+
+  Partition.freeze (partition state)
+
 
 -- | Seme as 'refine', but also reports some statistics about the algorithm's
 -- execution.
-refineWithStats :: forall f s.
-     RefinementInterface f
+refineWithStats
+  :: forall f
+   . RefinementInterface f
   => Proxy f
   -> Encoding (Label f) (F1 f)
-  -> ST s (Partition, AlgoStatistics)
-refineWithStats Proxy =
-  fmap (second fromJust) . refineImpl True (Proxy @f)
-
-refineImpl :: forall f s.
-     RefinementInterface f
-  => Bool
-  -> Proxy f
-  -> Encoding (Label f) (F1 f)
-  -> ST s (Partition, Maybe AlgoStatistics)
-refineImpl collectStats Proxy encoding = do
-  queue <- Queue.empty (size encoding)
-  (blocks, state) <- initialize @f encoding
-  mapM_ (Queue.enqueue queue) blocks
+  -> IO (Partition, AlgoStatistics)
+refineWithStats Proxy encoding = do
+  queue <- stToIO $ Queue.empty (size encoding)
+  (initTime, (blocks, state)) <- withTime (stToIO $ initialize @f encoding)
+  mapM_ (stToIO . Queue.enqueue queue) blocks
   let initialBlocks = length blocks
 
-  splitCount <- processQueue queue state
+  (refineTime, splitCount) <- withTime (stToIO $ processQueue queue state)
 
-  part <- Partition.freeze (partition state)
+  part <- stToIO $ Partition.freeze (partition state)
 
-  let stats =
-        if collectStats
-        then Just (AlgoStatistics initialBlocks splitCount)
-        else Nothing
+  let stats = (AlgoStatistics initialBlocks splitCount initTime refineTime)
 
   return (part, stats)

src/Copar/Timing.hs

+module Copar.Timing (withTime, showTimeDiff) where
+
+import           System.CPUTime
+
+import           Data.Text                      ( Text )
+import qualified Data.Text                     as T
+import           Data.Scientific
+
+-- | Run an IO action and return its result together with its execution time in
+-- picoseconds.
+withTime :: IO a -> IO (Integer, a)
+withTime action = do
+  time1 <- getCPUTime
+  res   <- action
+  time2 <- getCPUTime
+  return (time2 - time1, res)
+
+-- | Return the time as seconds
+showTimeDiff :: Integer -> Text
+showTimeDiff picoseconds =
+  T.pack (formatScientific Fixed (Just 10) (scientific picoseconds (-12)))

src/main/Main.hs

@@ -48,6 +48,7 @@ import           Copar.Functors.SomeFunctor (SomeFunctor)
 import           Copar.FunctorExpression.Type (FunctorExpression)
 import           Copar.Dot
 import           Copar.RewriteFunctors
+import           Copar.Timing
 
 ----------------------------------------------------------------------
 -- CLI Options
@@ -338,8 +339,8 @@ main = do
     (RefineCommand r) -> do
       stats <- initStats (refineStats r) (refineStatsJson r)
 
-      withTime stats "overall-duration" $ do
-        (f, (symbolTable, encoding)) <- withTime stats "parse-duration" $ do
+      withTimeStat stats "overall-duration" $ do
+        (f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
 
           let transPolicy = if (refineApplyTransformations r)
                 then ApplyTransformations
@@ -359,18 +360,22 @@ main = do
           (tshow (length (V.filter isFirstSort (Encoding.structure encoding))))
 
         partition <- case statsType stats of
-          NoStats -> withTime stats "refine-duration" (stToIO (refine f encoding))
+          NoStats -> withTimeStat stats "algorithm-duration" (stToIO (refine f encoding))
           _ -> do
-            (part, algoStats) <- withTime stats "refine-duration" $
-              (stToIO (refineWithStats f encoding))
+            (part, algoStats) <- withTimeStat stats "algorithm-duration" $
+              (refineWithStats f encoding)
             logStat
               stats
               "initial-partition-size"
               (tshow (initialBlocks algoStats))
+            logStat stats "initialize-duration"
+              (showTimeDiff (initTime algoStats))
             logStat
               stats
               "split-operation-count"
               (tshow (splitCount algoStats))
+            logStat stats "refine-duration"
+              (showTimeDiff (refineTime algoStats))
             return part
 
         logStat
@@ -383,7 +388,7 @@ main = do
           "explicit-final-partition-size"
           (tshow (length (restrictPartitionToSort1 encoding partition)))
 
-        withTime stats "output-duration"
+        withTimeStat stats "output-duration"
           (outputPartition (refineOutputFile r) encoding symbolTable partition)
 
       finalizeStats stats
@@ -434,21 +439,13 @@ tabularize table = do
 
     T.putStr "\n"
 
-withTime :: Stats -> Text -> IO a -> IO a
-withTime stats name action = case statsType stats of
+withTimeStat :: Stats -> Text -> IO a -> IO a
+withTimeStat stats name action = case statsType stats of
   NoStats -> action
   _ -> do
-    time1 <- getCPUTime
-    res <- action
-    time2 <- getCPUTime
-
-    logStat stats name (showTimeDiff (time2 - time1))
-
+    (duration, res) <- withTime action
+    logStat stats name (showTimeDiff duration)
     return res
 
--- | Output the time as seconds
-showTimeDiff :: Integer -> Text
-showTimeDiff picoseconds = T.pack (formatScientific Fixed (Just 10) (scientific picoseconds (-12)))
-
 tshow :: Show a => a -> Text
 tshow = T.pack . show