inst/doc/key-features.R

In SPARSEMODr: SPAtial Resolution-SEnsitive Models of Outbreak Dynamics

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ---- message=FALSE, warning=FALSE--------------------------------------------
library(tidyverse)
library(viridis)
library(lubridate)

## ---- fig.width=5-------------------------------------------------------------
# Set up the dates of change. 5 time windows
n_windows = 5
# Window intervals
start_dates = c(mdy("1-1-20"),  mdy("2-1-20"),  mdy("2-16-20"), mdy("3-11-20"),  mdy("3-22-20"))
end_dates =   c(mdy("1-31-20"), mdy("2-15-20"), mdy("3-10-20"), mdy("3-21-20"), mdy("5-1-20"))

# Date sequence
date_seq = seq.Date(start_dates[1], end_dates[n_windows], by = "1 day")

# Time-varying beta
changing_beta = c(0.3,            0.1,            0.1,            0.15,            0.15)

#beta sequence
beta_seq = NULL

beta_seq[1:(yday(end_dates[1]) - yday(start_dates[1]) + 1)] =
  changing_beta[1]

for(i in 2:n_windows){

  beta_temp_seq = NULL
  beta_temp = NULL

  if(changing_beta[i] != changing_beta[i-1]){

    beta_diff = changing_beta[i-1] - changing_beta[i]
    n_days = yday(end_dates[i]) - yday(start_dates[i]) + 1
    beta_slope = - beta_diff / n_days

    for(j in 1:n_days){
      beta_temp_seq[j] = changing_beta[i-1] + beta_slope*j
    }

  }else{
    n_days = yday(end_dates[i]) - yday(start_dates[i]) + 1
    beta_temp_seq = rep(changing_beta[i], times = n_days)
  }

  beta_seq = c(beta_seq, beta_temp_seq)

}

beta_seq_df = data.frame(beta_seq, date_seq)
date_breaks = seq(range(date_seq)[1],
                  range(date_seq)[2],
                  by = "1 month")


ggplot(beta_seq_df) +
  geom_path(aes(x = date_seq, y = beta_seq)) +
  scale_x_date(breaks = date_breaks, date_labels = "%b") +
  labs(x="", y=expression("Time-varying "*beta*", ("*beta[t]*")")) +
  # THEME
  theme_classic()+
  theme(
    axis.text = element_text(size = 10, color = "black"),
    axis.title = element_text(size = 12, color = "black"),
    axis.text.x = element_text(angle = 45, vjust = 0.5)
  )



## ---- fig.width=5, echo=FALSE-------------------------------------------------

# Distance between populations:
dist_temp = seq(0, 300, length.out = 200)
dist_phi = c(50, 100, 200)

p_move_func = function(dist_phi, distance){
  1 / (exp( distance / dist_phi ))
}

p_move_mat = sapply(dist_phi,
                    p_move_func, distance = dist_temp)
p_move_df =
  data.frame(dist_ij = dist_temp, p_move_mat) %>%
  pivot_longer(X1:X3, values_to = "p_ij", names_to = "dp_val") %>%
  mutate(dp_val = case_when(
    dp_val == "X1" ~ "50",
    dp_val == "X2" ~ "100",
    dp_val == "X3" ~ "200"
  ))

ggplot(p_move_df) +
  geom_path(aes(x = dist_ij, y = p_ij,
                color = dp_val, group = dp_val)) +
  labs(x = "Distance between pops (km)",
       y = "Probability of migration") +
  scale_color_viridis_d(name = expression(phi),
                        breaks = c("50", "100", "200"),
                        direction = -1) +
  theme_classic() +
  theme(
    axis.title = element_text(color = "black", size = 12),
    axis.text = element_text(color = "black", size = 11),
    legend.position = c(0.7,0.7)
  )




## ---- fig.width=5, echo=FALSE-------------------------------------------------

# Distance between populations:
# Units hosts / km2
dens_temp = seq(0, 3000, length.out = 200)
monod_k = c(100, 500, 1000)
beta_max = 2.0

beta_dd_func = function(monod_k, dens_temp, beta_max){
  beta_max * dens_temp / (monod_k + dens_temp)
}

beta_dd_mat = sapply(monod_k,
                    beta_dd_func, dens_temp, beta_max)
beta_dd_df =
  data.frame(dens = dens_temp, beta_dd_mat) %>%
  pivot_longer(X1:X3, values_to = "beta_realz", names_to = "monod_K") %>%
  mutate(monod_K = case_when(
    monod_K == "X1" ~ "100",
    monod_K == "X2" ~ "500",
    monod_K == "X3" ~ "1000"
  ))

ggplot(beta_dd_df) +
  geom_path(aes(x = dens, y = beta_realz,
                color = monod_K, group = monod_K)) +
  labs(x = expression("Host density ("~km^-2~")"),
       y = expression("Transmission,"~beta["realized"])) +
  scale_color_viridis_d(name = "Monod_K",
                        breaks = c("100", "500", "1000"),
                        direction = -1) +
  theme_classic() +
  theme(
    axis.title = element_text(color = "black", size = 12),
    axis.text = element_text(color = "black", size = 11),
    legend.position = c(0.7,0.3)
  )