**Paste:**#107370**Author:**1HaskellADay**Language:**Haskell**Channel:**-**Created:**2014-07-12 03:45:13 UTC**Revisions:**- 2014-07-12 03:55:57 UTC #107373 (diff): No title (1HaskellADay)
- 2014-07-12 03:45:13 UTC #107370: In a New York Minute (1HaskellADay)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 | import Locale import Data.Time.LocalTime import Data.Time.Calendar import Data.Time.Format import Data.Time.Calendar.MonthDay import Data.Time.Clock -- I added this one for the current time import Data.Set (Set) import qualified Data.Set as Set import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.List import Control.Arrow import Control.Monad import Control.List -- http://lpaste.net/107211 {-- The below are solutions to the problems posed in the New York Minute exercise found at http://lpaste.net/107328 1. isNYminute is super-easy to define ... in terms of mkNYminute. You either make a NY minute from the time (returning True) or you don't (returning ... 'coTrue.' Heh.) --} isNYminute :: LocalTime -> Bool isNYminute datetime = isJust $ explode datetime >>= mkNYminute -- explode explodes a local time into a set-o-unique-ints, if possible explode :: LocalTime -> Maybe (Set Int) explode (LocalTime date time) = let (TimeOfDay hr min _) = time timeo = [hr, min] in explodeDay date >>= \dayo -> let elts = [dayo, timeo] in guard (allUniqElems elts) >> return (Set.fromList $ join elts) explodeDay :: Day -> Maybe [Int] explodeDay date = let (yr, mos, day) = toGregorian date elts = [yearInset yr, mos, day] in guard (allUniqElems [elts]) >> return elts -- yearInset 'un-offsets' the offsetted year to a 2-digit year. -- ... 'Why?' you ask. Good question. Um ... because we SO LOVE -- the infamous y2k debacle that we SO want to repeat it. AGAIN! -- that's why. :p yearInset :: Integer -> Int yearInset yr = fromInteger yr - 1900 -- now gives you the time. Right now. now :: IO LocalTime now = getCurrentTime >>= \utct -> getTimeZone utct >>= return . flip utcToLocalTime utct {-- 2. mkNYminute Do New York Minutes exist? The answer is "yes": for example, 9:47 on 12/31/90. let leap = isLeapYear 1990 -- False dpm = monthLength leap 12 -- 31 so, the rules! day :- n <= dpm month n :- n <= 12 hour n :- n <= 12 minute n :- n <= 60 -- no seconds! year n :- n > 59 !!! deriving the type of n from the rules: n == Type t iff length rules n == 1 then we eliminate that rule matcher from the set of remaining numbers. So! Map Int [Rule] matches ... yeah, I went ahead and did it. I implemented a whole rule-based system out of need to solve the 'very simple' problem of determining whether the given time is a New York minute. But rule-based systems are just... so... cool! AND! This rule-based system doesn't use back-tracking as its proof search algorithm. No. It uses progressive refinement down to the solution. This is what you call a 'progressive system.' Literally. Fer realz, yo! --} data Type = Year | Month | Day | Hour | Minute deriving (Eq, Ord, Show) data Rule = Match { cat :: Type, range :: (Int,Int) } deriving (Eq, Show) data Matches = RulesFor { num :: Int, cats :: [Type] } deriving (Eq, Show) type YearMonth = (Int, Int) -- this is the sample problem given in the original statement. sample :: Set Int sample = Set.fromList [9, 47, 12, 31, 90] yearOffset :: Int -> Integer yearOffset y2k = (if y2k > 49 then 1900 else 2000) + toInteger y2k -- fix offset for years > 1999 rules :: YearMonth -> [Rule] -- ooh, this is very dependent-type-y! rules (yr, mos) = let leap = isLeapYear $ yearOffset yr dpm = monthLength leap mos in -- Match Year 99, Match Month 12, -- implied by Rules [Match Day (12, dpm), Match Hour (0,12), Match Minute (dpm,60)] rulesForNums :: Set Int -> [(YearMonth, Matches)] -- is there only one num > 59? -- after that, is there only one num > 12 -- actually, is the above inquiry thrashy? rulesForNums nums = takeout (Set.toList nums) >>= \(yr, next) -> guard (yr > 59) >> takeout next >>= \(mos, rem) -> guard (mos < 13) >> map (numsToRulesFor (yr, mos)) rem numsToRulesFor :: YearMonth -> Int -> (YearMonth, Matches) numsToRulesFor ym@(yr, mos) num = (ym, RulesFor num $ map cat $ filter (appR num) $ rules ym) appR :: Int -> Rule -> Bool appR num (Match _ (min,max)) = num <= max && num > min -- first we get all possible rule-sets for all viable year-month pairs: mappedRawRules :: Set Int -> Map YearMonth [Matches] mappedRawRules nums = foldr (\(ym, rule) -> Map.insertWith (++) ym [rule]) Map.empty (rulesForNums nums) -- now we need to prune out rules that have duplicate- or empty-cases pruneRules :: Map YearMonth [Matches] -> Map YearMonth [Matches] pruneRules rules = foldr (uncurry Map.insert) Map.empty (filter validRules $ Map.toList rules) validRules :: (YearMonth, [Matches]) -> Bool validRules (_, matchSets) = let matches = map cats matchSets in all consList matches && allUniqElems matches {-- But, actually, is allUniqElems complete? Or is it much too restrictive? If we have the ruleset: [[Day,Minute,Hour], [Day,Minute], [Minute]], then by progressive elimination we can determine this ruleset uniquely determines the type for each element. Does this case come up in practice? Are there edge cases were this is a possible scenario? ... no, by refining the rule type to be a range (it originally was just a 'less than or equal to'-Int rule, now it's a ranged value), the tuple (Day, Hour, Minute) are now internally mutually exclusive. The above function works correctly in light of these exclusively-ranged rules. --} -- so, with the above we now can construct our result... 'constructively.' mkNYminute :: Set Int -> Maybe LocalTime mkNYminute = mbConstructNYminute . Map.toList . pruneRules . mappedRawRules mbConstructNYminute :: [(YearMonth, [Matches])] -> Maybe LocalTime mbConstructNYminute [(ym, numsMatches)] = thenMkNYminute ym numsMatches mbConstructNYminute _ = Nothing -- ... and even more ... 'constructively.' thenMkNYminute :: YearMonth -> [Matches] -> Maybe LocalTime thenMkNYminute (yr, mos) rules = let vals = [(day, hour, minute) | (RulesFor day rd) <- rules, Day <- rd, (RulesFor hour rh) <- rules, Hour <- rh, (RulesFor minute rm) <- rules, Minute <- rm] in guard (length vals == 1) >> let (day, hour, minute) = head vals in return $ LocalTime (fromGregorian (yearOffset yr) mos day) (TimeOfDay hour minute 0) -- ... and that was exercise 2 of the New York Minute exercise. -- ... now, aren't you glad you did that? -- Don't answer that question. {-- 3. todaysNYminutes is easy, given the implementation of 4: daysNYminutes --} todaysNYminutes :: IO [LocalTime] todaysNYminutes = liftM (daysNYminutes . localDay) now {-- So, today, being July 11th, 2014, has no New York Minutes! WAAH! BOO-HOO! BUT! ... 4. so that just leaves us to iterate through most the minutes of a given day. ... I THINK the year MUST be greater than 59 ... :/ You see the conundrum? If year < 60, then minute and year are interchangeable! This violates the New York Minute principle that each number is uniquely- placed. --} daysNYminutes :: Day -> [LocalTime] daysNYminutes date = maybeToList (explodeDay date) >>= \[yr, mos, day] -> let [Match Day (_,maxDay), hourR, minuteR] = rules (yr, mos) in guard (yr `mod` 100 > 59 && day > 12) >> [(hr, min) | min <- [maxDay + 1 .. 59], hr <- delete mos [1..12]] >>= -- so, yr, mos, day, hr, min are now all mutually-unique \(hr, min) -> maybeToList $ mkNYminute $ Set.fromList [yr, mos, day, hr, min] -- the sample date's (1990-12-31) has 140 NY minutes! YAY! -- daysNYminutes (fromGregorian 1990 12 31) ~> 1990-12-31 04:59:00, etc ... -- and 139 more day-times similarly arrayed. -- Okay, more than 250 lines, including mostly comments. Not a trivial -- approach, to be sure, but you get to see how I do rule-based systems -- in Haskell. So, that, and USD 6.25, will get you a Venti Frap at sbux. -- The next P31-and-on P-99 problems coming up will shift focus from list -- to algebraic inquiries, e.g.: P31: primes. But we'll start that next week. |

64:35: Warning: Use liftM

Found:

getTimeZone utct >>= return . flip utcToLocalTime utct

Why not:

liftM (flip utcToLocalTime utct) (getTimeZone utct)