Am i able to replicate this heat map in ggplot?

Question

Heat map displaying R0 and proportion of pre-symptomatic transmission

I am trying to replicate this figure in R using ggplot, however I am having limited success. I am unable to replicate shaded imagine with my plots being too blocky using geom_tile().

data <- data.frame(
  Disease = c("Influenza", "Smallpox", "SARS", "HIV"),
  R0_Min = c(1, 4, 1, 1),
  R0_Max = c(21, 10, 7, 5),
  Theta_Min = c(30, 5, 0, 80),
  Theta_Max = c(50, 20, 10, 100)
)

(Figure legend - Plausible ranges for the key parameters R0 and θ (see main text for sources) for four viral infections of public concern are shown as shaded regions. The size of the shaded area reflects the uncertainties in the parameter estimates. The areas are color-coded to match the assumed variance values for β(τ) and S(τ). https://www.pnas.org/doi/10.1073/pnas.0307506101#sec-1)

I have tried geom_rect() however it is too blocky. I then attempted to use geom_tile() (below), however the plot is less like the desired appearance.

# Expand the data
expanded_data <- data %>%
  mutate(Theta_seq = map2(Theta_Min, Theta_Max, seq, length.out = 100),
         R0_seq = map2(R0_Min, R0_Max, seq, length.out = 100)) %>%
  unnest(c(Theta_seq, R0_seq)) %>%
  rename(Theta = Theta_seq, R0 = R0_seq)

# Plotting using geom_tile
ggplot(expanded_data, aes(x = Theta, y = R0, fill = Disease)) +
  geom_tile(width = 1, height = 1) +
  scale_fill_manual(values = c("Influenza" = "red", "Smallpox" = "blue", "SARS" = "green", "HIV" = "purple")) +
  labs(title = "Heat Map of R0 vs. Theta",
       x = "Theta (%)",
       y = "Basic Reproduction Number (R0)") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

  geom_tile(width = 1, height = 1) 

Answer 1

This looks to me like they generated a point cloud with a bajillion points for each disease.

Here's an approximation using a uniform distribution plus some normal distribution noise, but it looks like they used many more points, perhaps employing a different method to help with that. The output will vary depending on the output resolution and the graphic device. I expect ragg and/or cairo could help with cleaner alpha rendering.

Here, I add a step to calculate the approx area of each cloud, so that each one gets filled in with a similar density.

library(tidyverse)
data |>
  mutate(area_scaling = (R0_Max - R0_Min) * (Theta_Max - Theta_Min)) |>
  uncount(500 * area_scaling) |> # adjust points per cloud here

  rowwise() |> # hack to make rnorm respect each Disease's x/y distribution
  # adjust last term of the 'rnorm' terms to adjust fuzziness in each direction
  mutate(R0 = runif(1, R0_Min, R0_Max) + rnorm(1, 0, 2),
         Theta = runif(1, Theta_Min, Theta_Max) + rnorm(1, 0, 4)) |>
  ungroup() |>

  ggplot(aes(color = Disease)) +
  geom_point(aes(Theta, R0), alpha = 0.05, size = 0.01) +
  theme_minimal()