# 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: | + | [[Category:Haskell Quiz solutions|DayRange]] |

<haskell> | <haskell> | ||

− | dayRange = sepComma . map range . map (map toWeekday) . | + | -- > 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 = | + | 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> |

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