Faster break and span for Prelude
Bas van Dijk
v.dijk.bas at gmail.com
Tue Dec 27 22:40:05 CET 2011
On 27 December 2011 20:41, Boris Lykah <lykahb at gmail.com> wrote:
> Hello everyone,
>
> I noticed that Prelude break and span Core uses boxed tuples which is
> quite expensive. Since functions from Prelude are used everywhere,
> many programs will benefit from their optimization. Please see my
> implementation which uses internal worker function and unboxed tuples.
> In the best case it could perform more than twice faster than Prelude
> functions.
>
> import Criterion.Main
>
> newspan :: (a -> Bool) -> [a] -> ([a], [a])
> newspan p xs = go xs where
> go xs@[] = (xs, xs)
> go xs@(x:xs')
> | p x = case go xs' of (ys, zs) -> (x:ys,zs)
> | otherwise = ([], xs)
>
> newbreak :: (a -> Bool) -> [a] -> ([a], [a])
> newbreak p xs = go xs where
> go xs@[] = (xs, xs)
> go xs@(x:xs')
> | p x = ([], xs)
> | otherwise = case go xs' of (ys, zs) -> (x:ys,zs)
>
> versus f1 f2 pred arg = [ bench "new" $ whnf (f1 pred) arg
> , bench "prelude" $ whnf (f2 pred) arg
> ]
>
> variousLists f1 f2 pred = [ bgroup "fullMatch" $ versus f1 f2 pred
> (replicate 1000 1 :: [Int])
> , bgroup "failOnFirst" $ versus f1 f2 (not .
> pred) (replicate 1000 1 :: [Int])
> , bgroup "emptyList" $ versus f1 f2 pred
> ([]::[Int])
> ]
>
> main = defaultMain [ bgroup "span" $ variousLists newspan span (==1)
> , bgroup "break" $ variousLists newbreak break (/=1)
> ]
>
>
> --
> Regards,
> Boris
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
Note that your benchmarks just compare the time to construct the final
tuples and not the lists inside of it. This is because you're using
'whnf' instead of 'nf'. Because your new functions are strict in the
tail of the argument list (in contrast to the current span and break),
it will actually take a longer time to calculate the final tuple:
http://basvandijk.github.com/newSpanBreak_WHNF.html
So I think it's fairer to use 'nf':
http://basvandijk.github.com/newSpanBreak_NF.html
But, as already mentioned, your functions are more strict than the
current functions:
> head $ fst $ span (==1) (1:undefined)
1
> head $ fst $ newspan (==1) (1:undefined)
*** Exception: Prelude.undefined
> head $ fst $ break (/=1) (1:undefined)
1
> head $ fst $ newbreak (/=1) (1:undefined)
*** Exception: Prelude.undefined
So they can't just replace the originals without going through the
library submission process.
But lets see what happens when we make them as lazy as the original functions:
newspan :: (a -> Bool) -> [a] -> ([a], [a])
newspan p xs = go xs where
go xs@[] = (xs, xs)
go xs@(x:xs')
| p x = let (ys, zs) = go xs' in (x:ys,zs)
| otherwise = ([], xs)
newbreak :: (a -> Bool) -> [a] -> ([a], [a])
newbreak p xs = go xs where
go xs@[] = (xs, xs)
go xs@(x:xs')
| p x = ([], xs)
| otherwise = let (ys, zs) = go xs' in (x:ys,zs)
They are faster but not much:
http://basvandijk.github.com/newSpanBreak_Lazy_NF.html
However I do expect them to be significantly faster when they are
applied fully saturated.
Cheers,
Bas
More information about the Libraries
mailing list