diff --git a/bench/bench.hs b/bench/bench.hs deleted file mode 100644 --- a/bench/bench.hs +++ /dev/null @@ -1,231 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# OPTIONS_GHC -Wall #-} -{-# OPTIONS_GHC -fno-warn-type-defaults #-} - -import Online.Averages -import Online.Medians -import Options.Generic -import NumHask.Prelude hiding ((%), fromIntegral) -import Protolude (fromIntegral) -import Perf hiding (zero, Additive) -import Formatting -import qualified Data.Text as Text -import qualified Control.Foldl as L -import Data.Scientific -import Data.TDigest - -data Opts = Opts - { runs :: Maybe Int -- "number of runs" - , sumTo :: Maybe Int -- "sum to this number" - } deriving (Generic, Show) - -instance ParseRecord Opts - --- | compute deciles --- --- > c5 <- decile 5 <$> ticks n f a --- -deciles :: (Functor f, Foldable f) => Int -> f Cycle -> [Double] -deciles n xs = - (\x -> fromMaybe 0 $ quantile x (tdigest (fromIntegral <$> xs) :: TDigest 25)) <$> - ((/ fromIntegral n) . fromIntegral <$> [0 .. n]) :: [Double] - --- | compute a percentile --- --- > c <- percentile 0.4 . fst <$> ticks n f a --- -percentile :: (Functor f, Foldable f) => Double -> f Cycle -> Double -percentile p xs = fromMaybe 0 $ quantile p (tdigest (fromIntegral <$> xs) :: TDigest 25) - -expt' :: Int -> Format r (Scientific -> r) -expt' x = scifmt Exponent (Just x) - -code :: [Text] -> Text -code cs = "\n```\n" <> Text.intercalate "\n" cs <> "\n```\n" - -sumInt :: [Int] -> Int -> Int -sumInt xs n = foldl' (+) zero (take n xs) - -sumDouble :: [Double] -> Int -> Double -sumDouble xs n = foldl' (+) zero (take n xs) - -sumPoly :: (Enum b, MultiplicativeUnital b, Additive b) => [b] -> Int -> b -sumPoly xs n = foldl' (+) zero (take n xs) - -sumSum :: [Double] -> Int -> Double -sumSum xs n = L.fold L.sum (take n xs) - -sumInt' :: Int -> Int -sumInt' x = foldl' (+) zero [zero .. x] - -sumDouble' :: Double -> Double -sumDouble' x = foldl' (+) zero [one .. x] - -sumPoly' :: (Enum b, MultiplicativeUnital b, Additive b) => b -> b -sumPoly' x = foldl' (+) zero [one .. x] - -avTestMain :: [Double] -> Int -> Double -avTestMain xs n = L.fold Main.av (take n xs) - -av :: (Field a) => L.Fold a a -av = L.Fold step begin extract - where - begin = (zero, zero) - step (s, c) a = (s + a, c + one) - extract (s, c) = s / c -{-# INLINABLE av #-} - -maTest :: [Double] -> Int -> Double -maTest xs n = L.fold (ma 0.99) (take n xs) - -formatRun :: [Cycle] -> Text -> Text -formatRun cs label = - sformat - ((right 24 ' ' %. stext) % stext % - (left 9 ' ' %. expt' 3) % " cycles") - label - (Text.intercalate " " $ sformat (left 7 ' ' %. expt' 3) <$> - (\x -> scientific (fromIntegral x) 0) <$> take 5 cs) - (fromFloatDigits $ percentile 0.4 cs) - -formatRunHeader :: Text -formatRunHeader = - sformat - ((right 24 ' ' %. stext) % - (left 7 ' ' %. stext) % - (left 8 ' ' %. stext) % - (left 8 ' ' %. stext) % - (left 8 ' ' %. stext) % - (left 8 ' ' %. stext) % - (left 8 ' ' %. stext)) - "run" - "first" - "2nd" - "3rd" - "4th" - "5th" - "40th %" - -run :: Functor f => Text -> f ([Cycle], b) -> f Text -run label t = (`formatRun` label) . fst <$> t - -tick_Test :: FilePath -> IO () -tick_Test f = do - onetick <- tick_ - ticks' <- replicateM 10 tick_ - manyticks <- replicateM 1000000 tick_ - let avticks = average manyticks - let qticks = deciles 10 manyticks - let tick999 = percentile 0.999 manyticks - let tick99999 = percentile 0.99999 manyticks - let tick99 = percentile 0.99 manyticks - let tick40 = percentile 0.4 manyticks - writeFile f $ - code - [ "one tick_: " <> show onetick <> " cycles" - , "next 10: " <> show ticks' - , "average over 1m: " <> sformat (fixed 2) avticks <> " cycles" - , "99.999% perc: " <> sformat commas (floor tick99999 :: Integer) - , "99.9% perc: " <> sformat (fixed 2) tick999 - , "99th perc: " <> sformat (fixed 2) tick99 - , "40th perc: " <> sformat (fixed 2) tick40 - , "[min, 10th, 20th, .. 90th, max]:" - , mconcat (sformat (" " % expt' 4) . fromFloatDigits <$> qticks) - ] - -fMono :: Int -> Int -fMono x = foldl' (+) 0 [1 .. x] - -fLambda :: Int -> Int -fLambda = \x -> foldl' (+) 0 [1 .. x] - -fPoly :: (Enum b, Num b, Additive b) => b -> b -fPoly x = foldl' (+) 0 [1 .. x] - -tickTest :: FilePath -> Int -> IO () -tickTest f a' = do - (t, resultPrime) <- tick fMono a' - print resultPrime - (t2,_) <- tick fMono a' - writeFile f $ - code - [ "sum to " <> show a' - , "first measure: " <> show t <> " cycles" - , "second measure: " <> show t2 <> " cycles" - ] - - -ticksTest :: FilePath -> Int -> Int -> IO () -ticksTest f a' n = do - -- | various versions of tick - rpure <- run "ticks" $ ticks n fMono a' - rpurePoly <- run "ticks (poly)" $ ticks n fPoly a' - rpureLambda <- run "ticks (lambda)" $ ticks n fLambda a' - rio <- run "ticksIO" $ ticksIO n (pure $ fMono a') - rioPoly <- run "ticksIO (poly)" $ ticksIO n (pure $ fPoly a') - rioLambda <- run "ticksIO (lambda)" $ ticksIO n (pure $ fLambda a') - - writeFile f $ - code [ "sum to " <> show a' <> " n = " <> show n - , formatRunHeader - , rpure - , rpureLambda - , rpurePoly - , rio - , rioLambda - , rioPoly - ] - -main :: IO () -main = do - o :: Opts <- getRecord "online performance benchmarking" - let n = fromMaybe 100 (runs o) - let a = fromMaybe 1000 (sumTo o) - let !a' = fromIntegral a :: Double - let !xs = [zero .. a] - let !xs' = fromIntegral <$> xs :: [Double] - _ <- warmup 100 - - rSumInt' <- run "sumInt [0..]" $ ticks n sumInt' a - rSumDouble' <- run "sumDouble [0..]" $ ticks n sumDouble' a' - rSumPoly' <- run "sumPoly [0..]" $ ticks n sumPoly' a' - rSumInt <- run "sum Int" $ ticks n (sumInt xs) a - rSumDouble <- run "sum Double" $ ticks n (sumDouble xs') a - rSumPoly <- run "sum Poly" $ ticks n (sumPoly xs') a - rSumSum <- run "fold sum" $ ticks n (sumSum xs') a - rAvTestMain <- run "fold av" $ ticks n (avTestMain xs') a - rMaTest <- run "fold ma" $ ticks n (maTest xs') a - rStdTest <- run "fold std" $ ticks n (\x -> L.fold (std 0.99) $ take x xs') a - - rMaL1Test <- run "fold maL1" $ ticks n (\x -> L.fold (maL1 0 0.01 0.99) $ take x xs') a - rabsmaL1Test <- run "fold absmaL1" $ ticks n (\x -> L.fold (absmaL1 0 0.01 0.99) $ take x xs') a - - writeFile "other/perf.md" $ - code - [ "sum to " <> sformat commas a - , formatRunHeader - , rSumInt' - , rSumDouble' - , rSumPoly' - , rSumInt - , rSumDouble - , rSumPoly - , rSumSum - , rAvTestMain - , rMaTest - , rStdTest - , rMaL1Test - , rabsmaL1Test - ] - - tick_Test "other/tick_.md" - tickTest "other/tick.md" a - ticksTest "other/ticks.md" a n - pure () diff --git a/online.cabal b/online.cabal --- a/online.cabal +++ b/online.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5a5f633300efb3112bf98d43704d99a8f5c77499334e49e51687fa4d33f3b1d0 +-- hash: 0e52ec83c8732aad81bae413979e21c904825f1675946b464248c15cb19ae656 name: online -version: 0.2.2.0 +version: 0.2.3.0 synopsis: online statistics description: transformation of statistics to online algorithms category: statistics @@ -20,7 +20,6 @@ cabal-version: >= 1.10 extra-source-files: - readme.md stack.yaml source-repository head @@ -45,28 +44,6 @@ Online.Averages Online.Medians Online.Quantiles - other-modules: - Paths_online - default-language: Haskell2010 - -executable online-bench - main-is: bench.hs - hs-source-dirs: - bench - default-extensions: NegativeLiterals NoImplicitPrelude OverloadedStrings UnicodeSyntax - ghc-options: -O2 -funbox-strict-fields -fforce-recomp -threaded -rtsopts -with-rtsopts=-N - build-depends: - base >=4.7 && <5 - , foldl - , formatting - , numhask-prelude - , online - , optparse-generic - , perf - , protolude - , scientific - , tdigest - , text other-modules: Paths_online default-language: Haskell2010 diff --git a/readme.md b/readme.md deleted file mode 100644 --- a/readme.md +++ /dev/null @@ -1,80 +0,0 @@ -[online](https://github.com/tonyday567/online) -============================================== - -[![Build -Status](https://travis-ci.org/tonyday567/online.svg)](https://travis-ci.org/tonyday567/online) -[![Hackage](https://img.shields.io/hackage/v/online.svg)](https://hackage.haskell.org/package/online) -[![lts](https://www.stackage.org/package/online/badge/lts)](http://stackage.org/lts/package/online) -[![nightly](https://www.stackage.org/package/online/badge/nightly)](http://stackage.org/nightly/package/online) - -online turns a statistic (in haskell this can usually be thought of as a -fold of a foldable) into an online algorithm. - -motivation -========== - -Imagine a data stream, like an ordered indexed container or a -time-series of measurements. An exponential moving average can be -calculated as a repeated iteration over a stream of xs: - -$$ ema_t = ema_{t-1} * 0.9 + x_t * 0.1 $$ - -The 0.1 is akin to the learning rate in machine learning, or 0.9 can be -thought of as a decaying or a rate of forgetting. An exponential moving -average learns about what the value of x has been lately, where lately -is, on average, about 1/0.1 = 10 x's ago. All very neat. - -The first bit of neat is speed. There's 2 times and a plus. The next is -space: an ema is representing the recent xs in a size as big as a single -x. Compare that with a simple moving average where you have to keep the -history of the last n xs around to keep up (just try it). - -It's so neat, it's probably a viable monoidal category all by itself. - -online -====== - -Haskell allows us to abstract the compound ideas in an ema and create -polymorphic routines over a wide variety of statistics, so that they all -retain these properties of speed, space and rigour. - - av xs = L.fold (online identity (.* 0.9)) xs - -- av [0..10] == 6.030559401413827 - -- av [0..100] == 91.00241448887785 - -`online identity (.* 0.9)` is how you express an ema with a decay rate -of 0.9. - -online works for any statistic. Here's the construction of standard -deviation using applicative style: - - std :: Double -> L.Fold Double Double - std r = (\s ss -> sqrt (ss - s**2)) <$> ma r <*> sqma r - where - ma r = online identity (.*r) - sqma r = online (**2) (.*r) - -[perf](https://hackage.haskell.org/package/perf) -================================================ - -1 cycle = 0.4 nanoseconds. - - sum to 1,000 - run first 2nd 3rd 4th 5th 40th % - sumInt [0..] 6.064e3 1.746e3 1.560e3 1.540e3 1.626e3 1.544e3 cycles - sumDouble [0..] 7.835e5 3.032e5 3.104e5 2.837e5 3.051e5 8.957e4 cycles - sumPoly [0..] 1.139e5 7.660e4 7.638e4 7.648e4 7.636e4 7.674e4 cycles - sum Int 1.601e4 1.186e4 1.167e4 1.158e4 1.176e4 1.168e4 cycles - sum Double 2.756e4 1.189e4 1.158e4 1.163e4 1.158e4 1.159e4 cycles - sum Poly 1.170e4 1.172e4 1.163e4 1.166e4 1.158e4 1.164e4 cycles - fold sum 1.177e4 1.174e4 1.178e4 1.185e4 1.177e4 1.175e4 cycles - fold av 2.935e4 1.190e4 1.181e4 1.182e4 1.177e4 1.181e4 cycles - fold ma 1.289e4 1.202e4 1.205e4 1.203e4 1.206e4 1.201e4 cycles - fold std 2.052e5 1.210e5 7.236e5 1.364e5 1.348e5 1.324e5 cycles - fold maL1 8.218e4 1.192e5 1.052e5 2.567e5 1.168e5 7.856e4 cycles - fold absmaL1 3.405e5 5.966e4 5.976e4 6.025e4 5.939e4 5.975e4 cycles - -recipe -====== - - stack build --test --exec "$(stack path --local-install-root)/bin/online-bench" --exec "$(stack path --local-bin)/pandoc -f markdown -i other/header.md other/readme_.md other/footer.md -t html -o index.html --filter pandoc-include --mathjax" --exec "$(stack path --local-bin)/pandoc -f markdown -i other/readme_.md -t markdown -o readme.md --filter pandoc-include --mathjax" --file-watch diff --git a/src/Online/Averages.hs b/src/Online/Averages.hs --- a/src/Online/Averages.hs +++ b/src/Online/Averages.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} -- | online statistics based on a moving average @@ -27,11 +28,11 @@ { _averager :: (a, b) } -instance (Semigroup a, Monoid b) => Semigroup (Averager a b) where +instance (Semigroup a, Semigroup b) => Semigroup (Averager a b) where (Averager (s, c)) <> (Averager (s', c')) = Averager (s <> s', c <> c') -instance (Monoid a, Monoid b) => Monoid (Averager a b) where +instance (Semigroup a, Semigroup b, Monoid a, Monoid b) => Monoid (Averager a b) where mempty = Averager (mempty, mempty) mappend = (<>) @@ -167,5 +168,5 @@ {-# INLINABLE autocorr #-} -- | a constant fold -mconst :: (Field a) => a -> L.Fold a a +mconst :: a -> L.Fold a a mconst a = L.Fold (\() _ -> ()) () (const a) diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,12 +1,11 @@ resolver: nightly-2018-04-05 packages: - - '.' + - . extra-deps: - numhask-0.2.0.0 - - numhask-prelude-0.0.1.0 - - perf-0.4.0.0 + - numhask-prelude-0.0.3.0 - tdigest-0.1 allow-newer: true