replace figure on "evidence for variation in individual reproductive number" by Lloyd-Smith et al., 2005

[avallecam]

In epiverse-trace/superspreading#93 was solved how to reproduce the figure in paper pasted in the episode checklist. This code is now in vignette https://epiverse-trace.github.io/superspreading/articles/proportion_transmission.html

Episode section to replace:

tutorials-middle/episodes/superspreading-estimate.Rmd

Lines 514 to 623 in 4aec74c

	)](fig/SEE-individual-reproductive-number-fig-c-d.png)
	```{r,message=FALSE,warning=FALSE,echo=FALSE,eval=FALSE}
	library(epiparameter)
	library(superspreading)
	library(tidyverse)
	# list of diseases with offspring distribution
	epidist_string <- epiparameter::epidist_db(
	epi_dist = "offspring distribution"
	) %>%
	epiparameter::parameter_tbl() %>%
	dplyr::select(disease) %>%
	dplyr::distinct() %>%
	dplyr::as_tibble()
	# get percent of cases that cause percent of transmission
	across_offspring <- epidist_string %>%
	# add column list of epidist objects
	mutate(
	epidist_out =
	map(
	.x = disease,
	.f = epiparameter::epidist_db,
	epi_dist = "offspring distribution",
	single_epidist = TRUE
	)
	) %>%
	# get parameters
	mutate(
	epidist_params =
	map(
	.x = epidist_out,
	.f = epiparameter::get_parameters
	)
	) %>%
	# unnest parameters
	unnest_wider(col = epidist_params) %>%
	# to each disease, add sequence from 0.01 to 1 (proportion of transmission)
	expand_grid(percent_transmission = seq(from = 0.01, to = 1, by = 0.01)) %>%
	# estimate proportion of cases responsible of proportion of transmission (row)
	mutate(
	transmission_output =
	pmap(
	.l = dplyr::select(., R = mean, k = dispersion, percent_transmission),
	.f = superspreading::proportion_transmission,
	format_prop = FALSE,
	simulate = TRUE # use a numerical simulation
	)
	) %>%
	# unnest proportion of cases results
	unnest_wider(col = transmission_output) %>%
	# move each result to one column
	rowwise() %>%
	mutate(
	percent_cases =
	sum(
	c_across(cols = starts_with("prop_")),
	na.rm = TRUE
	)
	) %>%
	dplyr::select(-starts_with("prop_")) %>%
	ungroup()
	# get a position to the ggplot text annotation
	across_offspring_tip <- across_offspring %>%
	group_by(disease) %>%
	filter(percent_transmission < 0.98, percent_transmission > 0.85) %>%
	slice_max(percent_transmission) %>%
	ungroup() %>%
	mutate(disease = case_when(
	str_detect(disease, stringr::fixed("Hantavirus")) ~ "Hantavirus",
	str_detect(disease, stringr::fixed("Ebola")) ~ "Ebola",
	TRUE ~ disease
	))
	# plot x: proportion of cases, y: proportion of transmission
	across_offspring %>%
	ggplot() +
	geom_line(
	aes(
	x = percent_cases,
	y = percent_transmission,
	color = dispersion,
	group = disease
	)
	) +
	geom_text(
	data = across_offspring_tip,
	aes(
	x = percent_cases,
	y = percent_transmission,
	label = disease
	),
	hjust = 0.0,
	vjust = 1.0,
	angle = 25,
	size = 3
	) +
	scale_y_continuous(breaks = scales::breaks_pretty(n = 5)) +
	colorspace::scale_color_continuous_diverging(trans = "log10", rev = TRUE) +
	labs(
	x = "Proportion of infectious cases (ranked)",
	y = "Expected proportion of transmission",
	color = "Dispersion\nparameter (k)"
	) +
	# geom_hline(aes(yintercept = 0.8),lty = 3) +
	geom_vline(aes(xintercept = 0.2), lty = 2) +
	coord_fixed(ratio = 1)
	```