functions.R

#' Do linear interpolation of measurements generate daily values
#' @param data_frame The input data frame
#' @param date_col The name of the date column
#' @param measurement_cols The list of names of the measurement column(s)
#' @return The dataframe with daily measurements generated by linear interpolation
interpolate_measurements <- function(data_frame, date_col, measurement_cols) {
  data_frame <- as.data.frame(data_frame)
  data_frame$date_2 <- as.Date(data_frame[, date_col])
  daily_dates <- data.frame(
    date = seq.Date(
      min(data_frame$date_2),
      max(data_frame$date_2),
      by = "days"
    )
  )
  data_frame_interp <- data_frame %>%
    mutate(is_observation = T) %>%
    full_join(daily_dates, by = setNames(nm = date_col, "date")) %>%  # https://stackoverflow.com/questions/28399065/dplyr-join-on-by-a-b-where-a-and-b-are-variables-containing-strings
    arrange(!!sym(date_col)) %>%
    mutate(across(all_of(measurement_cols), ~ zoo::na.approx(.x, na.rm = F)))
  return(data_frame_interp)
}

#' Do cubic spline interpolation of measurements generate daily values
#' @param data_frame The input data frame
#' @param date_col The name of the date column
#' @param measurement_cols The list of names of the measurement column(s)
#' @return The dataframe with daily measurements generated by cubic spline interpolation
interpolate_measurements_cubic_spline <- function(data_frame, date_col, measurement_cols) {
  data_frame <- as.data.frame(data_frame)
  data_frame$date_2 <- as.Date(data_frame[, date_col])
  daily_dates <- data.frame(
    date = seq.Date(
      min(data_frame$date_2),
      max(data_frame$date_2),
      by = "days"
    )
  )
  data_frame_all_dates <- data_frame %>%
    mutate(is_observation = T) %>%
    full_join(daily_dates, by = setNames(nm = date_col, "date")) %>%  # https://stackoverflow.com/questions/28399065/dplyr-join-on-by-a-b-where-a-and-b-are-variables-containing-strings
    arrange(!!sym(date_col)) %>%
    mutate(x = 1:n())
  data_frame_all_dates_obs_only <- data_frame_all_dates %>% filter(is_observation)

  for (colname in measurement_cols) {
    interpolated_values <- pracma::cubicspline(
      x = data_frame_all_dates_obs_only$x,
      y = data_frame_all_dates_obs_only[[colname]],
      xi = data_frame_all_dates$x)
    data_frame_all_dates[[colname]] <- case_when(interpolated_values < 0 ~ 0, T ~ interpolated_values)
  }

  return(data_frame_all_dates %>% dplyr::select(-x))
}