Commit b090cb5a authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

Add CLI flag to disable optimizations

This allows to disable the 1-elem-block optimization to be able to compare the
running times with and with out it.
parent 4ac6cc5b
......@@ -52,10 +52,11 @@ refine :: forall f s.
RefinementInterface f
=> Proxy f
-> Encoding (Label f) (F1 f)
-> Bool
-> ST s Partition
refine Proxy encoding = do
refine Proxy encoding enableOptimization = do
queue <- Queue.empty (size encoding)
(blocks, state) <- initialize @f encoding
(blocks, state) <- initialize @f encoding enableOptimization
deleteLargestM (Partition.blockSize (partition state)) blocks >>= mapM_ (Queue.enqueue queue)
_ <- processQueue queue state
......@@ -70,10 +71,11 @@ refineWithStats
. RefinementInterface f
=> Proxy f
-> Encoding (Label f) (F1 f)
-> Bool
-> IO (Partition, AlgoStatistics)
refineWithStats Proxy encoding = do
refineWithStats Proxy encoding enableOptimization = do
queue <- stToIO $ Queue.empty (size encoding)
(initTime, (blocks, state)) <- withTime (stToIO $ initialize @f encoding)
(initTime, (blocks, state)) <- withTime (stToIO $ initialize @f encoding enableOptimization)
deleteLargestM (stToIO . Partition.blockSize (partition state)) blocks >>= mapM_ (stToIO . Queue.enqueue queue)
let initialBlocks = length blocks
......
......@@ -26,8 +26,9 @@ import qualified Data.RefinablePartition as Partition
-- returns (initial queue content, algo state)
initialize :: forall f s. RefinementInterface f
=> Encoding (Label f) (F1 f)
-> Bool
-> ST s ([Block], AlgoState s f)
initialize encoding = do
initialize encoding enableOptimization = do
toSub <- VM.replicate (size encoding) []
lastW <- VM.new (numEdges encoding)
predMutable <- VM.replicate (size encoding) []
......@@ -56,5 +57,6 @@ initialize encoding = do
blocks <- Partition.groupBy partition 0 (comparing (typeOf encoding))
size1Count <- newSTRef 0
let size1Enabled = enableOptimization
return (blocks, AlgoState {..})
......@@ -162,11 +162,11 @@ collectTouchedBlocks blockS = do
sizeOfB <- Partition.blockSize (partition as) b
when (sizeOfB == 1) $
when (sizeOfB == 1 && size1Enabled as) $
-- We found an edge with an outgoing block that has only one state.
modifySTRef' (size1Count as) (+1)
unless (sizeOfB == 1) $ do
unless (sizeOfB == 1 && size1Enabled as) $ do
unlessM (Partition.hasMarked (partition as) b) $ do
wCx <- readSTRef =<< VM.read (lastW as) (fromEdgeRef e)
let v0 = snd3 $ RI.update @f [] wCx
......
......@@ -11,6 +11,7 @@ module Copar.Algorithm.Types
, partitionL
, f3CacheL
, size1CountL
, size1EnabledL
)
where
......@@ -34,6 +35,8 @@ data AlgoState s f = AlgoState
-- | How often did we skip a block instead of calling update/splitBlock on it
-- due to our size-1-optimization.
, size1Count :: {-# UNPACK #-} (STRef s Int)
-- | Enable the 1-block optimization
, size1Enabled :: Bool
}
makeLensesFor
......@@ -44,5 +47,6 @@ makeLensesFor
, ( "partition", "partitionL")
, ( "f3Cache", "f3CacheL")
, ( "size1Count", "size1CountL")
, ( "size1Enabled", "size1EnabledL")
]
''AlgoState
......@@ -105,6 +105,7 @@ data RefineOptions = RefineOptions
, refineFunctor :: Maybe (FunctorExpression SomeFunctor Sort)
, refineApplyTransformations :: Bool
, refineEnableSanity :: Bool
, refineEnableOpt :: Bool
, refineInputFile :: Maybe FilePath
, refineOutputFile :: Maybe FilePath
}
......@@ -184,6 +185,12 @@ refineOptions = do
\might speed up the parser but require the input to be absolutely \
\correct. Otherwise, nasal demons might be created."
)
refineEnableOpt <- not <$> switch
( long "disable-optimizations"
<> help "Disable some optimizations. Currently, this is just the \
\one-element optimization. Obviously, this will reduce \
\performance."
)
pure RefineOptions { .. }
data GraphOptions = GraphOptions
......@@ -418,11 +425,11 @@ main = do
partition <- case statsType stats of
NoStats ->
withTimeStat stats "algorithm-duration" (stToIO (refine f encoding))
withTimeStat stats "algorithm-duration" (stToIO (refine f encoding (refineEnableOpt r)))
_ -> do
(part, algoStats) <-
withTimeStat stats "algorithm-duration"
$ (refineWithStats f encoding)
$ (refineWithStats f encoding (refineEnableOpt r))
logStat stats
"initial-partition-size"
(tshow (initialBlocks algoStats))
......@@ -469,7 +476,7 @@ main = do
Right res -> evaluate $ res
part <- if graphDrawPartition r
then (Just <$> stToIO (refine f encoding))
then (Just <$> stToIO (refine f encoding True))
else return Nothing
let config = DotConfig { nodeLabels = graphDrawNodeLabels r
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment