[Haskell-cafe] Removing alternate items from a list

[Markus Läll]

Forgot the file -- here it is:

module Main where

import Data.Either (rights)
import Data.Function (fix)

test f = putStr $ show $ last $ f $ replicate 10000000 (1 :: Int)

main = test matchPattern4
-- 1. zipNums
-- 2. matchPattern
-- 3. zipBoolCycle
-- 4. iterDrop
-- 5. zipBoolCycle2
-- 6. consume
-- 7. eitherr
-- 8. golf
-- 9. matchPattern2
-- 10. matchPattern3
-- 11. matchPattern4
-- 12. matchPattern5
-- 13. matchPattern10

-- 1. total time  =       13.72 secs   (686 ticks @ 20 ms)
--    total alloc = 1,840,007,000 bytes  (excludes profiling overheads)
zipNums = map snd . filter (odd . fst) . zip [1,2..]

-- 2. total time  =        1.82 secs   (91 ticks @ 20 ms)
--    total alloc = 400,006,752 bytes  (excludes profiling overheads)
matchPattern (x:_:zs) = x : matchPattern zs
matchPattern x = x

-- 3. total time  =        4.46 secs   (223 ticks @ 20 ms)
--    total alloc = 1,040,006,904 bytes  (excludes profiling overhea
zipBoolCycle xs = map fst . filter snd $ zip xs (cycle [False, True])

-- 4 total time  =        5.20 secs   (260 ticks @ 20 ms)
--   total alloc = 940,006,916 bytes  (excludes profiling overheads)
iterDrop = map head . takeWhile (not . null) . iterate (drop 2) . drop 1


-- 5 total time  =        3.68 secs   (184 ticks @ 20 ms)
--   total alloc = 820,006,872 bytes  (excludes profiling overheads)
zipBoolCycle2 x = [y | (True, y) <- zip (cycle [False, True]) x]


-- 6. total time  =        2.46 secs   (123 ticks @ 20 ms)
--    total alloc = 420,006,860 bytes  (excludes profiling overheads)
data Consume = Take | Skip
consumeBy :: [Consume] -> [a] -> [a]
consumeBy [] _ = []
consumeBy _ [] = []
consumeBy (tOrS:takesAndSkips) (x:xs) =
   case tOrS of Take -> x : consumeBy takesAndSkips xs
                Skip -> consumeBy takesAndSkips xs
consume = consumeBy $ cycle [Take, Skip]


-- 7. total time  =        4.10 secs   (205 ticks @ 20 ms)
--    total alloc = 1,000,006,884 bytes  (excludes profiling overheads)
eitherr = rights . zipWith ($) (cycle [Left,Right])


-- 8. total time  =        2.08 secs   (104 ticks @ 20 ms)
--    total alloc = 420,006,784 bytes  (excludes profiling overheads)
golf = (fix $ \f xs -> case xs of { (x:_: xs) -> x : f xs; _ -> [] })


-- 9. total time  =        1.68 secs   (84 ticks @ 20 ms)
--    total alloc = 370,006,752 bytes  (excludes profiling overheads)
matchPattern2 (a:_:c:_:rest)  = a : c : matchPattern2 rest
matchPattern2 (a:_:rest)      = a : rest
matchPattern2 (rest)          = rest

-- 10. total time  =        1.58 secs   (79 ticks @ 20 ms)
--     total alloc = 360,006,744 bytes  (excludes profiling overheads)
matchPattern3 (a:_:c:_:e:_: rest) = a : c : e : matchPattern3 rest
matchPattern3 (a:_:c:_:rest)      = a : c : rest
matchPattern3 (a:_:rest)          = a : rest
matchPattern3 (rest)              = rest

-- 11. total time  =        1.56 secs   (78 ticks @ 20 ms)
--     total alloc = 355,006,752 bytes  (excludes profiling overheads)
matchPattern4 (a:_:c:_:e:_:g:_:rest) = a : c : e : g : matchPattern4 rest
matchPattern4 (a:_:c:_:e:_: rest)    = a : c : e : rest
matchPattern4 (a:_:c:_:rest)         = a : c : rest
matchPattern4 (a:_:rest)             = a : rest
matchPattern4 (rest)                 = rest

-- 12. total time  =        1.52 secs   (76 ticks @ 20 ms)
--     total alloc = 352,006,752 bytes  (excludes profiling overheads)
matchPattern5 (a:_:c:_:e:_:g:_:i:_:rest) = a : c : e : g : i :
matchPattern5 rest
matchPattern5 (a:_:c:_:e:_:g:_:rest)     = a : c : e : g : rest
matchPattern5 (a:_:c:_:e:_: rest)        = a : c : e : rest
matchPattern5 (a:_:c:_:rest)             = a : c : rest
matchPattern5 (a:_:rest)                 = a : rest
matchPattern5 (rest)                     = rest

-- 13. total time  =        1.48 secs   (74 ticks @ 20 ms)
--     total alloc = 346,006,752 bytes  (excludes profiling overheads)
matchPattern10 (a:_:c:_:e:_:g:_:i:_:k:_:m:_:o:_:q:_:s:_:rest) =
a:c:e:g:i:k:m:o:q:s: matchPattern10 rest
matchPattern10 (a:_:c:_:e:_:g:_:i:_:k:_:m:_:o:_:q:_:rest)     =
a:c:e:g:i:k:m:o:q:rest
matchPattern10 (a:_:c:_:e:_:g:_:i:_:k:_:m:_:o:_:rest)         =
a:c:e:g:i:k:m:o:rest
matchPattern10 (a:_:c:_:e:_:g:_:i:_:k:_:m:_:rest)             =
a:c:e:g:i:k:m:rest
matchPattern10 (a:_:c:_:e:_:g:_:i:_:k:_:rest)                 = a:c:e:g:i:k:rest
matchPattern10 (a:_:c:_:e:_:g:_:i:_:rest)                     = a:c:e:g:i:rest
matchPattern10 (a:_:c:_:e:_:g:_:rest)                         = a:c:e:g:rest
matchPattern10 (a:_:c:_:e:_: rest)                            = a:c:e:rest
matchPattern10 (a:_:c:_:rest)                                 = a:c:rest
matchPattern10 (a:_:rest)                                     = a:rest
matchPattern10 (rest)                                         = rest

On Wed, Jun 9, 2010 at 11:47 PM, Markus Läll <markus.l2ll at gmail.com> wrote:
> So out of curiosity i took the definitions given in this thread, and
> tried to run timing-tests.
> Here's what I ran:
>> ghc -prof -auto-all -o Test Test.h
>> Test +RTS -p
> and then looked in the Test.prof file.
>
> All tests I ran from 3 to 10 times (depending on how sure I wanted to
> be), so the  results are not entirely exact. (I copied the "average"
> result to the source-file as comments above every function.)
>
> As the function doing (x:_:rest) pattern-matching was the fastest I
> extended the idea from that to (x1:_:x2: ... x10:_:rest), but skipping
> from 5 to 10, where all steps showed a small increase in performance.
>
> So a question: when increasing the pattern matched, is it somekind of
> way of inlining the matchings, and if so, is there some way of just
> saying that to the compiler how many recursions you want to inline
> together to increase speed?
>
> Any comments? (besides -O2 ;-)  -- I remembered it too late and didn't
> want to restart... At least for the last two functions it showed a
> similar difference in seconds as with no -O2)
>
>
> Markus Läll
>