# Haskell Quiz/DayRange/Solution Jethr0

### From HaskellWiki

< Haskell Quiz | DayRange(Difference between revisions)

m |
(sharpen cat) |
||

(3 intermediate revisions by one user not shown) | |||

Line 1: | Line 1: | ||

− | [[Category:Code]] |
+ | [[Category:Haskell Quiz solutions|DayRange]] |

<haskell> |
<haskell> |
||

− | dayRange = sepComma . map range . map (map toWeekday) . groupAscend . sort |
+ | -- > 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 ", " |
where sepComma = concat . intersperse ", " |
||

− | toWeekday x = weekdays!!(x-1) |
+ | 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 |
||

− | weekdays = ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"] |
||

− | groupAscend (x:xs) = together $ foldl ascend ([],[x]) xs |
+ | -- groupBy compares any element to the first one of the group |

− | where ascend (done,curr) e = if e == (last curr)+1 then (done, curr++[e]) |
+ | -- groupBy' instead compares an element to the last added group element |

− | else (done++[curr], [e]) |
+ | groupBy' :: (a -> a -> Bool) -> [a] -> [[a]] |

− | together (a,b) = a++[b] |
+ | 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> |

## Latest revision as of 10:46, 13 January 2007

-- > 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