Skip to content

Instantly share code, notes, and snippets.

@tinkhaven
Created September 17, 2014 11:19
Show Gist options
  • Save tinkhaven/a31218239d7f2daebac1 to your computer and use it in GitHub Desktop.
Save tinkhaven/a31218239d7f2daebac1 to your computer and use it in GitHub Desktop.
import Test.QuickCheck
import Criterion.Main
{-
- Alternative using list comprehension
-}
allButLast :: (a -> a) -> [a] -> [a]
allButLast f [] = []
allButLast f l = reverse $ last l : [f x | x <- tail (reverse l)]
allButLast2 :: (a -> a) -> [a] -> [a]
allButLast2 f [] = []
allButLast2 f l =
let (x:xs) = reverse l
in reverse $ x : [f x | x <- xs]
{-
- creds: @Rvion
-}
mapInit :: (a -> a) -> [a] -> [a]
mapInit f l = map f (init l) ++ [last l]
{-
- creds: @bheklilr
-}
mapBut1 :: (a -> a) -> [a] -> [a]
mapBut1 f [] = []
mapBut1 f [x] = [x]
mapBut1 f (x:xs) = f x : mapBut1 f xs
{-
- Creds: @Will Ness
-}
mapButLast :: (a -> a) -> [a] -> [a]
mapButLast f = para g []
where
g x [] r = [x]
g x _ r = f x : r
para f z (x:xs) = f x xs (para f z xs)
para f z [] = z
prop_Id_AllButLast xs = allButLast (\x -> x - 1) (allButLast (+ 1) xs) == xs
where types = xs::[Int]
prop_Id_AllButLast2 xs = allButLast2 (\x -> x - 1) (allButLast2 (+ 1) xs) == xs
where types = xs::[Int]
prop_Id_MapInit xs = allButLast2 (\x -> x - 1) (allButLast2 (+ 1) xs) == xs
where types = xs::[Int]
prop_Id_MapBut1 xs = mapBut1 (\x -> x - 1) (mapBut1 (+ 1) xs) == xs
where types = xs::[Int]
prop_Id_Para xs = mapButLast (\x -> x - 1) (mapButLast (+ 1) xs) == xs
where types = xs::[Int]
-- Our benchmark harness.
main = defaultMain [
bgroup "allbutlast" [ bench "1" $ nf ablplus $ (take 1 [1..] :: [Int])
, bench "10" $ nf ablplus $ (take 10 [1..] :: [Int])
, bench "100" $ nf ablplus $ (take 100 [1..] :: [Int])
, bench "1000" $ nf ablplus $ (take 1000 [1..] :: [Int])
-- , bench "1000000" $ whnf ablplus $ (take 1000000 [1..] :: [Int])
]
,
bgroup "allbutlast2" [ bench "1" $ nf abl2plus $ (take 1 [1..] :: [Int])
, bench "10" $ nf abl2plus $ (take 10 [1..] :: [Int])
, bench "100" $ nf abl2plus $ (take 100 [1..] :: [Int])
, bench "1000" $ nf abl2plus $ (take 1000 [1..] :: [Int])
-- , bench "1000000" $ nf abl2plus $ (take 1000000 [1..] :: [Int])
]
,
bgroup "mapInit" [ bench "1" $ nf mapInitplus $ (take 1 [1..] :: [Int])
, bench "10" $ nf mapInitplus $ (take 10 [1..] :: [Int])
, bench "100" $ nf mapInitplus $ (take 100 [1..] :: [Int])
, bench "1000" $ nf mapInitplus $ (take 1000 [1..] :: [Int])
-- , bench "1000000" $ nf mapInitplus $ (take 1000000 [1..] :: [Int])
]
,
bgroup "mapBut1" [ bench "1" $ nf mapBut1plus $ (take 1 [1..] :: [Int])
, bench "10" $ nf mapBut1plus $ (take 10 [1..] :: [Int])
, bench "100" $ nf mapBut1plus $ (take 100 [1..] :: [Int])
, bench "1000" $ nf mapBut1plus $ (take 1000 [1..] :: [Int])
-- , bench "1000000" $ nf mapBut1plus $ (take 1000000 [1..] :: [Int])
]
,
bgroup "para" [ bench "1" $ nf mapButLastplus $ (take 1 [1..] :: [Int])
, bench "10" $ nf mapButLastplus $ (take 10 [1..] :: [Int])
, bench "100" $ nf mapButLastplus $ (take 100 [1..] :: [Int])
, bench "1000" $ nf mapButLastplus $ (take 1000 [1..] :: [Int])
-- , bench "1000000" $ nf mapButLastplus $ (take 1000000 [1..] :: [Int])
]
]
where
ablplus :: [Int] -> [Int]
ablplus = allButLast (+ 1)
abl2plus :: [Int] -> [Int]
abl2plus = allButLast2 (+ 1)
mapInitplus :: [Int] -> [Int]
mapInitplus = mapInit (+ 1)
mapBut1plus :: [Int] -> [Int]
mapBut1plus = mapBut1 (+ 1)
mapButLastplus :: [Int] -> [Int]
mapButLastplus = mapButLast (+ 1)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment