Ninety-Nine Haskell Problems: #9

banovski

Mar 31st, 2025 (edited)

1,570

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

Haskell 2.09 KB | Source Code | 0 0

raw download clone embed print report

-- Pack consecutive duplicates of list elements into sublists. If a
-- list contains repeated elements they should be placed in separate
-- sublists.
import Data.List (group)
-- "group" is imported as a reference function
main :: IO ()
main = do
putStrLn "Test strings: "
mapM_ print $ chunksOfFour testStringList
putStrLn "\nTested functions validity check: "
mapM_ (print . testFunction) testFuncList
testStringList :: [String]
testStringList = pure (\a b c d -> [a, b, c, d])
<*> "ab"
<*> "ab"
<*> "ab"
<*> "ab"
chunksOfFour :: [a] -> [[a]]
chunksOfFour [] = []
chunksOfFour lst = take 4 lst : chunksOfFour (drop 4 lst)
testFuncList :: Eq a => [[a] -> [[a]]]
testFuncList = [zero, one, two, three]
testFunction :: (String -> [String]) -> Bool
testFunction function =
-- group from Data.List is used to produce reference results
map function testStringList == map group testStringList
-- Functions were tested on a list with duplicates, 1000405 items
-- long. Time each function takes to complete the task is measured in
-- ticks.
-- 128 ticks
zero :: Eq a => [a] -> [[a]]
zero = group
-- 221 ticks
one :: Eq a => [a] -> [[a]]
one [] = []
one [a] = [[a]]
one lst = go [head lst] (tail lst)
where
go a [] = [a]
go a (x:xs)
| head a == x = go (a ++ [x]) xs
| otherwise = a : go [x] xs
-- 285 ticks
two :: Eq a => [a] -> [[a]]
two lst =
let
itemsAsLists = map (:[]) lst
h = head itemsAsLists
t = tail itemsAsLists
join a [] = [a]
join acc (x:xs)
| head acc == head x = join (acc ++ x) xs
| otherwise = acc : join x xs
in
join h t
-- 138 ticks
three :: Eq a => [a] -> [[a]]
three [] = []
three [x] = [[x]]
three lst = foldr go [[last lst]] (init lst)
where
go x (y:ys)
| x == head y = (x : y) : ys
| otherwise = [x] : y : ys
-- Test strings:
-- ["aaaa","aaab","aaba","aabb"]
-- ["abaa","abab","abba","abbb"]
-- ["baaa","baab","baba","babb"]
-- ["bbaa","bbab","bbba","bbbb"]
-- Tested functions validity check:
-- True
-- True
-- True
-- True

Add Comment

Please, Sign In to add comment