Forestplot in R. How to add arrows, x axis breaks and extend the x axis?

Question

I have created a forestplot using the forestplot package and code below.

There are three things I would like to add:

1. Add arrows and text under the x axis (ie. an arrow in either direction explain the association).

I have reviewed these posts using a different package.

How to add arrows to forest plot in survminer (ggforest)

How to add arrows to a forest plot?

2. I would also like to put a break the x axis as I have one variable with a very wide CI.

3. I would also like to extend the negative side of the x-axis to -5, to balance the figure (even though most datapoints are on the right).

I am using the forest plot package. Any ideas how to do it with this package?

table2OR_ex <- structure(list(X = c("Aeroplanes", "Sex (F)", "1", "2", "Cars", "Sex (F)", "1", "2"), 
                 mean = c(NA, 1.35, 7.81, 6.14, NA, 1.17, 0.15, 0.4), 
                 lower = c(NA, 1.13, 5.69, 4.36, NA, 0.74, 0.05, 0.16), 
                 upper = c(NA, 1.61, 11.01, 8.83, NA, 1.88, 0.35, 0.89),
                 p.value = c("", "< 0.001", "< 0.001", "< 0.001", "", "0.509", "< 0.001", "0.034")), 

                 .Names = c("Transport", "mean", "lower", "upper", "p value"), 
                 class = "data.frame", row.names = c(NA, -8L))

tabletext <- cbind(c("Transport","\n",table2OR_ex$Transport), 
               c("Odds ratio","\n",table2OR_ex$mean),
               c("Confidence Interval","\n", 
                 ifelse(is.na(table2OR_ex$lower), "", paste(table2OR_ex$lower, table2OR_ex$upper, 
sep= " - "))))
mat <- rbind(rbind(rep(NA, 3), rbind(rep(NA, 3), as.matrix(table2OR_ex[, 2:4]))))


fn <- local({
i = 0
no_lines <- sum(!is.na(mat[,"mean"])) 
b_clrs = colorRampPalette(colors=c("pink", "blue"))(no_lines)
l_clrs = colorRampPalette(colors=c("blue", "pink"))(no_lines) 
function(..., clr.line, clr.marker){
    i <<- i + 1
    fpDrawDiamondCI(..., clr.line = l_clrs[i], clr.marker = b_clrs[i])
}
})

forestplot(labeltext=tabletext, 
       mat,
       graphwidth=unit (70, "mm"), 
       graph.pos=3, 
       fn.ci_norm = fn,
       clip =c(-.125, max(table2OR_ex$upper, na.rm = TRUE)),
       is.summary=c(TRUE, TRUE, rep(FALSE, 8)),
       txt_gp=fpTxtGp(label=gpar(fontsize=12, cex=1), 
                      ticks=gpar(fontsize=12, cex=1.4),
                      xlab=gpar(fontsize=12,cex = 1),
                      title=gpar(fontsize=12,cex = 1.2)),

       zero=1,
       boxsize=0.4)

Answer 1

This doesn't have everything you wanted, but it's a start. Maybe someone else can improve on this answer.

1. I've added labels to the left and the right of the null value using grid.text, but it doesn't have arrows. You may need to adjust the grid.text y values so that the labels don't overlap with the x-axis ticks.
2. I don't know how to put a break in the x-axis, but odds ratios should be plotted on a log scale (see https://doi.org/10.1002/sim.4780070807), and I think that solves the problem.
3. It doesn't make sense to have a negative value on the x-axis when you're plotting ORs, but with a log scale you can make the x-axis symmetric by setting the lower bound to the reciprocal of the upper bound, which is what I've done.

library(forestplot)

table2OR_ex <- structure(list(X = c("Aeroplanes", "Sex (F)", "1", "2", "Cars", "Sex (F)", "1", "2"), 
                 mean = c(NA, 1.35, 7.81, 6.14, NA, 1.17, 0.15, 0.4), 
                 lower = c(NA, 1.13, 5.69, 4.36, NA, 0.74, 0.05, 0.16), 
                 upper = c(NA, 1.61, 11.01, 8.83, NA, 1.88, 0.35, 0.89),
                 p.value = c("", "< 0.001", "< 0.001", "< 0.001", "", "0.509", "< 0.001", "0.034")), 

                 .Names = c("Transport", "mean", "lower", "upper", "p value"), 
                 class = "data.frame", row.names = c(NA, -8L))

tabletext <- cbind(c("Transport","\n",table2OR_ex$Transport), 
               c("Odds ratio","\n",table2OR_ex$mean),
               c("Confidence Interval","\n", 
                 ifelse(is.na(table2OR_ex$lower), "", paste(table2OR_ex$lower, table2OR_ex$upper, 
sep= " - "))))
mat <- rbind(rbind(rep(NA, 3), rbind(rep(NA, 3), as.matrix(table2OR_ex[, 2:4]))))


fn <- local({
i = 0
no_lines <- sum(!is.na(mat[,"mean"])) 
b_clrs = colorRampPalette(colors=c("pink", "blue"))(no_lines)
l_clrs = colorRampPalette(colors=c("blue", "pink"))(no_lines) 
function(..., clr.line, clr.marker){
    i <<- i + 1
    fpDrawDiamondCI(..., clr.line = l_clrs[i], clr.marker = b_clrs[i])
}
})

ticks <- c(0.04, 0.2, 1, 5, 25) # ADDITION
attr(ticks, "labels") <- as.character(ticks) # ADDITION
#attr(ticks, "labels") <- c("1/25", "1/5", "1", "5", "25") # ADDITION

forestplot(labeltext=tabletext, 
       mat,
       graphwidth=unit (70, "mm"), 
       graph.pos=3, 
       fn.ci_norm = fn,
       mar = unit(rep(10, times = 4), "mm"), # ADDITION
       xlog=TRUE, # ADDITION
       xticks=ticks, # ADDITION
       clip =c(0.04, 25), # CHANGE
       is.summary=c(TRUE, TRUE, rep(FALSE, 8)),
       txt_gp=fpTxtGp(label=gpar(fontsize=12, cex=1), 
                      ticks=gpar(fontsize=12, cex=1.4),
                      xlab=gpar(fontsize=12,cex = 1),
                      title=gpar(fontsize=12,cex = 1.2)),

       zero=1,
       boxsize=0.4)

# ADDITION
downViewport("forestplot_margins")
downViewport("axis_margin")
downViewport("axis")
grid.text("Favors X", x=0.46, y=-0.25, just=c("right", "center"))
grid.text("Favors Y", x=0.54, y=-0.25, just=c("left", "center"))