Skip the weekend for formr (including tests and friday as weekend)

skip_weekday.R

skip_weekend <-
  function(datetime = lubridate::now(),
           day_over = lubridate::hm("18:40")) {
    stopifnot(lubridate::is.timepoint(datetime))
    date <- lubridate::date(datetime)
    time <- hms::as_hms(datetime)
    is.wday <- function(date, what) {
      lubridate::wday(date, label = TRUE) %in% what
    }
    if (is.wday(date, "Fri") & (time > day_over))
      return(date + 3)
    else if (is.wday(date, "Sat"))
      return(date + 2)
    else if (time > day_over)
      return(date + 1)
    else
      return(date)
  }

skip_weekend(lubridate::dmy_hm("04.02.2022 20:30"))
library(tidyverse)
library(lubridate)

cases <-
  tribble(
    ~test,              ~solution,    ~comment,
    "02.02.2022 08:12", "02.02.2022", "normal day",
    "03.02.2022 20:04", "04.02.2022", "normal evening",
    "03.02.2022 18:10", "03.02.2022", "late regular or starter",
    "03.02.2022 18:50", "04.02.2022", "starter",
    "03.02.2022 19:10", "04.02.2022", "early regular",
    "04.02.2022 00:30", "04.02.2022", "late regular",
    "04.02.2022 12:30", "04.02.2022", "friday",
    "04.02.2022 20:30", "07.02.2022", "fri evening is weekend",
    "05.02.2022 12:19", "07.02.2022", "sat",
    "05.02.2022 18:19", "07.02.2022", "sat evening",
    "05.02.2022 14:12", "07.02.2022", "sun",
    "05.02.2022 21:12", "07.02.2022", "sun"
  )
simplify_date <- function(x) {
  stopifnot(is.list(x), is.Date(x[[1]]))
  ymd(purrr::map_chr(x, as.character))
}

mutate(cases,
       test = dmy_hm(test),
       solution = dmy(solution),
       test_wday = wday(test, label = TRUE),
       guess = purrr::map(test, skip_weekend) %>% simplify_date(),
       correct = guess == solution)