allbutlast.hs

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)