Haskell99Pointfree

####!!!Work in progress!!! ##Useful functions:

ifM (from Control.Monad.Extra):
liftA(n)/liftM(n):
if'/ifThenElse (from Data.Bool.HT (package utilities-ht)):
over (from Control.Lens):
set (from Control.Lens):
view (from Control.Lens):

I will present only some of my solutions. For more solutions have a look at the sources.

In some cases I decided to split up the one-line to make it more readable.

Problem 1: Find the last element of a list

--using ifM from Control.Monad.Extra
p01_6 :: [a] -> Maybe a
p01_6 = ifM null (const Nothing) (Just . last)

p01_8 :: [a] -> Maybe a
p01_8 = flip if' Nothing . null <*>  Just .last

p01_10 :: [a] -> Maybe a
p01_10 = listToMaybe . reverse

--from the safe package
p01_11 :: [a] -> Maybe a
p01_11 = lastMay

Problem 2: Find the last but one element of a list

--using (<*>) from Control.Applicative
p02_3A :: [a] -> Maybe a
p02_3A =   flip if' Nothing . (< 2) . length <*>  Just . last . init

--using liftA3 from Control.Applicatice
p02_4 :: [a] -> Maybe a
p02_4 = liftA3 ifThenElse ( (<=) 2  . length ) (Just . head . tail . reverse ) (const Nothing)

--using functions from the safe package
p02_10 :: [a] -> Maybe a
p02_10 = initMay >=> lastMay

Problem 3: Return the nth element of a list

p03_4 :: [a] -> Int -> Maybe a
p03_4 =   ( . subtract 1 ) .  ap ( liftM2 (flip ( `if'` Nothing))   (Just . head) .  ( . null) . (||) . (>) 0) . flip drop

p03_6 :: [a] -> Int -> Maybe a
p03_6 =  (fmap snd . ) . ( . ((. fst) . (==))) . flip find . zip [1..]

p03_13 :: [a] -> Int -> Maybe a
p03_13 = (>=> lastMay ) . flip takeExactMay

Problem 4: Return the length of a list

p04_7 :: [a] -> Int
p04_7 = sum . map (const 1)

--using fix from Control.Monad.Fix
p04_8 :: [a] -> Int
p04_8 = fix (ifM null (const 0) . ( . tail) . ((+1). ))

--using the list Monad
p04_9 :: [a] -> Int
p04_9 =  sum . flip (>>) [1]

Problem 5: Reverse a list

p05_2 :: [a] -> [a]
p05_2 = liftA3 ifThenElse null (const []) (  flip (flip (++) . take 1) =<< p05_2 . tail )

--using snoc from Data.List.Extra
p05_7 :: [a] -> [a]
p05_7 = foldr (flip snoc) []

p05_8 :: [a] -> [a]
p05_8 = foldl (flip (:)) []

Problem 6: Check if a given list is a palindrom

--does redundant comparisons
p06_3 :: Eq a => [a] -> Bool
p06_3 = and . liftA2 (zipWith (==)) id reverse

p06_7 :: Eq a => [a] -> Bool
p06_7  = uncurry isPrefixOf . second reverse .  ap (flip splitAt) (flip div 2 . length)

Problem 7:

--using Prisms
data NestedList a = List [NestedList a] | Elem a

makePrisms ''NestedList

--recursive
p07_1 :: NestedList a -> [a]
p07_1 =  ifM (is _Elem) ( (:[]) . fromJust . preview _Elem) (concatMap p07_1 . fromJust . preview _List)

Problem 8:

p08_1 :: Eq a => [a] -> [a]
p08_1 = map head . group

p08_4 :: Eq a => [a] -> [a]
p08_4 = reverse . snd . until ( null . fst ) (liftA2 (,) ( join (dropWhile . (==) . head) . fst) (liftA2 (:) (head . fst)  snd ) )  . (,[])

Problem 9:

--trivial solution
p09_1 :: Eq a => [a] -> [[a]]
p09_1 = group

p09_3 :: Eq a => [a] -> [[a]]
p09_3 = reverse . snd . until ( null . fst ) nextStep . (,[])
  where
    nextStep :: Eq a => ([a],[[a]]) -> ([a],[[a]])
    nextStep = liftA2 (,) (join (dropWhile . (==) . head) . fst) ( (flip (:) . snd) <*>   join (takeWhile . (==) . head) . fst )

Problem 10:

p10_1 :: Eq a =>  [a] -> [(Integer,a)]
p10_1 = map (liftA2 (,) genericLength head) .  p09_1

--using arrows
p10_3 :: Eq a => [a] -> [(Int,a)]
p10_3 = map ( length &&& head ) . p09_3

Problem 11:

data ListItem a = Multiple Integer a  | Single a deriving Show

p11_1 :: Eq a =>  [a] -> [ListItem a]
p11_1 =  map ( ifM ( (==1) . fst) ( Single . snd) (liftA2 Multiple fst snd) ) .  p10_1

Problem 12:

data MorS a = Multiple {nm::Int, val::a} | Single {val::a}  deriving (Data,Typeable)

p12_1 :: Data a => [MorS a] -> [a]
p12_1  = concatMap (liftA3 ifThenElse (  (==) (toConstr (Single ())) . toConstr )  (replicate 1 . val)  (liftA2 replicate nm val)  )


data MorS2 a = Multiple2 Int a | Single2 a deriving (Data,Typeable)

p12_2 :: Data a => [MorS2 a] -> [a]
p12_2 = concatMap (liftA3 ifThenElse (  (==) (toConstr (Single2 ())) . toConstr )  ( flip (:) [] . fromJust . gmapQi 0 cast  )  ( uncurry replicate .   ((fromJust . gmapQi 0 cast)   &&&  (fromJust . gmapQi 1 cast)) )  )

Problem 13:

p13_2 :: Eq a => [a] -> [ListItem a]
p13_2 =  liftA2 (`if'` [] ) null (reverse   . (  (:) . ifM ( (==1) . view _1) (Single . (^._2) ) ( Multiple . (^._1) <*> view _2) <*> view _4) .  join ((until (null . view _3) nextStep . ) . (. tail) . (1,,,[]) . head))
  where
    nextStep :: Eq a => (Integer , a , [a], [ListItem a]) -> (Integer ,a , [a] , [ListItem a])
    nextStep = ifM ( join (( . view _2 ) . (==) . head . view _3 )) ( over _3 tail  . over _1 (+1) ) ( liftA3 (1,,,) (head . view _3) (tail . view _3 ) (liftA2 (:) (ifM ( (==1) . view _1) (Single . view _2) (liftA2 Multiple (^._1) (^._2)) ) (view _4) ) )

Problem 14:

p14_1 :: [a] -> [a]
p14_1 = concatMap (replicate 2)

p14_4 :: [a] -> [a]
p14_4 =concat . fix ( ifM null (const []) . liftM2  (:) (replicate 2 . head) . ( . tail))

Problem 15:

--the "&" is almost the same as "$" but with arguments flipped (but is precedece is one higher)
p15_1 :: [a] -> Int -> [a]
p15_1 =  concatMap . replicate & flip

p15_2 :: [a] -> Int -> [a]
p15_2 =  ( . (,[]) ) .  flip ( ( (concat  . snd) .  ) . foldr ( ap  (  (,)  . fst )    .  liftA2 (flip (:)) snd . ( . fst)  . flip replicate ))

Problem 16:

p16_4 :: [a] -> Int -> [a]
p16_4 =  (map fst . ) . ap (filter . ( . snd) . (/=) )  . ( . (cycle . enumFromTo (1::Int) . max 1 )) .  zip

Problem 17:

p17_1 :: [a] -> Int -> ([a],[a])
p17_1 = flip splitAt

p17_2 :: [a] -> Int -> ([a],[a])
p17_2 =  (liftA2 (,) . take) <*> drop & flip

Problem 18:

p18_1 :: [a] -> Int -> Int -> [a]
p18_1 =  (  . (subtract 1  . max 1)) . ap  ( (. flip take) . flip (  .  ) . subtract )  . flip drop

Problem 19:

p19_1 :: [a] -> Int -> [a]
p19_1 = ( . )  . ( ( uncurry (++) .swap) . )  . flip splitAt <*> flip mod . length

Problem 20:

--unsafe for index <= 0
p20 :: [a] -> Int -> (a , [a])
p20 =  ( liftA2 (,) (last . fst) (liftA2 (++) (init . fst ) snd) . ) . flip splitAt

--using find,filter and zip, safe, does not change the list in case of invalid index
p20_2 :: [a] -> Int -> (Maybe a,[a])
p20_2 =  ( .  liftA2 (,) ( (fmap snd . ) . find  .  ( . fst)  . (==))  ( (map snd . ) . filter . ( . fst) . (/=) )  ) . flip (uncurry (liftA2 (,))) . zip [1..]

Problem 21:

p21_1 :: a -> [a] -> Int -> [a]
p21_1 = ( . ( (. subtract 1)  . flip splitAt ) ) . (.) . liftA2 (++) fst . ( . snd)  .  (:)

Problem 22:

--trivial soution, ignoring descending cases
p22_1 :: Integer -> Integer -> [Integer]
p22_1 = enumFromTo

--imporved version of p22_1 where descending cases are taken into account
p22_2 :: Int -> Int -> [Int]
p22_2 =  (  liftA3 ifThenElse (uncurry (<)) (uncurry enumFromTo)  (reverse . uncurry (flip enumFromTo)) . ) . (,)

Problem 23:

-- If the index is too large or negative , Nothing is returned
p23_2 :: [a] -> Int -> IO (Maybe [a])
p23_2  = liftA2 (`if'` return  Nothing) . liftA2 (||) (<0) . (<) . length <*> trueBranch
  where
    trueBranch = ((( flip fmap  newStdGen . ) . ( . (take:: Int -> [a] -> [a]))) . ) . ( . (((Just .) . ) . (.) )) . flip (.) . flip ( . ) . (nub . ) . randomRs . (0,) . subtract 1 . length <*>  map . (!!)

Problem 24:

p24_2 :: Int -> Int -> IO (Maybe [Int])
p24_2 = liftM2 ( `if'` return Nothing) . (>) <*>   ( . (randomRs  . (1,))) . (flip fmap newStdGen .) . (.) . ( . nub) . (Just .) . take

Problem 25:

p25_1 :: [a] -> IO [a]
p25_1 =  ( newStdGen <&> ) .  ((view _2 . until condition nextStep) . ) . ap (,[],,)  ( subtract 1 . length )    --first postition is the actual list , second is the new list ,
  where                                                                                                          --third contains the length  and fourth will contain the "Gen"
    condition = null . view _1
    nextStep  =  over _3 (subtract 1) .  join (( . snd) .  set _4 . view (_1._2)).  ( ap (liftA2 (++) . take) (drop. (+1)) . view (_1._1)  >>= over (_2._1) )  . ( ((:) . liftA2 (!!) (view (_2._1) ) (view (_1._1))) >>= over (_2._2) )  . join ((,) . liftA2  (randomR . (0,)) (view _3) (view _4))

Problem 26:

p26_2 :: Int -> [a] -> [[a]]
p26_2 =  flip ( ap ( filter   .  ( . length)  .  (==) ) . ((map (map snd)  . nubOn (map fst) . map (sortOn fst. nubOn fst)) . ) .  flip replicateM  . zip [1..])

SvenWille/Haskell99Pointfree

Haskell99Pointfree