Skip to content

Instantly share code, notes, and snippets.

@meteficha
Created August 21, 2014 14:28
Show Gist options
  • Save meteficha/1acef6dc1e1ed81b63ae to your computer and use it in GitHub Desktop.
Save meteficha/1acef6dc1e1ed81b63ae to your computer and use it in GitHub Desktop.
Alexander Pakhomov's e-amil
benchmarking --nothing--/10
time 151.5 ns (151.2 ns .. 151.8 ns)
1.000 R² (1.000 R² .. 1.000 R²)
mean 151.8 ns (151.6 ns .. 152.1 ns)
std dev 868.8 ps (732.4 ps .. 1.030 ns)
benchmarking --best--/10
time 157.4 ns (157.1 ns .. 157.7 ns)
1.000 R² (1.000 R² .. 1.000 R²)
mean 157.1 ns (156.6 ns .. 157.4 ns)
std dev 1.297 ns (786.7 ps .. 2.366 ns)
benchmarking Heap/10
time 1.168 μs (1.162 μs .. 1.174 μs)
1.000 R² (1.000 R² .. 1.000 R²)
mean 1.163 μs (1.160 μs .. 1.168 μs)
std dev 12.45 ns (10.15 ns .. 14.98 ns)
benchmarking Insertion/10
time 1.156 μs (1.149 μs .. 1.162 μs)
1.000 R² (1.000 R² .. 1.000 R²)
mean 1.157 μs (1.153 μs .. 1.163 μs)
std dev 18.21 ns (15.42 ns .. 21.43 ns)
variance introduced by outliers: 16% (moderately inflated)
benchmarking Intro/10
time 1.150 μs (1.146 μs .. 1.155 μs)
1.000 R² (1.000 R² .. 1.000 R²)
mean 1.153 μs (1.150 μs .. 1.156 μs)
std dev 10.35 ns (8.735 ns .. 12.56 ns)
benchmarking Merge/10
time 1.161 μs (1.157 μs .. 1.166 μs)
1.000 R² (1.000 R² .. 1.000 R²)
mean 1.167 μs (1.162 μs .. 1.173 μs)
std dev 19.08 ns (15.93 ns .. 24.82 ns)
variance introduced by outliers: 17% (moderately inflated)
benchmarking Optimal/10
time 1.173 μs (1.168 μs .. 1.180 μs)
1.000 R² (1.000 R² .. 1.000 R²)
mean 1.194 μs (1.187 μs .. 1.204 μs)
std dev 27.45 ns (22.18 ns .. 36.34 ns)
variance introduced by outliers: 29% (moderately inflated)
benchmarking Optimal'/10
time 157.7 ns (157.5 ns .. 158.0 ns)
1.000 R² (1.000 R² .. 1.000 R²)
mean 157.8 ns (157.5 ns .. 158.2 ns)
std dev 1.178 ns (872.4 ps .. 1.965 ns)
{-# LANGUAGE Rank2Types #-}
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.ST
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as MV
import qualified Data.Vector.Algorithms.Heap as Heap
import qualified Data.Vector.Algorithms.Insertion as Insertion
import qualified Data.Vector.Algorithms.Intro as Intro
import qualified Data.Vector.Algorithms.Merge as Merge
import qualified Data.Vector.Algorithms.Optimal as Optimal
import qualified Data.Vector.Algorithms.Radix as Radix
import Data.IORef
import Data.Vector.Generic.Mutable
import Criterion.Main
type Value = Double
arr = V.fromList ([1,2] :: [Value])
foo :: (forall s. V.MVector s Value -> ST s ()) -> Value -> Value
foo f x = V.head q
where
q = runST $ do
res <- V.unsafeThaw $ V.concat
[ V.map (\e -> e + x) arr
, V.map (\e -> e - x) arr]
f res
V.unsafeFreeze res
main = do
ref <- newIORef 0
defaultMain
[ b "--nothing--" (const $ return ())
, b "--best--" best
, b "Heap" Heap.sort
, b "Insertion" Insertion.sort
, b "Intro" Intro.sort
, b "Merge" Merge.sort
, b "Optimal" (\v -> Optimal.sort4ByOffset compare v 0)
, b "Optimal'" (\v -> sort4ByOffset' v) ]
where
b :: String -> (forall s. V.MVector s Value -> ST s ()) -> Benchmark
b s f = bgroup s [ bench "10" $ whnf (foo f) 10 ]
best :: forall s. V.MVector s Value -> ST s ()
best res = do
-- [ 11, 12, -9, -8 ]
MV.swap res 0 2
-- [ -9, 12, 11, -8 ]
MV.swap res 1 3
-- [ -9, -8, 11, 12 ]
sort4ByOffset' :: V.MVector s Value -> ST s ()
sort4ByOffset' a = sort4ByIndex' compare a 0 1 2 3
-- The horror...
-- | Sorts the elements at the four given indices. Like the 2 and 3 element
-- versions, this assumes that the indices are given in increasing order, so
-- it can be used to sort medians into particular positions and so on.
sort4ByIndex' :: (PrimMonad m, MVector v e)
=> (e -> e -> Ordering) -> v (PrimState m) e -> Int -> Int -> Int -> Int -> m ()
sort4ByIndex' cmp a i j k l = do
a0 <- unsafeRead a i
a1 <- unsafeRead a j
a2 <- unsafeRead a k
a3 <- unsafeRead a l
case cmp a0 a1 of
GT -> case cmp a0 a2 of
GT -> case cmp a1 a2 of
GT -> case cmp a1 a3 of
GT -> case cmp a2 a3 of
GT -> do unsafeWrite a i a3
unsafeWrite a j a2
unsafeWrite a k a1
unsafeWrite a l a0
_ -> do unsafeWrite a i a2
unsafeWrite a j a3
unsafeWrite a k a1
unsafeWrite a l a0
_ -> case cmp a0 a3 of
GT -> do unsafeWrite a i a2
unsafeWrite a j a1
unsafeWrite a k a3
unsafeWrite a l a0
_ -> do unsafeWrite a i a2
unsafeWrite a j a1
unsafeWrite a k a0
unsafeWrite a l a3
_ -> case cmp a2 a3 of
GT -> case cmp a1 a3 of
GT -> do unsafeWrite a i a3
unsafeWrite a j a1
unsafeWrite a k a2
unsafeWrite a l a0
_ -> do unsafeWrite a i a1
unsafeWrite a j a3
unsafeWrite a k a2
unsafeWrite a l a0
_ -> case cmp a0 a3 of
GT -> do unsafeWrite a i a1
unsafeWrite a j a2
unsafeWrite a k a3
unsafeWrite a l a0
_ -> do unsafeWrite a i a1
unsafeWrite a j a2
unsafeWrite a k a0
-- unsafeWrite a l a3
_ -> case cmp a0 a3 of
GT -> case cmp a1 a3 of
GT -> do unsafeWrite a i a3
-- unsafeWrite a j a1
unsafeWrite a k a0
unsafeWrite a l a2
_ -> do unsafeWrite a i a1
unsafeWrite a j a3
unsafeWrite a k a0
unsafeWrite a l a2
_ -> case cmp a2 a3 of
GT -> do unsafeWrite a i a1
unsafeWrite a j a0
unsafeWrite a k a3
unsafeWrite a l a2
_ -> do unsafeWrite a i a1
unsafeWrite a j a0
-- unsafeWrite a k a2
-- unsafeWrite a l a3
_ -> case cmp a1 a2 of
GT -> case cmp a0 a2 of
GT -> case cmp a0 a3 of
GT -> case cmp a2 a3 of
GT -> do unsafeWrite a i a3
unsafeWrite a j a2
unsafeWrite a k a0
unsafeWrite a l a1
_ -> do unsafeWrite a i a2
unsafeWrite a j a3
unsafeWrite a k a0
unsafeWrite a l a1
_ -> case cmp a1 a3 of
GT -> do unsafeWrite a i a2
unsafeWrite a j a0
unsafeWrite a k a3
unsafeWrite a l a1
_ -> do unsafeWrite a i a2
unsafeWrite a j a0
unsafeWrite a k a1
-- unsafeWrite a l a3
_ -> case cmp a2 a3 of
GT -> case cmp a0 a3 of
GT -> do unsafeWrite a i a3
unsafeWrite a j a0
-- unsafeWrite a k a2
unsafeWrite a l a1
_ -> do -- unsafeWrite a i a0
unsafeWrite a j a3
-- unsafeWrite a k a2
unsafeWrite a l a1
_ -> case cmp a1 a3 of
GT -> do -- unsafeWrite a i a0
unsafeWrite a j a2
unsafeWrite a k a3
unsafeWrite a l a1
_ -> do -- unsafeWrite a i a0
unsafeWrite a j a2
unsafeWrite a k a1
-- unsafeWrite a l a3
_ -> case cmp a1 a3 of
GT -> case cmp a0 a3 of
GT -> do unsafeWrite a i a3
unsafeWrite a j a0
unsafeWrite a k a1
unsafeWrite a l a2
_ -> do -- unsafeWrite a i a0
unsafeWrite a j a3
unsafeWrite a k a1
unsafeWrite a l a2
_ -> case cmp a2 a3 of
GT -> do -- unsafeWrite a i a0
-- unsafeWrite a j a1
unsafeWrite a k a3
unsafeWrite a l a2
_ -> do -- unsafeWrite a i a0
-- unsafeWrite a j a1
-- unsafeWrite a k a2
-- unsafeWrite a l a3
return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment