Personal tools

Haskell Quiz/DayRange/Solution Jethr0

From HaskellWiki

< Haskell Quiz | DayRange(Difference between revisions)
Jump to: navigation, search
m (added example)
m (using a datatype, added type declarations)
Line 4: Line 4:
 
-- > dayRange [1,2,3,6,7]
 
-- > dayRange [1,2,3,6,7]
 
-- "Mon-Wed, Sat, Sun"
 
-- "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) . groupAscend . sort
 
dayRange = sepComma . map range . map (map toWeekday) . groupAscend . 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"]
 
   
  +
-- group list of numbers into directly ascending subgroups
  +
groupAscend :: [Int] -> [[Int]]
 
groupAscend (x:xs) = together $ foldl ascend ([],[x]) xs
 
groupAscend (x:xs) = together $ foldl ascend ([],[x]) xs
 
where ascend (done,curr) e = if e == (last curr)+1 then (done, curr++[e])
 
where ascend (done,curr) e = if e == (last curr)+1 then (done, curr++[e])
 
else (done++[curr], [e])
 
else (done++[curr], [e])
together (a,b) = a++[b]
+
together (a,b) = a++[b]
 
</haskell>
 
</haskell>

Revision as of 18:00, 16 December 2006


-- > 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) . groupAscend . sort
    where sepComma    = concat . intersperse ", "
          toWeekday x = show $ (toEnum (x-1) :: Weekday)
          range xs | length xs < 3 = sepComma xs
                   | otherwise     = head xs ++ "-" ++ last xs
 
-- group list of numbers into directly ascending subgroups
groupAscend :: [Int] -> [[Int]]
groupAscend (x:xs) = together $ foldl ascend ([],[x]) xs
    where ascend (done,curr) e = if e == (last curr)+1 then (done,         curr++[e])
                                                       else (done++[curr], [e])
          together (a,b) = a++[b]