TSR-Proj / f-compute_beta_var.r
f-compute_beta_var.r
Raw
#############################################################################
# This script contains the function used to optimize the effects of weather,
# given a weather time series of temperature and relative humidity normalised 
# measurements in order to achieve a certain variability
#############################################################################
compute_beta_var <- function(param, df, objective_var) {
  
  e_Te <- param
  e_RH <- param
  
  # Seasonal transmission rate
  x <- e_Te * df$Te_norm + e_RH * df$RH_norm
  
  # Numerical stability
  Beta_seas <- exp(pmin(50, x))
  
  mean_beta <- mean(Beta_seas, na.rm = TRUE)
  if (!is.finite(mean_beta) || mean_beta <= 0) return(1e12)
  
  # Variability metric
  p_low  <- quantile(Beta_seas, 0.05, na.rm = TRUE)
  p_high <- quantile(Beta_seas, 0.95, na.rm = TRUE)
  
  beta_var <- 100 * ((p_high - p_low) / 2) / mean_beta
  
  # Smooth calibration objective
  (beta_var - objective_var)^2
}

compute_TWO_beta_vars <- function(param, df, objective_var) {

  e_current <- param[1]
  e_lag     <- param[2]

  df <- df[-1,]
  x <- e_current * df$Te_norm +
       e_current * df$RH_norm +
       e_lag     * df$Te_norm_Lag +
       e_lag     * df$RH_norm_Lag

  Beta_seas <- exp(pmin(50, x))

  mean_beta <- mean(Beta_seas, na.rm = TRUE)

  if (!is.finite(mean_beta) || mean_beta <= 0){
    return(1e12)}

  p_low  <- quantile(Beta_seas, 0.05, na.rm = TRUE)
  p_high <- quantile(Beta_seas, 0.95, na.rm = TRUE)

  beta_var <- 100 * ((p_high - p_low) / 2) / mean_beta

  (beta_var - objective_var)^2
}

TMP_compute_beta_var <- function(param, df, objective_var) {
  
  e_Te <- param[1]
  e_RH <- param[2]
  
  # Seasonal transmission rate
  x <- e_Te * df$Te_norm + e_RH * df$RH_norm
  
  # Numerical stability
  Beta_seas <- exp(pmin(50, x))
  
  mean_beta <- mean(Beta_seas, na.rm = TRUE)
  if (!is.finite(mean_beta) || mean_beta <= 0) return(1e12)
  
  # Variability metric
  p_low  <- quantile(Beta_seas, 0.05, na.rm = TRUE)
  p_high <- quantile(Beta_seas, 0.95, na.rm = TRUE)
  
  beta_var <- 100 * ((p_high - p_low) / 2) / mean_beta
  
  # Smooth calibration objective
  (beta_var - objective_var)^2
}