>>> During a small project I'm trying to develop a small application. It
>>> becomes quite often that I need a function mapapp:
>>>
>>> mapapp _ [] ap = ap
>>> mapapp f (a:as) ap = f a : map f as ap
>> Of course,
>>> (map f list) ++ append
>>> would do the same as
>>>
>>> mapapp f list append
>>>
>>> but with less efficiency. Or am I wrong?
I timed each of the following five operations with ...
> ghc -O2 --make MapApp.hs
> time ./MapApp
... and they produced no statistically significant differences. Each ran for about 3.8 seconds. Perhaps you can try it to convince yourself?
Sean
--
module Main where
mapapp0 :: (a -> b) -> [b] -> [a] -> [b]
mapapp0 f tail xs = map f xs ++ tail
mapapp1 :: (a -> b) -> [b] -> [a] -> [b]
mapapp1 _ tail [] = tail
mapapp1 f tail (a:as) = f a : mapapp1 f tail as
mapapp2 :: (a -> b) -> [b] -> [a] -> [b]
mapapp2 f tail = go
where
go [] = tail
go (x:xs) = f x : go xs
mapapp3 :: (a -> b) -> [b] -> [a] -> [b]
mapapp3 f tail = foldr ((:) . f) tail
main = do
writeFile "/dev/null" $ show $ [1 .. 10001000]
-- writeFile "/dev/null" $ show $ mapapp0 (+3) [1 .. 10000000] [1 .. 1000]
-- writeFile "/dev/null" $ show $ mapapp1 (+3) [1 .. 10000000] [1 .. 1000]
-- writeFile "/dev/null" $ show $ mapapp2 (+3) [1 .. 10000000] [1 .. 1000]
-- writeFile "/dev/null" $ show $ mapapp3 (+3) [1 .. 10000000] [1 .. 1000]
return ()