Trouble with tornado plot using ggplot2 package in R

90 views Asked by At

I am trying to make a Tornado plot with the following Rcode:

# tornado plot
library(forcats)
library(ggplot2)

# construct empty matrix
D<-matrix(data = NA,
          nrow = 10,
          ncol = 3)
rownames(D)<-     c("Sex_man","Sex_woman","Age_45","Age_90","p_N_Event_high","p_N_Event_low","p_E_Event_high","p_E_Event_low","discount","no_discount")
colnames(D)<-c("txe", "txn", "diff")

# fill in matrix with minimum and maximum value for both strategies
D[,1]<-c(16.370930,17.238380,19.32026,2.472129,17.23838,17.23838,14.81019,17.44902,16.56,20.86)
D[,2]<-  c(15.516060,16.354510,18.375550,2.294882,15.23853,16.44606,16.35451,16.35451,15.74,19.84)
D[,3]<-D[,1]-D[,2]
D

# parameters
sex_woman <- 0.883870 
sex_man <- 0.854870
age_high_90 <- 0.944710 # age not reflected in initial health state dis or RB/RT probability or state-transition probabilities
age_low_45 <- 0.177247
p_N_Event_high <- 2.880820
p_N_Event_low <- 0.671710
p_E_Event_high <- -3.248930
p_E_Event_low <- 1.350520
discount <- 0.820000
no_discount <- 1.020000

# combine all data
grp <- c("Patient sex", 
     "Patient age", 
     "Cycle-dependent probability of event after Clipping", 
     "Cycle-dependent probability of event after Coiling",
     "Discounting")
hi <- c(sex_woman,age_high_90,p_N_Event_high,p_E_Event_high,discount)
lo <- c(sex_man,age_low_45,p_N_Event_low,p_E_Event_low,no_discount)
diff <- abs(hi-lo)
benefit <- c("Coiling","Coiling","Coiling","Clipping","Coiling")

df.t <- data.frame(grp,lo,hi,diff,benefit)
df.t <- df.t[order(df.t$diff),] #ordered on effect size

# make plot
ggplot(data=df.t, aes(x=fct_inorder(grp), y=diff, ymin=lo, ymax=hi, fill=benefit)) + 
 geom_linerange(size = 8, colour=c("steelblue","steelblue","steelblue","steelblue","darkred")) +
 coord_flip() +
 theme_bw() +
 geom_hline(yintercept = 0, color = "black", linetype = "dashed") +
 theme(panel.grid=element_blank(),
    axis.title.x = element_text(size = 13),
    axis.text = element_text(size = 11, colour = "black")) +
 ylab("Benefit of Treatment (QALYs)") +
 xlab("")

Running this code should give you the attached plot.

QUESTION: I am trying to give the bars on the left side of the reference line one color and another on the right side but can't seems to get it right. I tried multiple things.

Can someone help me?

1

There are 1 answers

0
Peter On

This is one approach, create a dummy variable which controls the colour of the bars either side of the intercept line.


library(dplyr)

df1 <- 
  df.t |> 
  filter(hi < 0) |> 
  mutate(lo = 0,
         fill = "neg") |> 
  bind_rows(df.t) |> 
  mutate(hi = ifelse(lo > 0 & hi < 0, 0, hi),
         fill = ifelse(is.na(fill), "pos", fill)) |> 
  arrange(diff)

# make plot
ggplot(data=df1, aes(x=diff, xmin=lo, xmax=hi, y=fct_inorder(grp), colour=fill)) + 
  geom_linerange(linewidth = 8) +
  scale_colour_manual(values=c("steelblue","darkred")) +
  geom_hline(yintercept = 0, color = "black", linetype = "dashed") +
  theme_bw() +
  theme(panel.grid=element_blank(),
        axis.title.x = element_text(size = 13),
        axis.text = element_text(size = 11, colour = "black")) +
  labs(x = "Benefit of Treatment (QALYs)",
       y = NULL,
       colour = NULL)

Created on 2023-06-09 with reprex v2.0.2