105 lines
4.0 KiB
Haskell
105 lines
4.0 KiB
Haskell
import Data.List (intercalate)
|
|
|
|
data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday |
|
|
Saturday | Sunday
|
|
deriving (Eq, Show)
|
|
|
|
-- the whole thing bases upon an infinite list of weeks
|
|
|
|
daysFrom1_1_1900 :: [DayOfWeek]
|
|
daysFrom1_1_1900 = concat $ repeat [Monday, Tuesday, Wednesday,
|
|
Thursday, Friday, Saturday, Sunday]
|
|
|
|
data Month = January | February | March | April | May | June | July |
|
|
August | September | October | November | December
|
|
deriving (Show)
|
|
|
|
type Year = Int
|
|
type YearCalendar = (Year, [DayOfWeek])
|
|
type MonthlyCalendar = (Year, [(Month, [DayOfWeek])])
|
|
|
|
-- makes groups of 365 or 366 days for each year (infinite list)
|
|
|
|
yearsFrom :: [DayOfWeek] -> Year -> [YearCalendar]
|
|
yearsFrom s i = (i, yeardays) : yearsFrom rest (i + 1)
|
|
where
|
|
yeardays = take (leapOrNot i) s
|
|
yearlen = length yeardays
|
|
rest = drop yearlen s
|
|
leapOrNot n = if isLeapYear n then 366 else 365
|
|
|
|
yearsFrom1900 :: [YearCalendar]
|
|
yearsFrom1900 = yearsFrom daysFrom1_1_1900 1900
|
|
|
|
-- makes groups of days for each month of the year
|
|
|
|
months :: YearCalendar -> MonthlyCalendar
|
|
months (y, d) = (y, [(January, january), (February, february),
|
|
(March, march), (April, april), (May, may), (June, june),
|
|
(July, july), (August, august), (September, september),
|
|
(October, october), (November, november), (December, december)])
|
|
where
|
|
leapOrNot = if isLeapYear y then 29 else 28
|
|
january = take 31 d
|
|
february = take leapOrNot $ drop 31 d
|
|
march = take 31 $ drop (31 + leapOrNot) d
|
|
april = take 30 $ drop (62 + leapOrNot) d
|
|
may = take 31 $ drop (92 + leapOrNot) d
|
|
june = take 30 $ drop (123 + leapOrNot) d
|
|
july = take 31 $ drop (153 + leapOrNot) d
|
|
august = take 31 $ drop (184 + leapOrNot) d
|
|
september = take 30 $ drop (215 + leapOrNot) d
|
|
october = take 31 $ drop (245 + leapOrNot) d
|
|
november = take 30 $ drop (276 + leapOrNot) d
|
|
december = take 31 $ drop (306 + leapOrNot) d
|
|
|
|
-- see if a year is a leap year
|
|
|
|
isLeapYear n
|
|
| n `mod` 100 == 0 = n `mod` 400 == 0
|
|
| otherwise = n `mod` 4 == 0
|
|
|
|
-- make a list of the months of a year that have 5 weekends
|
|
-- (they must have 31 days and the first day must be Friday)
|
|
-- if the year doesn't contain any 5-weekended months, then
|
|
-- return the year and an empty list
|
|
|
|
whichFiveWeekends :: MonthlyCalendar -> (Year, [Month])
|
|
whichFiveWeekends (y, ms) = (y, map (\(m, _) -> m) found) -- extract the months & leave out their days
|
|
where found = filter (\(m, a@(d:ds)) -> and [length a == 31,
|
|
d == Friday]) ms
|
|
|
|
-- take all days from 1900 until 2100, grouping them by years, then by
|
|
-- months, and calculating whether they have any 5-weekended months
|
|
-- or not
|
|
|
|
calendar :: [MonthlyCalendar]
|
|
calendar = map months $ yearsFrom1900
|
|
|
|
fiveWeekends1900To2100 :: [(Year, [Month])]
|
|
fiveWeekends1900To2100 = takeWhile (\(y, _) -> y <= 2100) $
|
|
map whichFiveWeekends calendar
|
|
|
|
main = do
|
|
-- count the number of years with 5 weekends
|
|
let answer1 = foldl (\c (_, m) -> c + length m) 0 fiveWeekends1900To2100
|
|
-- take only the years with 5-weekended months
|
|
answer2 = filter (\(_, m) -> not $ null m) fiveWeekends1900To2100
|
|
-- take only the years without 5-weekended months
|
|
answer30 = filter (\(_, m) -> null m) fiveWeekends1900To2100
|
|
-- count how many years without 5-weekended months there are
|
|
answer31 = length answer30
|
|
-- show the years without 5-weekended months
|
|
answer32 = intercalate ", " $ map (\(y, m) -> show y) answer30
|
|
putStrLn $ "There are " ++ show answer1 ++ " months with 5 weekends between 1900 and 2100."
|
|
putStrLn "\nThe first ones are:"
|
|
mapM_ (putStrLn . formatMonth) $ take 5 $ answer2
|
|
putStrLn "\nThe last ones are:"
|
|
mapM_ (putStrLn . formatMonth) $ reverse $ take 5 $ reverse answer2
|
|
putStrLn $ "\n" ++ show answer31 ++ " years don't have at least one five-weekened month"
|
|
putStrLn "\nThose are:"
|
|
putStrLn answer32
|
|
|
|
formatMonth :: (Year, [Month]) -> String
|
|
formatMonth (y, m) = show y ++ ": " ++ intercalate ", " [ show x | x <- m ]
|