Skip to content

Commit

Permalink
fjerner avhengighet til rundayofyear for visning av neste utsending (#…
Browse files Browse the repository at this point in the history 
…205)

Lukker #203

Også mulig å filtrere på register i runAutoReport.

---------

Co-authored-by: Arnfinn Hykkerud Steindal <arnfinn.hykkerud.steindal@helse-nord.no>
  • Loading branch information
@kevinthon @arnfinn
kevinthon and arnfinn authored Jan 15, 2025
1 parent 804cc84 commit 2e27bf2
Show file tree
Hide file tree
Showing 4 changed files with 208 additions and 47 deletions.
141 changes: 95 additions & 46 deletions R/autoReport.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -514,6 +514,7 @@ getRegs <- function(config) {
#' sent. Default is FALSE
#' @param dato Date-class date when report will be run first time. Default value
#' is set to \code{Sys.Date()}
#' @inheritParams makeAutoReportTab
#'
#' @return Emails with corresponding file attachment. If dryRun == TRUE just a
#' message
Expand All @@ -528,12 +529,27 @@ getRegs <- function(config) {

runAutoReport <- function(dayNumber = as.POSIXlt(Sys.Date())$yday + 1,
dato = Sys.Date(),
group = NULL,
type = c("subscription", "dispatchment"),
target = "file", dryRun = FALSE) {

# get report candidates
reps <- readAutoReportData(target = target) %>%
filterAutoRep(by = "type", pass = type, target = target)
if (!is.null(group)) {
reps <- reps %>%
filterAutoRep(by = "package", pass = group, target = target)
}
if (target == "db") {
reps <- reps %>%
# nolint start: object_usage_linter
dplyr::summarise(
email = list(unique(email)),
.by = c(owner, ownerName, package, organization, type, fun,
params, startDate, terminateDate, interval)
)
# nolint end
}

# standard text for email body
stdTxt <- readr::read_file(
Expand All @@ -549,7 +565,8 @@ runAutoReport <- function(dayNumber = as.POSIXlt(Sys.Date())$yday + 1,
tryCatch(
{
if (target == "db") {
rep <- reps[i, ]
rep <- reps[i, ] %>% as.list()
rep$email <- unlist(rep$email)
params <- jsonlite::fromJSON(rep$params)
} else {
rep <- reps[[i]]
Expand Down Expand Up @@ -678,6 +695,7 @@ makeRunDayOfYearSequence <- function(startDay = Sys.Date(), interval) {
#' \code{\link[base]{strptime}} in the current locale. Defaults to
#' "\%A \%d. \%B \%Y" that will provide something like
#' 'Mandag 20. januar 2019' in a Norwegian locale
#' @inheritParams createAutoReport
#' @return String date for printing
#' @examples
#' # Will return Jan 30 in the current year and locale with default formatting
Expand All @@ -687,55 +705,86 @@ 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 (!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
terminateDate = NULL,
interval = NULL,
returnFormat = "%A %e. %B %Y",
target = "file") {

if (target == "db") {
if (Sys.Date() < startDate) {
nextDate <- as.Date(startDate)
}
if (Sys.Date() >= startDate && Sys.Date() <= terminateDate) {
dateseq <- timeplyr::time_seq(
as.Date(startDate),
as.Date(terminateDate),
time_by = interval
)
tidsdiff <- difftime(dateseq, Sys.Date(), units = "days")
tidsdiff[tidsdiff <= 0] <- NA
if (length(tidsdiff) == sum(is.na(tidsdiff))) {
nextDate <- as.Date(terminateDate) + 1
} else {
nextDate <- dateseq[which(tidsdiff == min(tidsdiff, na.rm = TRUE))]
}
}
if (Sys.Date() > terminateDate) {
nextDate <- as.Date(terminateDate) + 1
}
}

# 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)
return(format(nextDate, format = returnFormat))
} else {
# 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

year <- as.POSIXlt(Sys.Date())$year + 1900

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 start 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)
} else {
runDayOfYearSubset <- runDayOfYear
# 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])
}

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
}

# 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)
}

format(strptime(paste(year, nextDayNum), "%Y %j"), format = returnFormat)
}

# nolint start
Expand Down Expand Up @@ -828,13 +877,13 @@ makeAutoReportTab <- function(session,

l <- list()
for (i in seq_len(nrow(autoRep))) {
runDayOfYear <- as.vector(
as.integer(strsplit(autoRep[i, ]$runDayOfYear, ",")[[1]])
)
nextDate <- findNextRunDate(
runDayOfYear = runDayOfYear,
runDayOfYear = NULL,
startDate = autoRep[i, ]$startDate,
returnFormat = dateFormat
terminateDate = autoRep[i, ]$terminateDate,
interval = autoRep[i, ]$interval,
returnFormat = dateFormat,
target = target
)
if (as.Date(nextDate, format = dateFormat) > autoRep[i, ]$terminateDate) {
nextDate <- "Utl\u00F8pt"
Expand Down
15 changes: 14 additions & 1 deletion man/findNextRunDate.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 7 additions & 0 deletions man/runAutoReport.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

92 changes: 92 additions & 0 deletions tests/testthat/test-auto-report-functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -132,6 +132,98 @@ test_that("a start date is enforced when given", {
), days[4])
})

######################################
# Test findNextRunDate with db-setup #
######################################

test_that("The next run day is a monday", {
expect_equal(
findNextRunDate(
startDate = "2025-01-06", # Monday
terminateDate = Sys.Date() + 365,
interval = "weeks",
returnFormat = "%A",
target = "db"
)
, "Monday")
})

test_that("The next run day is day 6 of month ", {
expect_equal(
findNextRunDate(
startDate = "2025-01-06",
terminateDate = Sys.Date() + 365,
interval = "months",
returnFormat = "%d",
target = "db"
)
, "06")
})

test_that("Terminate date is before today, and will return terminateDate + 1", {
expect_equal(
findNextRunDate(
startDate = "2023-01-06",
terminateDate = Sys.Date() - 10,
interval = "months",
target = "db"
), format(Sys.Date() - 9, format = "%A %e. %B %Y"))

expect_equal(findNextRunDate(
startDate = "2025-01-06",
terminateDate = "2025-01-06",
target = "db"
), "Tuesday 7. January 2025")
})

test_that("Terminate date is after today but before next in range, and will return terminateDate + 1", {
expect_equal(
findNextRunDate(
startDate = seq(as.Date(Sys.Date()), length = 2, by = "-24 months")[2], # 24 months back in time
terminateDate = Sys.Date() + 14,
interval = "months",
target = "db"
), format(Sys.Date() + 15, format = "%A %e. %B %Y"))
})


test_that("Start date is after today, and will return start date", {
expect_equal(
findNextRunDate(
startDate = Sys.Date() + 10,
terminateDate = Sys.Date() + 20,
interval = "months",
target = "db"
), format(Sys.Date() + 10, format = "%A %e. %B %Y"))
})

test_that("findNextRunDate throw errors", {
expect_error(findNextRunDate())
expect_error(findNextRunDate(target = "db"))
expect_error(findNextRunDate(startDate = "2025-01-06", target = "db"))
expect_error(findNextRunDate(terminateDate = "2025-01-06", target = "db"))
# Wrong date format
expect_error(findNextRunDate(
startDate = "202501-06",
terminateDate = "2025-01-06",
interval = "days",
target = "db"
))
expect_error(findNextRunDate(
startDate = "2025-01-06",
terminateDate = "243467853443-212",
interval = "days",
target = "db"
))
# missing interval
expect_error(findNextRunDate(
startDate = "2025-01-06",
terminateDate = Sys.Date() + 10,
target = "db"
))
})


shinySession <- list(user = "tester")
shinySession$groups <- "rapbase"
attr(shinySession, "class") <- "ShinySession"
Expand Down

0 comments on commit 2e27bf2

Please sign in to comment.