Bugfix next run date

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rapbase
 Type: Package
 Title: Base Functions and Resources for Rapporteket
-Version: 1.20.1
+Version: 1.20.2
 Authors@R: c(
     person(given = "Are",
            family = "Edvardsen",

NEWS.md

@@ -1,3 +1,7 @@
+# rapbase 1.20.2
+
+* Fix short-term error in function finding next run date in auto reports
+
 # rapbase 1.20.1
 
 * Fix unit testing issue by also allowing "MockShinySession" as an attribute of the shiny session object

R/AutoReportFuns.R

@@ -25,6 +25,8 @@
 #' @param organization String identifying the organization the owner belongs to
 #' @param runDayOfYear Integer vector with day numbers of the year when the
 #' report is to be run
+#' @param startDate Date-class date when report will be run first time. Default
+#' value is set to \code{Sys.Date() + 1} \emph{i.e.} tomorrow.
 #' @param terminateDate Date-class date after which report is no longer run.
 #' Default value set to \code{NULL} in which case the function will provide an
 #' expiry date adding 3 years to the current date if in a PRODUCTION context
@@ -45,6 +47,7 @@
 createAutoReport <- function(synopsis, package, type = "subscription", fun,
                              paramNames, paramValues, owner, ownerName = "",
                              email, organization, runDayOfYear,
+                             startDate = as.character(Sys.Date()),
                              terminateDate = NULL, interval = "",
                              intervalName = "", dryRun = FALSE) {
 
@@ -75,6 +78,7 @@ createAutoReport <- function(synopsis, package, type = "subscription", fun,
   l$ownerName <- ownerName
   l$email <- email
   l$organization <- organization
+  l$startDate <- as.character(startDate)
   l$terminateDate <- as.character(terminateDate)
   l$interval <- interval
   l$intervalName <- intervalName
@@ -159,6 +163,7 @@ upgradeAutoReportData <- function(config) {
   upgradeType <- FALSE
   upgradeOwnerName <- FALSE
   upgradeParams <- FALSE
+  upgradeStartDate <- FALSE
 
   for (i in seq_len(length(config))) {
     rep <- config[[i]]
@@ -180,6 +185,10 @@ upgradeAutoReportData <- function(config) {
       }
       config[[i]]$params <- as.list(stats::setNames(paramValue, paramName))
     }
+    if (!"startDate" %in% names(rep)) {
+      upgradeStartDate <- TRUE
+      config[[i]]$startDate <- Sys.Date()
+    }
   }
 
   if (upgradeType) {
@@ -203,6 +212,12 @@ upgradeAutoReportData <- function(config) {
       "registries are still working as expected."
     ))
   }
+  if (upgradeStartDate) {
+    message(paste(
+      "Auto report data were upgraded:",
+      "auto reports with no start date defined now set to the current date."
+    ))
+  }
 
   config
 }
@@ -645,6 +660,10 @@ makeRunDayOfYearSequence <- function(startDay = Sys.Date(), interval) {
 #'
 #' @param runDayOfYear Numeric vector providing year-day numbers
 #' @param baseDayNum Numeric defining base year-day. Default is today
+#' @param startDate Character string of format "YYYY-MM-DD" defining the date of
+#' the very first run. If set to NULL (default) or a none future date (compared
+#' to the date represented by \code{baseDayNum} for the current year) it will be
+#' disregarded.
 #' @param returnFormat String providing return format as described in
 #' \code{\link[base]{strptime}} in the current locale. Defaults to
 #' "\%A \%d. \%B \%Y" that will provide something like
@@ -657,17 +676,52 @@ makeRunDayOfYearSequence <- function(startDay = Sys.Date(), interval) {
 
 findNextRunDate <- function(runDayOfYear,
                             baseDayNum = as.POSIXlt(Sys.Date())$yday + 1,
+                            startDate = NULL,
                             returnFormat = "%A %e. %B %Y") {
+
   year <- as.POSIXlt(Sys.Date())$year + 1900
 
-  if (baseDayNum >= max(runDayOfYear) | length(runDayOfYear) == 1 &
-    baseDayNum >= max(runDayOfYear)) {
-    # next run will be first run of next year
+  if (!is.null(startDate)) {
+    if (as.Date(startDate) > as.Date(strptime(paste(year, baseDayNum),
+                                              "%Y %j"))) {
+      # since we pull the NEXT run day set new base day on day BEFORE star date
+      baseDayNum <- as.POSIXlt(startDate)$yday
+    }
+  }
+
+  # special case if out of max range and only one run day defined (yearly)
+  if (baseDayNum >= max(runDayOfYear) | length(runDayOfYear) == 1) {
+    # next run will be first run in day num vector
     nextDayNum <- min(runDayOfYear)
-    year <- year + 1
   } else {
-    # next run will be next run day this year
-    nextDayNum <- min(runDayOfYear[runDayOfYear > baseDayNum])
+    # find year transition, if any
+    nDay <- length(runDayOfYear)
+    deltaDay <- runDayOfYear[2:nDay] - runDayOfYear[1:(nDay - 1)]
+    trans <- deltaDay < 0
+    if (any(trans)) {
+      indTrans <- match(TRUE, trans)
+      # vector head
+      dHead <- runDayOfYear[1:indTrans]
+      # vector tail
+      dTail <- runDayOfYear[(indTrans + 1):nDay]
+
+      if (baseDayNum >= max(dTail)) {
+        ## next run day to be found in vector head
+        runDayOfYearSubset <- dHead
+      } else {
+        ## next run day to be found in vector tail
+        runDayOfYearSubset <- dTail
+      }
+    } else {
+      runDayOfYearSubset <- runDayOfYear
+    }
+
+    nextDayNum <- min(runDayOfYearSubset[runDayOfYearSubset > baseDayNum])
+  }
+
+  # if current day num larger than nextDayNum report will be run next year
+  if (as.numeric(format(Sys.Date(), "%j")) > nextDayNum) {
+    year <- year + 1
   }
 
   format(strptime(paste(year, nextDayNum), "%Y %j"), format = returnFormat)
@@ -742,7 +796,9 @@ makeAutoReportTab <- function(session, namespace = character(),
   dateFormat <- "%A %e. %B %Y"
 
   for (n in names(autoRep)) {
-    nextDate <- findNextRunDate(autoRep[[n]]$runDayOfYear,
+    nextDate <- findNextRunDate(
+      runDayOfYear = autoRep[[n]]$runDayOfYear,
+      startDate = autoRep[[n]]$startDate,
       returnFormat = dateFormat
     )
     if (as.Date(nextDate, format = dateFormat) > autoRep[[n]]$terminateDate) {

R/autoReport.R

@@ -287,6 +287,7 @@ autoReportServer <- function(id, registryName, type, org = NULL,
           interval = interval,
           startDay = input$start
         ),
+        startDate = input$start,
         interval = interval,
         intervalName = strsplit(input$freq, "-")[[1]][1]
       )
@@ -386,7 +387,9 @@ autoReportServer <- function(id, registryName, type, org = NULL,
         ),
         value = seq.Date(Sys.Date(),
                          by = strsplit(input$freq, "-")[[1]][2],
-                         length.out = 2)[2]
+                         length.out = 2)[2],
+        min = Sys.Date() + 1,
+        max = seq.Date(Sys.Date(), length.out = 2, by = "1 years")[2] - 1
       )
     })
 

inst/autoReport.yml

@@ -12,6 +12,7 @@ testAutoReportFirst:
   - Some One <someone@nowhere.com>
   - Jesus <jesus@sky.com>
   organization: '999999'
+  startDate: '1900-01-01'
   terminateDate: '9999-12-31'
   interval:
   intervalName:
@@ -30,6 +31,7 @@ testAutoReportSecond:
   owner: ttester
   email: <someone@nowhere.com>
   organization: '999999'
+  startDate: '1900-01-01'
   terminateDate: '9999-12-31'
   interval:
   intervalName:
@@ -53,6 +55,7 @@ testAutoReportThird:
   - <someone@nowhere.com>
   - jesus@sky.com
   organization: '999999'
+  startDate: '1900-01-01'
   terminateDate: '9999-12-31'
   interval:
   intervalName:
@@ -71,6 +74,7 @@ testAutoReportThird:
   owner: ttester
   email: tester@skde.no
   organization: '999999'
+  startDate: '1900-01-01'
   terminateDate: '9999-12-31'
   interval:
   intervalName:
@@ -86,6 +90,7 @@ cd467ac14dd848b8798a384a3e51512c:
   owner: ttester
   email: tester@skde.no
   organization: '999999'
+  startDate: '1900-01-01'
   terminateDate: '0000-01-01'
   interval:
   intervalName:

tests/testthat/test-auto-report-functions.R

@@ -25,7 +25,8 @@ test_that("auto report config can be upgraded", {
 })
 
 test_that("already upgraded auto report config is left as is", {
-  c <- list(list(type = "subscription", ownerName = "Tore Tester"))
+  c <- list(list(type = "subscription", ownerName = "Tore Tester",
+                 startDate = "2021-11-19"))
   expect_equal(c, upgradeAutoReportData(c))
 })
 
@@ -106,7 +107,7 @@ test_that("A year-day sequence can be mande", {
   expect_true(is.numeric(rdoy))
 })
 
-test_that("The next run day in sequence can be identified", {
+test_that("The next run day in simple sequence can be identified", {
   expect_equal(as.numeric(
     findNextRunDate(
       runDayOfYear = c(10, 20, 30), baseDayNum = 11,
@@ -124,6 +125,44 @@ test_that("The next run day in sequence can be identified when next year", {
   ), 10)
 })
 
+test_that("for within year-break sequence, next is found among earlier days", {
+  expect_equal(as.numeric(
+    findNextRunDate(
+      runDayOfYear = c(200, 300, 1, 100), baseDayNum = 10,
+      returnFormat = "%j"
+    )
+  ), 100)
+})
+
+test_that("for within year-break sequence, next is found among later days", {
+  expect_equal(as.numeric(
+    findNextRunDate(
+      runDayOfYear = c(200, 300, 1, 100), baseDayNum = 110,
+      returnFormat = "%j"
+    )
+  ), 200)
+})
+
+test_that("a start date is enforced when given", {
+  todayNum <- as.POSIXlt(Sys.Date())$yday + 1
+  # sequence of 4 consecutive days from, but not including, today
+  days <-
+    as.POSIXlt(seq.Date(Sys.Date(), (Sys.Date() + 3), by = "day"))$yday + 2
+  expect_equal(as.numeric(
+    findNextRunDate(
+      runDayOfYear = days, baseDayNum = todayNum,
+      returnFormat = "%j"
+    )
+  ), days[1])
+  startDate <- Sys.Date() + 4
+  expect_equal(as.numeric(
+    findNextRunDate(
+      runDayOfYear = days, baseDayNum = todayNum, startDate = startDate,
+      returnFormat = "%j"
+    )
+  ), days[4])
+})
+
 shinySession <- list(user = "tester")
 shinySession$groups <- "rapbase"
 attr(shinySession, "class") <- "ShinySession"