R/get_milepost.R

In YuanchenZhu2020/DemoPreTurningPointsCOVID19: Demo of Tracking and Forecasting Milepost Moments of COVID-19

#' Get Milepost
#'
#' Get 4 milepost moments T.1, T.2, Z.1 and Z.2
#'
#' @param pre_data dataframe with 4 predicted indicators:
#' - date: the exact day in the formate "%y-%m-%d" as a character
#' - infection_rate.pre: prediction result of infection rate
#' - removed_rate.pre: prediction result of removed_rate
#' - active_cases.pre: prediction result of active_cases
#' - confirmed.pre: prediction result of confirmed cases
#' All of these data is calculated from the Beginning_Time.
#' And it is always generated by function prediction().
#' @param Beginning_Time the selection of beginning time,
#' which must be in the formate "%y-%m-%d" as a character.
#'
#' @return dataframe contains 4 milepost T.1, T.2, Z.1, Z.2,
#' which must be in the formate "%y-%m-%d" as a character.
#' @export
#'
#' @examples Beginning_Time <- "2020-01-29"
#' M <- 5
#' indicators <- get_indicators(DemoPreTurningPointsCOVID19::COVID19_CN)
#' velocity <- calc_velocity(indicators, M, Beginning_Time)
#' pre_data <- get_future_indicators(indicators, velocity, Beginning_Time)
#' mileposts <- get_milepost(pre_data, Beginning_Time)
get_milepost <- function(pre_data, Beginning_Time) {
  # we can get the second turing point T.2 directly from pre_data
  # If T.2 have already gone, then T.2 = NA
  max_active_cases_pre_ind <- which.max(pre_data$active_cases.pre)
  if (max_active_cases_pre_ind > 1) {
    T.2 <- as.Date(Beginning_Time) + max_active_cases_pre_ind - 1
  }else {
    T.2 <- NA
  }

  t <- 1

  # to find the first turning point T.1
  if (!is.na(T.2)) {
    while (t < max_active_cases_pre_ind
           & pre_data$confirmed.pre[t] <= pre_data$confirmed.pre[t + 1]) {
      t <- t + 1
    }
  }
  # if T.2 does not exist or beginning_time \in (T.1, T.2),
  # then T.1 does not exist.
  if (is.na(T.2) | t == max_active_cases_pre_ind) {
    T.1 <- NA
  }
  else {
    T.1 <- as.Date(Beginning_Time) + t - 1
  }

  # to find the first zero point Z.1.
  while (pre_data$confirmed.pre[t] > 1) {
    t <- t + 1
  }
  Z.1 <- as.Date(Beginning_Time) + t - 1

  # to find the second zero point Z.2.
  while (pre_data$active_cases.pre[t] > 1 ) {
    t <- t + 1
  }
  Z.2 <- as.Date(Beginning_Time) + t - 1

  # return a dataframe with 4 milepost moments
  milepost <- data.frame("T.1" = T.1,
                         "T.2" = T.2,
                         "Z.1" = Z.1,
                         "Z.2" = Z.2)

  return(milepost)
}