fix: first and last week of month and year (#10)

clinc · Jun 28, 2021 · 4c04a18 · 4c04a18
1 parent 3361f93
commit 4c04a18
Show file tree

Hide file tree

Showing 18 changed files with 4,328 additions and 4,609 deletions.
diff --git a/Duckling/Ranking/Classifiers/EN_AU.hs b/Duckling/Ranking/Classifiers/EN_AU.hs
diff --git a/Duckling/Ranking/Classifiers/EN_BZ.hs b/Duckling/Ranking/Classifiers/EN_BZ.hs
diff --git a/Duckling/Ranking/Classifiers/EN_CA.hs b/Duckling/Ranking/Classifiers/EN_CA.hs
diff --git a/Duckling/Ranking/Classifiers/EN_GB.hs b/Duckling/Ranking/Classifiers/EN_GB.hs
diff --git a/Duckling/Ranking/Classifiers/EN_IE.hs b/Duckling/Ranking/Classifiers/EN_IE.hs
diff --git a/Duckling/Ranking/Classifiers/EN_IN.hs b/Duckling/Ranking/Classifiers/EN_IN.hs
diff --git a/Duckling/Ranking/Classifiers/EN_JM.hs b/Duckling/Ranking/Classifiers/EN_JM.hs
diff --git a/Duckling/Ranking/Classifiers/EN_NZ.hs b/Duckling/Ranking/Classifiers/EN_NZ.hs
diff --git a/Duckling/Ranking/Classifiers/EN_PH.hs b/Duckling/Ranking/Classifiers/EN_PH.hs
diff --git a/Duckling/Ranking/Classifiers/EN_TT.hs b/Duckling/Ranking/Classifiers/EN_TT.hs
diff --git a/Duckling/Ranking/Classifiers/EN_US.hs b/Duckling/Ranking/Classifiers/EN_US.hs
diff --git a/Duckling/Ranking/Classifiers/EN_XX.hs b/Duckling/Ranking/Classifiers/EN_XX.hs
diff --git a/Duckling/Ranking/Classifiers/EN_ZA.hs b/Duckling/Ranking/Classifiers/EN_ZA.hs
diff --git a/Duckling/Ranking/Classifiers/FR_XX.hs b/Duckling/Ranking/Classifiers/FR_XX.hs
@@ -780,7 +780,7 @@ classifiers
                                      -6.215607598755275),
                                     ("intersectyear", -5.52246041819533),
                                     ("Fevrierfin de matin\233e", -6.215607598755275),
-                                    ("minuteday", -3.474767574830074),
+                                    ("minuteday", -3.4747675748300746),
                                     ("le <time>d\233but de matin\233e", -6.215607598755275),
                                     ("Mardile <time>", -4.829313237635384),
                                     ("aujourd'hui\224|vers <time-of-day>", -5.29931686688112),

diff --git a/Duckling/Ranking/Classifiers/IT_XX.hs b/Duckling/Ranking/Classifiers/IT_XX.hs
@@ -327,10 +327,10 @@ classifiers
                                unseen = -4.31748811353631,
                                likelihoods =
                                  HashMap.fromList
-                                   [("<integer> (latent time-of-day)", -0.9718605830289657),
+                                   [("<integer> (latent time-of-day)", -0.9718605830289658),
                                     ("intersect by \"di\", \"della\", \"del\"", -3.20545280453606),
                                     ("day", -2.3581549441488563), ("Lunedi", -3.6109179126442243),
-                                    ("hour", -0.9718605830289657),
+                                    ("hour", -0.9718605830289658),
                                     ("two time tokens separated by `di`", -3.20545280453606),
                                     ("Domenica", -3.6109179126442243)],
                                n = 33}}),

diff --git a/Duckling/Time/EN/Corpus.hs b/Duckling/Time/EN/Corpus.hs
@@ -468,23 +468,23 @@ allExamples = concat
   , examples (datetime (2013, 10, 3, 0, 0, 0) Day)
              [ "third day of october"
              ]
-  , examples (datetime (2014, 10, 6, 0, 0, 0) Week)
+  , examples (datetime (2014, 9, 29, 0, 0, 0) Week)
              [ "first week of october 2014"
              ]
-  , examples (datetime (2018, 12, 10, 0, 0, 0) Week)
+  , examples (datetime (2018, 12, 17, 0, 0, 0) Week)
              [ "third last week of 2018"
              , "the third last week of 2018"
              , "the 3rd last week of 2018"
              ]
-  , examples (datetime (2018, 10, 15, 0, 0, 0) Week)
+  , examples (datetime (2018, 10, 22, 0, 0, 0) Week)
              [ "2nd last week of October 2018"
              , "the second last week of October 2018"
              ]
   , examples (datetime (2013, 5, 27, 0, 0, 0) Day)
              [ "fifth last day of May"
              , "the 5th last day of May"
              ]
-  , examples (datetime (2013, 10, 7, 0, 0, 0) Week)
+  , examples (datetime (2013, 9, 30, 0, 0, 0) Week)
              [ "the week of october 6th"
              ]
   , examples (datetime (2013, 10, 7, 0, 0, 0) Week)
@@ -494,7 +494,7 @@ allExamples = concat
              [ "last day of october 2015"
              , "last day in october 2015"
              ]
-  , examples (datetime (2014, 9, 22, 0, 0, 0) Week)
+  , examples (datetime (2014, 9, 29, 0, 0, 0) Week)
              [ "last week of september 2014"
              ]
   , examples (datetime (2013, 10, 1, 0, 0, 0) Day)

diff --git a/Duckling/Time/EN/Rules.hs b/Duckling/Time/EN/Rules.hs
@@ -266,21 +266,6 @@ ruleLastDOWOfTime = Rule
       _ -> Nothing
   }
 
-ruleLastCycleOfTime :: Rule
-ruleLastCycleOfTime = Rule
-  { name = "last <cycle> of <time>"
-  , pattern =
-    [ regex "last"
-    , dimension TimeGrain
-    , regex "of|in"
-    , dimension Time
-    ]
-  , prod = \tokens -> case tokens of
-      (_:Token TimeGrain grain:_:Token Time td:_) ->
-        tt $ cycleLastOf grain td
-      _ -> Nothing
-  }
-
 ruleLastNight :: Rule
 ruleLastNight = Rule
   { name = "last night"
@@ -2271,7 +2256,7 @@ ruleCycleOrdinalOfTime = Rule
   , prod = \tokens -> case tokens of
       (token:Token TimeGrain grain:_:Token Time td:_) -> do
         n <- getIntValue token
-        tt $ cycleNthAfter True grain (n - 1) td
+        tt $ cycleNthAfter False grain (n - 1) td
       _ -> Nothing
   }
 
@@ -2280,15 +2265,18 @@ ruleCycleLastOrdinalOfTime = Rule
   { name = "<ordinal> last <cycle> of <time>"
   , pattern =
     [ dimension Ordinal
-    , regex "last"
+    , regex "(to )?(last|final)"
     , dimension TimeGrain
     , regex "of|in|from"
     , dimension Time
     ]
   , prod = \tokens -> case tokens of
       (token:_:Token TimeGrain grain:_:Token Time td:_) -> do
         n <- getIntValue token
-        tt . cycleNthAfter True grain (-n) . cycleNthAfter True (timeGrain td) 1 $ td
+        base <- Just $ cycleNthAfter True (timeGrain td) 1 td
+        case grain of
+          TG.Week -> tt $ cycleNthWeekToLast grain (-n) base
+          _       -> tt $ cycleNthAfter True grain (-n) base
       _ -> Nothing
   }
 
@@ -2305,7 +2293,7 @@ ruleCycleTheOrdinalOfTime = Rule
   , prod = \tokens -> case tokens of
       (_:token:Token TimeGrain grain:_:Token Time td:_) -> do
         n <- getIntValue token
-        tt $ cycleNthAfter True grain (n - 1) td
+        tt $ cycleNthAfter False grain (n - 1) td
       _ -> Nothing
   }
 
@@ -2315,15 +2303,18 @@ ruleCycleTheLastOrdinalOfTime = Rule
   , pattern =
     [ regex "the"
     , dimension Ordinal
-    , regex "last|final"
+    , regex "(to )?(last|final)"
     , dimension TimeGrain
     , regex "of|in|from"
     , dimension Time
     ]
   , prod = \tokens -> case tokens of
       (_:token:_:Token TimeGrain grain:_:Token Time td:_) -> do
         n <- getIntValue token
-        tt . cycleNthAfter True grain (-n) . cycleNthAfter True (timeGrain td) 1 $ td
+        base <- Just $ cycleNthAfter True (timeGrain td) 1 td
+        case grain of
+          TG.Week -> tt $ cycleNthWeekToLast grain (-n) base 
+          _       -> tt $ cycleNthAfter True grain (-n) base
       _ -> Nothing
   }
 
@@ -2338,7 +2329,10 @@ ruleCycleTheLastOfTime = Rule
     ]
   , prod = \tokens -> case tokens of
       (_:Token TimeGrain grain:_:Token Time td:_) -> do
-        tt . cycleNthAfter True grain (-1) . cycleNthAfter True (timeGrain td) 1 $ td
+        base <- Just $ cycleNthAfter True (timeGrain td) 1 td
+        case grain of
+          TG.Week -> tt $ cycleNthWeekToLast grain (-1) base
+          _ ->       tt $ cycleNthAfter True grain (-1) base
       _ -> Nothing
   }
 
@@ -2353,7 +2347,7 @@ ruleCycleTheOfTime = Rule
     ]
   , prod = \tokens -> case tokens of
       (_:Token TimeGrain grain:_:Token Time td:_) ->
-        tt $ cycleNthAfter True grain 0 td
+        tt $ cycleNthAfter False grain 0 td
       _ -> Nothing
   }
 
@@ -2375,7 +2369,7 @@ ruleCycleOrdinalAfterTime = Rule
 
 ruleCycleTheOrdinalAfterTime :: Rule
 ruleCycleTheOrdinalAfterTime = Rule
-  { name = "<ordinal> <cycle> after <time>"
+  { name = "the <ordinal> <cycle> after <time>"
   , pattern =
     [ regex "the"
     , dimension Ordinal
@@ -2799,7 +2793,6 @@ rules =
   , ruleTimeBeforeLastAfterNext
   , ruleOrdinalDOWOfTime
   , ruleLastDOWOfTime
-  , ruleLastCycleOfTime
   , ruleLastNight
   , ruleLastWeekendOfMonth
   , ruleNthTimeOfTime

diff --git a/Duckling/Time/Helpers.hs b/Duckling/Time/Helpers.hs
@@ -17,8 +17,8 @@ module Duckling.Time.Helpers
   , isIntegerBetween, isNotLatent , isOrdinalBetween, isMidnightOrNoon
   , isOkWithThisNext, sameGrain, hasTimezone, hasNoTimezone, today
     -- Production
-  , cycleLastOf, cycleN, cycleNth, cycleNthAfter, dayOfMonth, dayOfWeek
-  , durationAfter, durationAgo, durationBefore, mkOkForThisNext, form, hour
+  , cycleLastOf, cycleN, cycleNth, cycleNthAfter, cycleNthWeekToLast, dayOfMonth
+  , dayOfWeek, durationAfter, durationAgo, durationBefore, mkOkForThisNext, form, hour
   , hourMinute, hourMinuteSecond, inDuration, intersect, intersectDOM, interval
   , inTimezone, longWEBefore, minute, minutesAfter, minutesBefore, mkLatent
   , month, monthDay, notLatent, now, nthDOWOfMonth, partOfDay, predLastOf
@@ -192,6 +192,35 @@ takeNthAfter n notImmediate cyclicPred basePred =
            [] -> Nothing
            (nth:_) -> Just nth
 
+-- | Like `takeNthAfter`, but corrects predicates which overshoot to next grain
+takeNthWeekToLast
+  :: Int
+  -> TTime.Predicate
+  -> TTime.Predicate
+  -> TTime.Predicate
+takeNthWeekToLast n cyclicPred basePred =
+  mkSeriesPredicate $! TTime.timeSeqMap False f basePred
+  where
+    f t ctx =
+      let (past, future) = runPredicate cyclicPred t ctx
+          rest = if n >= 0
+            then case future of
+              (ahead:_) | True && TTime.timeBefore ahead t
+                -> drop (n + 1) future
+              _ -> drop n future
+            else drop (- (n + 1)) past
+      in case rest of
+        [] -> Nothing
+        (nth:_) -> t
+          where
+            -- get last week of cycle and second to last week of cycle
+            -- if they are in the same month, then add a week to the current result
+            (TTime.TimeObject (Time.UTCTime day _) _ _) = TTime.timePlusEnd nth TG.Week $ toInteger $ negate n
+            (TTime.TimeObject (Time.UTCTime day2 _) _ _) = TTime.timePlusEnd nth TG.Week $ toInteger $ negate (n + 1)
+            (_, month, _) = Time.toGregorian day
+            (_, month2, _) = Time.toGregorian day2
+            t = if month == month2 then Just $ TTime.timePlusEnd nth TG.Week 1 else Just nth
+
 -- | Take the nth closest value to `basePred` among those yielded by
 -- `cyclicPred`.
 -- n = 0 is the closest value, n = 1 is the second closest value, etc.
@@ -503,6 +532,13 @@ cycleNthAfter notImmediate grain n TimeData {TTime.timePred = p} =
     , TTime.timeGrain = grain
     }
 
+cycleNthWeekToLast :: TG.Grain -> Int -> TimeData -> TimeData
+cycleNthWeekToLast grain n TimeData {TTime.timePred = p} =
+  TTime.timedata'
+    { TTime.timePred = takeNthWeekToLast n (timeCycle grain) p
+    , TTime.timeGrain = grain
+    }
+
 cycleLastOf :: TG.Grain -> TimeData -> TimeData
 cycleLastOf grain TimeData {TTime.timePred = p} = TTime.timedata'
   { TTime.timePred = takeLastOf (timeCycle grain) p