Haskell Quiz/DayRange/Solution Jethr0
From HaskellWiki
< Haskell Quiz | DayRange(Difference between revisions)
m (added example) |
(sharpen cat) |
||
| (2 intermediate revisions not shown.) | |||
| Line 1: | Line 1: | ||
| - | [[Category: | + | [[Category:Haskell Quiz solutions|DayRange]] |
<haskell> | <haskell> | ||
-- > dayRange [1,2,3,6,7] | -- > dayRange [1,2,3,6,7] | ||
-- "Mon-Wed, Sat, Sun" | -- "Mon-Wed, Sat, Sun" | ||
| - | dayRange = sepComma . map range . map (map toWeekday) . | + | module DayRange where |
| + | import Data.List (intersperse,sort) | ||
| + | |||
| + | -- > dayRange [1,2,3,6,7] | ||
| + | -- "Mon-Wed, Sat, Sun" | ||
| + | data Weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun deriving (Show,Enum) | ||
| + | |||
| + | dayRange :: [Int] -> String | ||
| + | dayRange = sepComma . map range . map (map toWeekday) . groupBy' (\a b -> a+1 == b) . sort | ||
where sepComma = concat . intersperse ", " | where sepComma = concat . intersperse ", " | ||
| - | toWeekday x = | + | toWeekday x = show $ (toEnum (x-1) :: Weekday) |
range xs | length xs < 3 = sepComma xs | range xs | length xs < 3 = sepComma xs | ||
| otherwise = head xs ++ "-" ++ last xs | | otherwise = head xs ++ "-" ++ last xs | ||
| - | |||
| - | + | -- groupBy compares any element to the first one of the group | |
| - | where | + | -- groupBy' instead compares an element to the last added group element |
| - | else ( | + | groupBy' :: (a -> a -> Bool) -> [a] -> [[a]] |
| - | + | groupBy' f (x:xs) = gb f xs [[x]] | |
| + | where gb f (x:xs) ((a:as):bs) = gb f xs $ if f a x then ((x:a:as):bs) | ||
| + | else ([x]:(a:as):bs) | ||
| + | gb _ [] as = reverse . map reverse $ as | ||
</haskell> | </haskell> | ||
Current revision
-- > dayRange [1,2,3,6,7] -- "Mon-Wed, Sat, Sun" module DayRange where import Data.List (intersperse,sort) -- > dayRange [1,2,3,6,7] -- "Mon-Wed, Sat, Sun" data Weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun deriving (Show,Enum) dayRange :: [Int] -> String dayRange = sepComma . map range . map (map toWeekday) . groupBy' (\a b -> a+1 == b) . sort where sepComma = concat . intersperse ", " toWeekday x = show $ (toEnum (x-1) :: Weekday) range xs | length xs < 3 = sepComma xs | otherwise = head xs ++ "-" ++ last xs -- groupBy compares any element to the first one of the group -- groupBy' instead compares an element to the last added group element groupBy' :: (a -> a -> Bool) -> [a] -> [[a]] groupBy' f (x:xs) = gb f xs [[x]] where gb f (x:xs) ((a:as):bs) = gb f xs $ if f a x then ((x:a:as):bs) else ([x]:(a:as):bs) gb _ [] as = reverse . map reverse $ as
