https://github.com/morgankain/RRV_HostVectorCompetence
Raw File
Tip revision: be7e87c3c4c8af0420a8dd42cdcff5586fdbad90 authored by Morgan Kain on 25 May 2021, 16:23 UTC
Merge pull request #1 from morgankain/add-license-1
Tip revision: be7e87c
8_data.hm.R
#######
### Host-to-mosquito transmission
#######

max_dose_val <- 9.5

## First, drop Aedes multiplex because of tbe odd data and opposite predictions (Aedes multiplex isn't found in
 ## Brisbane anyway)
h_to_m_emp <- h_to_m_emp %>% filter(species != "ae_multiplex")

## Convert to proportion and sample size
h_to_m_emp <- h_to_m_emp %>% 
  mutate(prop.infected = perc.infected / 100) %>%
  mutate(num_inf = round(prop.infected * total.infect.exp))

## Fit a binomial model to the proportion infected of those bit
h_to_m_trans.mod  <- glmer(
    cbind(num_inf, total.infect.exp - num_inf) ~ infectious.dose 
  + (1 + infectious.dose | species) 
  , data    = h_to_m_emp
  , family  = "binomial")

## Empty data frame for predictions from the GLMM over infectious dose
h_to_m_trans.preddat <- expand.grid(
    infectious.dose = seq(0, max_dose_val, by = 0.2)
  , species         = unique(h_to_m_emp$species)
  )

## Estimates without uncertainty, just for the ggplot
h_to_m_trans.pred <- h_to_m_trans.preddat %>%
  mutate(prob = plogis(predict(h_to_m_trans.mod
  , newdata = h_to_m_trans.preddat
  , re.form = ~(1 + infectious.dose | species)))
    )

gg.emp.h_to_m <- ggplot(h_to_m_emp, aes(infectious.dose, perc.infected/100)) + 
  geom_point(aes(colour = species), lwd = 2.5) +
  geom_line(data = h_to_m_trans.pred, aes(infectious.dose, prob, colour = species)) +
  xlab("Titer") +
  ylab("Percentage infected")

## Check by genus
gg.emp.h_to_m.p <- ggplot(h_to_m_emp, aes(infectious.dose, perc.infected/100)) + 
  geom_point(aes(colour = species, shape = genus, size = total.infect.exp)) +
  geom_line(data = h_to_m_trans.pred, aes(infectious.dose, prob, colour = species)) +
  xlab("Titer") +
  ylab("Percentage infected") 

### The actual data needed for R0, with and without uncertainty
samp_inf <- h_to_m_emp

## Container for the predictions for the actual titers we care about (those seen in hosts)
h_to_m_trans.preddat <- expand.grid(
    infectious.dose =  c(host_titer)
  , species         =  unique(h_to_m_emp$species))

## Fill in without uncertainty 
h_to_m_trans.pred <- h_to_m_trans.preddat %>%
  mutate(prob = plogis(predict(h_to_m_trans.mod
  , newdata = h_to_m_trans.preddat
  , re.form = ~(1 + infectious.dose | species)))
    )

### Use the conditional modes and conditional covariances and bootstrap to get uncertainty on individual species responses 
rand_eff_est         <- getME(h_to_m_trans.mod, c("b"))@x#[(length(unique(h_to_m_emp$ref)) + 1):(length(unique(h_to_m_emp$ref)) + length(unique(h_to_m_emp$species))*2)]
cond_cov_mat         <- lme4:::condVar(h_to_m_trans.mod)
condvar_branch_array <- array(data = 0, dim = c(2, 2, length(unique(h_to_m_emp$species))))

for (i in 1:dim(condvar_branch_array)[3]) {
  ## Based on the structure of the model, extracting the intercept and slope and setting into the right structure
   ## This just counts 1,2 for i = 1, 3, 4 for i = 2 etc. 
  condvar_branch_array[,,i] <- as.matrix(cond_cov_mat[(i*2 - 1):(i*2), (i*2 - 1):(i*2)])
}

## Samples for each species
ran_ef_array <- array(dim = c(n_samps, 2, length(unique(h_to_m_emp$species))))

## Draws from the covar matrix
for (i in 1:dim(ran_ef_array)[3]) {
  ran_ef_array[,,i] <- mvrnorm(n_samps, rand_eff_est[(i*2 - 1):(i*2)], condvar_branch_array[,,i])
}

## Fixed effects
fix_eff_matrix <- mvrnorm(n_samps
  , mu    = getME(h_to_m_trans.mod, c("beta"))
  , Sigma = summary(h_to_m_trans.mod)[["vcov"]])

## estimates for each species
pred_vals <- expand.grid(
  infectious.dose = c(host_titer)
, species         = unique(h_to_m_emp$species)
, sim             = seq(1, n_samps, by = 1)
, prob            = 0
)
pred_vals$species <- as.character(pred_vals$species)

h_to_m_trans_all_samps <- array(
  dim = c(
    nrow(host_titer)
  , length(unique(tot_titer$host))
  , length(unique(h_to_m_emp$species))
  , n_samps
    )
  , data = 0)

dimnames(h_to_m_trans_all_samps) <- list(
  NULL
, unique(tot_titer$host)
, unique(h_to_m_emp$species)
, NULL
)

## Estimate host to mosquito transmission probability taking into consideration uncertainty in the host titer 
for (i in 1:length(unique(h_to_m_emp$species))) {
  for (j in 1:n_samps) {
    
## Here use  titer "samples" with a transmission "samples" to understand the joint uncertainty over titer and transmission | titer
 ## That is, what is the probability that any given mosquito picks up infection from any given host given the uncertainty we 
  ## have in that mosquitoes ability and hosts' titer
h_to_m_trans_all_samps[ , , i, j] <- plogis(
      ## intercept
    fix_eff_matrix[j, 1] + ran_ef_array[j,1,i] +
      ## slope over titer * titer, with uncertainty in titer
    (fix_eff_matrix[j, 2] + ran_ef_array[j,2,i]) * 
    host_titer_all_samps[, j, ]
    )
    
  }
  
}

## Also "brute force" calculate AUC for mosquito infection probability
mosq_inf_AUC_all_samps                <- matrix(nrow = length(unique(h_to_m_emp$species)), ncol = n_samps, data = 0)
dimnames(mosq_inf_AUC_all_samps)[[1]] <- unique(h_to_m_emp$species)

for (i in 1:length(unique(h_to_m_emp$species))) {
  for (j in 1:n_samps) {
    
temp_prob <- plogis(
      ## intercept
    fix_eff_matrix[j, 1] + ran_ef_array[j,1,i] +
      ## slope over titer * titer, with uncertainty in titer
    (fix_eff_matrix[j, 2] + ran_ef_array[j,2,i]) * 
      ## very fine scale titer for the AUC
    seq(1, max_dose_val, by = 0.001)
    )
    
mosq_inf_AUC_all_samps[i, j] <- sum(temp_prob) * 0.001
    
  }
  
}

## Finally, just need the probability that each mosquito obtains infection at some specific dose
mosq_inf_single_dose <- matrix(nrow = length(unique(h_to_m_emp$species)), ncol = n_samps, data = 0)
dimnames(mosq_inf_single_dose)[[1]] <- unique(h_to_m_emp$species)

for (i in 1:length(unique(h_to_m_emp$species))) {
  for (j in 1:n_samps) {
    
mosq_inf_single_dose[i, j] <- plogis(
      ## intercept
    fix_eff_matrix[j, 1] + ran_ef_array[j,1,i] +
      ## slope over titer * titer, with uncertainty in titer
    (fix_eff_matrix[j, 2] + ran_ef_array[j,2,i]) * 
      ## very fine scale titer for the AUC
    titer_dose # titer_dose
    )
    
  }
}

## And clean it up for use in mosquito to host competence (only place this is used is to weight the probability that 
 ## a mosquito would become infected for mosquito to host transmission)
mosq_inf_single_dose.gg <- melt(mosq_inf_single_dose)
names(mosq_inf_single_dose.gg) <- c("mosq", "samp", "prob")
mosq_names <- strsplit(as.character(mosq_inf_single_dose.gg$mosq), "_") %>% 
  sapply(., FUN = function(x) c(paste(x, collapse = " "))) %>% 
  sapply(., FUN = function(x) paste(toupper(substring(x, 1, 1)), substring(x, 2), sep = "", collapse = " "))
mosq_inf_single_dose.gg$mosq <- mosq_names

#################################################################
### Supplemental host to mosquito transmission plot
#####

## Estimated host to mosquito transmission probabilities

h_to_m_trans_all_samps.gg    <- array(
  dim = c(
    length(seq(0, max_dose_val, by = .1))
  , length(unique(h_to_m_emp$species))
  , n_samps
    )
  , data = 0)

dimnames(h_to_m_trans_all_samps.gg) <- list(
  seq(0, max_dose_val, by = .1)
, unique(h_to_m_emp$species))

## Estimate host to mosquito transmission probability taking into consideration uncertainty in the host titer 
for (i in 1:length(unique(h_to_m_emp$species))) {
  for (j in 1:n_samps) {
    
## Here use  titer "samples" with a transmission "samples" to understand the joint uncertainty over titer and transmission | titer
 ## That is, what is the probability that any given mosquito picks up infection from any given host given the uncertainty we 
  ## have in that mosquitoes ability and hosts' titer
h_to_m_trans_all_samps.gg[ , i, j] <- plogis(
      ## intercept
    fix_eff_matrix[j, 1] + ran_ef_array[j,1,i] +
      ## slope over titer * titer, with uncertainty in titer
    (fix_eff_matrix[j, 2] + ran_ef_array[j,2,i]) * 
    seq(0, max_dose_val, by = .1)
    )
    
  }
  
}

h_to_m_trans_all_samps.gg        <- melt(h_to_m_trans_all_samps.gg)
names(h_to_m_trans_all_samps.gg) <- c("titre", "species", "samp", "prob")

h_to_m_trans_all_samps.gg.s      <- h_to_m_trans_all_samps.gg %>%
  group_by(species, titre) %>% 
  summarize(
    lwr = quantile(prob, 0.100)
  , est = quantile(prob, 0.500)
  , upr = quantile(prob, 0.900)
  )

mosq_names <- strsplit(as.character(h_to_m_trans_all_samps.gg.s$species), "_") %>% 
  sapply(., FUN = function(x) c(paste(x, collapse = " "))) %>% 
  sapply(., FUN = function(x) paste(toupper(substring(x, 1, 1)), substring(x, 2), sep = "", collapse = " "))
h_to_m_trans_all_samps.gg.s$species <- mosq_names

h_to_m_emp.gg <- h_to_m_emp
mosq_names <- strsplit(as.character(h_to_m_emp.gg$species), "_") %>% 
  sapply(., FUN = function(x) c(paste(x, collapse = " "))) %>% 
  sapply(., FUN = function(x) paste(toupper(substring(x, 1, 1)), substring(x, 2), sep = "", collapse = " "))
h_to_m_emp.gg$species <- mosq_names

## Export at 18x12
ggplot(h_to_m_trans_all_samps.gg.s
  , aes(titre, est)) + 
  geom_line() +
  geom_ribbon(aes(x = titre, ymin = lwr, ymax = upr), alpha = 0.25) +
  geom_point(data = h_to_m_emp.gg, aes(infectious.dose, num_inf / total.infect.exp)) +
  facet_wrap(~species) +
  xlab(bquote('Infectious Dose -- Titer ('*log[10]*')')) +
  ylab("Infection Probability")

## Single panel for conceptual figure
mos.cf <- "Cq linealis"

ggplot(
  (h_to_m_trans_all_samps.gg.s %>% filter(species == mos.cf))
  , aes(titre, est)) + 
  geom_line() +
  geom_ribbon(aes(x = titre, ymin = lwr, ymax = upr), alpha = 0.25) +
  geom_point(data = (h_to_m_emp.gg %>% filter(species == mos.cf))
    , aes(infectious.dose, num_inf / total.infect.exp)) +
  xlab(bquote('Titer ('*log[10]*') (dose)' )) +
  ylab("Infection 
Probability")

## Calculated AUC for these same species
mosq_inf_AUC.gg        <- melt(mosq_inf_AUC_all_samps)
names(mosq_inf_AUC.gg) <- c("mosq", "samp", "AUC")
mosq_names             <- strsplit(as.character(mosq_inf_AUC.gg$mosq), "_") %>% 
  sapply(., FUN = function(x) c(paste(x, collapse = " "))) %>% 
  sapply(., FUN = function(x) paste(toupper(substring(x, 1, 1)), substring(x, 2), sep = "", collapse = " "))
mosq_inf_AUC.gg$mosq <- mosq_names
mosq_inf_AUC.gg.s    <- mosq_inf_AUC.gg %>% group_by(mosq) %>%
  summarize(
    lwr = quantile(AUC, 0.025)
  , est = quantile(AUC, 0.500)
  , upr = quantile(AUC, 0.975)
  )  

mosq_inf_AUC.gg.s <- mosq_inf_AUC.gg.s[order(mosq_inf_AUC.gg.s$est), ]
mosq_inf_AUC.gg.s$mosq <- factor(mosq_inf_AUC.gg.s$mosq, levels = mosq_inf_AUC.gg.s$mosq)

gg.mosq_inf.AUC <- ggplot(mosq_inf_AUC.gg.s, aes(est, mosq)) + 
  geom_point(lwd = 2) +
  geom_errorbarh(aes(xmin = lwr, xmax = upr, y = mosq), height = 0.5) +
  ylab("Mosquito") +
  xlab("Area Under Infection Probability Curve") +
  theme(
    axis.text.y = element_text(size = 16)
  , axis.title.x = element_text(size = 19)
  , axis.title.y = element_text(size = 19)
  )

## Reorder
prop_inf_gbite <- prop_inf[match(dimnames(h_to_m_trans_all_samps)[[2]], prop_inf$host), ]

## AUC for these titer curves
AUC_titer.gg        <- melt(host_titer_AUC_all_samps)
names(AUC_titer.gg) <- c("host", "sample", "AUC")
host_names          <- strsplit(as.character(AUC_titer.gg$host), "_") %>% 
  sapply(., FUN = function(x) c(paste(x, collapse = " "))) %>% 
  sapply(., FUN = function(x) paste(toupper(substring(x, 1, 1)), substring(x, 2), sep = "", collapse = " "))
AUC_titer.gg$Host <- host_names

## Change a few names for the supplemental plot
AUC_titer.gg <- AUC_titer.gg %>% mutate(
  Host = mapvalues(Host, from = "Grey h f fox", to = "Grey flying fox")
)

## Multiply the AUC by the proportion of the hosts displaying titer
prop_inf_gbite.gg <- prop_inf_gbite
host_names        <- strsplit(as.character(prop_inf_gbite.gg$host), "_") %>% 
  sapply(., FUN = function(x) c(paste(x, collapse = " "))) %>% 
  sapply(., FUN = function(x) paste(toupper(substring(x, 1, 1)), substring(x, 2), sep = "", collapse = " "))
prop_inf_gbite.gg$Host <- host_names
prop_inf_gbite.gg <- prop_inf_gbite.gg %>% mutate(
  Host = mapvalues(Host, from = "Grey h f fox", to = "Grey flying fox")
)

AUC_titer.gg <- AUC_titer.gg %>% left_join(., (prop_inf_gbite.gg %>% dplyr::select(Host, num_inf)))
AUC_titer.gg <- AUC_titer.gg %>% mutate(AUC_weighted = AUC * num_inf)

## Finally, summarize into CI
AUC_titer.gg.s.w <- AUC_titer.gg %>%
  group_by(Host) %>% 
  summarize(
    est = quantile(AUC_weighted, 0.50)
  , lwr = quantile(AUC_weighted, 0.025)
  , upr = quantile(AUC_weighted, 0.975)
  ) %>% mutate(AUC = "Yes")

AUC_titer.gg.s.w      <- AUC_titer.gg.s.w[order(AUC_titer.gg.s.w$est), ]
AUC_titer.gg.s.w$Host <- factor(AUC_titer.gg.s.w$Host, levels = AUC_titer.gg.s.w$Host)

AUC_titer.gg.s.uw <- AUC_titer.gg %>%
  group_by(Host) %>% 
  summarize(
    est = quantile(AUC, 0.50)
  , lwr = quantile(AUC, 0.025)
  , upr = quantile(AUC, 0.975)
  ) %>% mutate(AUC = "No")

AUC_titer.gg.s      <- rbind(AUC_titer.gg.s.w, AUC_titer.gg.s.uw)

AUC_titer.gg.s      <- AUC_titer.gg.s[order(AUC_titer.gg.s$est), ]
AUC_titer.gg.s$Host <- factor(AUC_titer.gg.s$Host, levels = AUC_titer.gg.s.w$Host)

## Export at 18x12
gg.titer.AUC <- ggplot(AUC_titer.gg.s, aes(est, Host)) + 
  geom_point(aes(colour = AUC), lwd = 2, position = position_dodge(width = 0.5)) +
  geom_errorbarh(aes(xmin = lwr, xmax = upr, y = Host, colour = AUC), height = 0.5, position=position_dodge(width=0.5)) +
  ylab("Host") +
  xlab(bquote('Titre Days -- '*log[10]*'(AUC of titer profile)')) +
  scale_color_brewer(palette = "Dark2", name = "Weighted by proportion
of exposed hosts that
develop detectable viremia?") +
  theme(
    axis.text.y = element_text(size = 16)
  , axis.title.x = element_text(size = 19)
  , axis.title.y = element_text(size = 19)
  , legend.key.size = unit(.65, "cm")
  , legend.title = element_text(size = 18)
  , legend.text = element_text(size = 16)
  , legend.position = c(0.80, 0.14)
  )
back to top