From a563109f78db5bee270623890b7c2631d23e31d5 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Wed, 19 Jun 2024 00:11:32 +0100 Subject: [PATCH] Tweaks --- .github/workflows/haskell-ci.yml | 16 +----- src/Test/Tasty/Bench/Equalize.hs | 79 ++++++++++++++------------ src/Test/Tasty/Bench/Fit.hs | 29 +++------- src/Test/Tasty/Bench/Fit/Complexity.hs | 14 +---- src/Test/Tasty/Bench/Utils.hs | 48 ++++++++++++++++ tasty-bench-fit.cabal | 5 +- 6 files changed, 106 insertions(+), 85 deletions(-) create mode 100644 src/Test/Tasty/Bench/Utils.hs diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index f0f0261..9802d67 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -28,9 +28,9 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.10.0.20240413 + - compiler: ghc-9.10.1 compilerKind: ghc - compilerVersion: 9.10.0.20240413 + compilerVersion: 9.10.1 setup-method: ghcup allow-failure: false - compiler: ghc-9.8.2 @@ -141,18 +141,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG < Benchmarkable + -- ^ A benchmark which is faster at 'eqlLow', typically 'nf' @f@. , eqlFasterOnHigh :: Word -> Benchmarkable + -- ^ A benchmark which is faster at 'eqlHigh', typically 'nf' @g@. , eqlLow :: Word + -- ^ An argument at which 'eqlFasterOnLow' is faster than 'eqlFasterOnHigh'. , eqlHigh :: Word + -- ^ An argument at which 'eqlFasterOnHigh' is faster than 'eqlFasterOnLow'. , eqlTimeout :: Timeout + -- ^ Timeout of individual measurements. } -- | Generate a default 'equalize' configuration. mkEqualizeConfig :: (NFData a) => (Word -> a) + -- ^ An algorithm which is faster for small arguments, without 'nf'. -> (Word -> a) + -- ^ An algorithm which is faster for large arguments, without 'nf'. -> (Word, Word) - -- ^ The smallest and the largest sizes of the input. + -- ^ Small and large arguments. -> EqualizeConfig mkEqualizeConfig fLow fHigh (low, high) = EqualizeConfig @@ -41,33 +49,34 @@ mkEqualizeConfig fLow fHigh (low, high) = , eqlFasterOnHigh = nf fHigh , eqlLow = low , eqlHigh = high - , eqlTimeout = NoTimeout + , eqlTimeout = mkTimeout 1e8 } -equalize :: EqualizeConfig -> IO [(Word, Word)] -equalize EqualizeConfig {..} = go (RelStDev 1.0) eqlLow eqlHigh +equalize :: EqualizeConfig -> IO (NonEmpty (Word, Word)) +equalize EqualizeConfig {..} = NE.fromList <$> go (RelStDev (1 / 3)) eqlLow eqlHigh where - go std@(RelStDev std') lo hi - | lo + 1 >= hi = pure [(lo, hi)] - | otherwise = - unsafeInterleaveIO $ - ((lo, hi) :) <$> do - let mid = (lo + hi) `quot` 2 - traceShowM' $ "mid = " ++ show mid - (mean1, stdev1) <- measureCpuTimeAndStDev eqlTimeout std $ eqlFasterOnLow mid - traceShowM' $ "(mean1, stdev1) = " ++ show (mean1, stdev1) - (mean2, stdev2) <- measureCpuTimeAndStDev eqlTimeout std $ eqlFasterOnHigh mid - traceShowM' $ "(mean2, stdev2) = " ++ show (mean2, stdev2) - if mean1 + 2 * stdev1 < mean2 - 2 * stdev2 - then go std mid hi - else - if mean2 + 2 * stdev2 < mean1 - 2 * stdev1 - then go std lo mid - else go (RelStDev $ std' / 2) lo hi + go targetRelStdDev lo hi = fmap ((lo, hi) :) $ + unsafeInterleaveIO $ do + let mid = (lo + hi) `quot` 2 + measureIt alg k = do + meas <- measure eqlTimeout targetRelStdDev $ alg mid + traceShowM' meas + if getRelStDev (measRelStDev meas) > getRelStDev targetRelStdDev + then pure [] + else k meas -traceShowM' :: (Applicative m, Show a) => a -> m () -#ifdef DEBUG -traceShowM' = traceShowM -#else -traceShowM' = const (pure ()) -#endif + traceShowM' targetRelStdDev + if mid == lo + then pure [] + else measureIt eqlFasterOnLow $ \(Measurement mean1 stdev1) -> + measureIt eqlFasterOnHigh $ \(Measurement mean2 stdev2) -> do + let (lo', hi') + | mean1 + 2 * stdev1 < mean2 - 2 * stdev2 = (mid, hi) + | mean2 + 2 * stdev2 < mean1 - 2 * stdev1 = (lo, mid) + | otherwise = (lo, hi) + let targetStdDev' = + RelStDev $ + max + (abs (mean1 - mean2) / max mean1 mean2 / 4) + (getRelStDev targetRelStdDev * (sqrt 5 - 1) / 2) + go targetStdDev' lo' hi' diff --git a/src/Test/Tasty/Bench/Fit.hs b/src/Test/Tasty/Bench/Fit.hs index e628a74..dbfe2f4 100644 --- a/src/Test/Tasty/Bench/Fit.hs +++ b/src/Test/Tasty/Bench/Fit.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE NumDecimals #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -35,10 +34,9 @@ import qualified Data.Map as M import Data.Ord (comparing) import System.IO.Unsafe (unsafeInterleaveIO) import Test.Tasty (Timeout, mkTimeout) -import Test.Tasty.Bench (Benchmarkable, RelStDev (..), measureCpuTimeAndStDev, nf) +import Test.Tasty.Bench (Benchmarkable, RelStDev (..), nf) import Test.Tasty.Bench.Fit.Complexity ( Complexity (..), - Measurement (..), evalComplexity, guessComplexity, isConstant, @@ -48,10 +46,7 @@ import Test.Tasty.Bench.Fit.Complexity ( isLogarithmic, isQuadratic, ) - -#ifdef DEBUG -import Debug.Trace -#endif +import Test.Tasty.Bench.Utils (Measurement (..), measure, traceShowM') -- | Configuration for 'fit'. data FitConfig = FitConfig @@ -149,17 +144,14 @@ converge xs = case zs of -- ... fits :: FitConfig -> IO (NonEmpty Complexity) fits FitConfig {..} = unsafeInterleaveIO $ do - lowTime <- measure fitLow - highTime <- measure fitHigh + lowTime <- measureIt fitLow + highTime <- measureIt fitHigh let mp = M.fromList [(fitLow, lowTime), (fitHigh, highTime)] cmpl = fitOracle mp cmpl `seq` (cmpl :|) <$> go mp where - measure :: Word -> IO Measurement - measure = - fmap (uncurry Measurement) - . measureCpuTimeAndStDev fitTimeout fitRelStDev - . fitBench + measureIt :: Word -> IO Measurement + measureIt = measure fitTimeout fitRelStDev . fitBench processGap :: forall t @@ -169,7 +161,7 @@ fits FitConfig {..} = unsafeInterleaveIO $ do -> IO (Map Word Measurement) processGap gaps mp | M.null gaps' = pure mp - | otherwise = (\m -> M.insert maxGap m mp) <$> measure maxGap + | otherwise = (\m -> M.insert maxGap m mp) <$> measureIt maxGap where gaps' = M.fromList gaps `M.difference` mp maxGap = fst $ maximumBy (comparing snd) $ M.toList gaps' @@ -200,10 +192,3 @@ fits FitConfig {..} = unsafeInterleaveIO $ do d :: Word -> Double d = fromIntegral - -traceShowM' :: (Applicative m, Show a) => a -> m () -#ifdef DEBUG -traceShowM' = traceShowM -#else -traceShowM' = const (pure ()) -#endif diff --git a/src/Test/Tasty/Bench/Fit/Complexity.hs b/src/Test/Tasty/Bench/Fit/Complexity.hs index 91be271..e24cbfd 100644 --- a/src/Test/Tasty/Bench/Fit/Complexity.hs +++ b/src/Test/Tasty/Bench/Fit/Complexity.hs @@ -8,7 +8,6 @@ -- | Guess complexity from data. module Test.Tasty.Bench.Fit.Complexity ( Complexity (..), - Measurement (..), guessComplexity, evalComplexity, @@ -36,6 +35,7 @@ import Math.Regression.Simple ( levenbergMarquardt2WithYerrors, linear, ) +import Test.Tasty.Bench.Utils (Measurement (..)) import Text.Printf (printf) import Prelude hiding (log) import qualified Prelude as P @@ -142,18 +142,6 @@ bestOf = fst . minimumBy (comparing weigh) then 100 else (if diff < 0.15 then 32 else 10) --- | Represents a time measurement for a given problem's size. -data Measurement = Measurement - { measTime :: !Double - , measStDev :: !Double - } - deriving (Eq, Ord, Generic) - -instance Show Measurement where - show (Measurement t err) = printf "%.3g ± %.3g" t err - -instance NFData Measurement - -- | Guess time complexity from a map where keys -- are problem's sizes and values are time measurements (or instruction counts). -- diff --git a/src/Test/Tasty/Bench/Utils.hs b/src/Test/Tasty/Bench/Utils.hs new file mode 100644 index 0000000..a851044 --- /dev/null +++ b/src/Test/Tasty/Bench/Utils.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} + +module Test.Tasty.Bench.Utils ( + Measurement (..), + measRelStDev, + measure, + getRelStDev, + traceShowM', +) where + +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) +import Test.Tasty (Timeout) +import Test.Tasty.Bench (Benchmarkable, RelStDev (..), measureCpuTimeAndStDev) +import Text.Printf (printf) + +#ifdef DEBUG +import Debug.Trace +#endif + +-- | Represents a time measurement for a given problem's size. +data Measurement = Measurement + { measTime :: !Double + , measStDev :: !Double + } + deriving (Eq, Ord, Generic) + +instance Show Measurement where + show (Measurement t err) = printf "%.3g ± %.3g" t err + +instance NFData Measurement + +measure :: Timeout -> RelStDev -> Benchmarkable -> IO Measurement +measure x y z = uncurry Measurement <$> measureCpuTimeAndStDev x y z + +measRelStDev :: Measurement -> RelStDev +measRelStDev (Measurement mean stDev) = RelStDev (stDev / mean) + +getRelStDev :: RelStDev -> Double +getRelStDev (RelStDev x) = x + +traceShowM' :: (Applicative m, Show a) => a -> m () +#ifdef DEBUG +traceShowM' = traceShowM +#else +traceShowM' = const (pure ()) +#endif diff --git a/tasty-bench-fit.cabal b/tasty-bench-fit.cabal index 11134ef..43cf7f9 100644 --- a/tasty-bench-fit.cabal +++ b/tasty-bench-fit.cabal @@ -36,7 +36,10 @@ library Test.Tasty.Bench.Equalize hs-source-dirs: src - other-modules: Test.Tasty.Bench.Fit.Complexity + other-modules: + Test.Tasty.Bench.Fit.Complexity + Test.Tasty.Bench.Utils + default-language: Haskell2010 ghc-options: -Wall build-depends: