Personal tools

Haskell Quiz/DayRange/Solution Jethr0

From HaskellWiki

< Haskell Quiz | DayRange(Difference between revisions)
Jump to: navigation, search
m (using a datatype, added type declarations)
(sharpen cat)
 
(One intermediate revision by one user not shown)
Line 1: Line 1:
[[Category:Code]]
+
[[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"
data Weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun deriving (Show,Enum)
+
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 :: [Int] -> String
dayRange = sepComma . map range . map (map toWeekday) . groupAscend . sort
+
dayRange = sepComma . map range . map (map toWeekday) . groupBy' (\a b -> a+1 == b) . sort
 
     where sepComma    = concat . intersperse ", "
 
     where sepComma    = concat . intersperse ", "
 
           toWeekday x = show $ (toEnum (x-1) :: Weekday)
 
           toWeekday x = show $ (toEnum (x-1) :: Weekday)
Line 13: Line 18:
 
                   | otherwise    = head xs ++ "-" ++ last xs
 
                   | otherwise    = head xs ++ "-" ++ last xs
  
-- group list of numbers into directly ascending subgroups
+
-- groupBy compares any element to the first one of the group
groupAscend :: [Int] -> [[Int]]
+
-- groupBy' instead compares an element to the last added group element
groupAscend (x:xs) = together $ foldl ascend ([],[x]) xs
+
groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
     where ascend (done,curr) e = if e == (last curr)+1 then (done,        curr++[e])
+
groupBy' f (x:xs) = gb f xs [[x]]
                                                       else (done++[curr], [e])
+
     where gb f (x:xs) ((a:as):bs) = gb f xs $ if f a x then ((x:a:as):bs)
          together (a,b) = a++[b]                                                                                    
+
                                                       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