In a New York Minute

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)