## ----echo=FALSE--------------------------------------------------------------- knitr::opts_chunk$set(fig.width = 7, fig.height = 3) ## ----message=FALSE------------------------------------------------------------ library(forestplot) library(dplyr) ## ----fig.height=4, fig.width=8, message=FALSE--------------------------------- # Cochrane data from the 'rmeta'-package base_data <- tibble::tibble(mean = c(0.578, 0.165, 0.246, 0.700, 0.348, 0.139, 1.017), lower = c(0.372, 0.018, 0.072, 0.333, 0.083, 0.016, 0.365), upper = c(0.898, 1.517, 0.833, 1.474, 1.455, 1.209, 2.831), study = c("Auckland", "Block", "Doran", "Gamsu", "Morrison", "Papageorgiou", "Tauesch"), deaths_steroid = c("36", "1", "4", "14", "3", "1", "8"), deaths_placebo = c("60", "5", "11", "20", "7", "7", "10"), OR = c("0.58", "0.16", "0.25", "0.70", "0.35", "0.14", "1.02")) base_data |> forestplot(labeltext = c(study, deaths_steroid, deaths_placebo, OR), clip = c(0.1, 2.5), xlog = TRUE) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") |> fp_add_header(study = c("", "Study"), deaths_steroid = c("Deaths", "(steroid)"), deaths_placebo = c("Deaths", "(placebo)"), OR = c("", "OR")) |> fp_append_row(mean = 0.531, lower = 0.386, upper = 0.731, study = "Summary", OR = "0.53", is.summary = TRUE) |> fp_set_zebra_style("#EFEFEF") ## ----fig.height=4, fig.width=8, message=FALSE--------------------------------- base_data |> forestplot(labeltext = c(study, deaths_steroid, deaths_placebo, OR), clip = c(0.1, 2.5), xlog = TRUE) |> fp_add_lines() |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue", align = "lrrr", hrz_lines = "#999999") |> fp_add_header(study = c("", "Study"), deaths_steroid = c("Deaths", "(steroid)") |> fp_align_center(), deaths_placebo = c("Deaths", "(placebo)") |> fp_align_center(), OR = c("", fp_align_center("OR"))) |> fp_append_row(mean = 0.531, lower = 0.386, upper = 0.731, study = "Summary", OR = "0.53", is.summary = TRUE) ## ----fig.height=4, fig.width=8, message=FALSE--------------------------------- base_data |> forestplot(labeltext = c(study, deaths_steroid, deaths_placebo, OR), clip = c(0.1, 2.5), xlog = TRUE) |> fp_add_lines(h_3 = gpar(lty = 2), h_11 = gpar(lwd = 1, columns = 1:4, col = "#000044")) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue", align = "lrrr", hrz_lines = "#999999") |> fp_add_header(study = c("", "Study"), deaths_steroid = c("Deaths", "(steroid)") |> fp_align_center(), deaths_placebo = c("Deaths", "(placebo)") |> fp_align_center(), OR = c("", fp_align_center("OR"))) |> fp_append_row(mean = 0.531, lower = 0.386, upper = 0.731, study = "Summary", OR = "0.53", is.summary = TRUE) ## ----fig.height=4, fig.width=8, message=FALSE--------------------------------- base_data |> forestplot(labeltext = c(study, deaths_steroid, deaths_placebo, OR), clip = c(0.1, 2.5), vertices = TRUE, xlog = TRUE) |> fp_add_lines(h_3 = gpar(lty = 2), h_11 = gpar(lwd = 1, columns = 1:4, col = "#000044")) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue", align = "lrrr", hrz_lines = "#999999") |> fp_add_header(study = c("", "Study"), deaths_steroid = c("Deaths", "(steroid)") |> fp_align_center(), deaths_placebo = c("Deaths", "(placebo)") |> fp_align_center(), OR = c("", fp_align_center("OR"))) |> fp_append_row(mean = 0.531, lower = 0.386, upper = 0.731, study = "Summary", OR = "0.53", is.summary = TRUE) ## ----------------------------------------------------------------------------- base_data |> forestplot(labeltext = c(study, deaths_steroid, deaths_placebo, OR), clip = c(0.1, 2.5), vertices = TRUE, xlog = TRUE) |> fp_add_lines(h_3 = gpar(lty = 2), h_11 = gpar(lwd = 1, columns = 1:4, col = "#000044")) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue", hrz_lines = "#999999") |> fp_add_header(study = c("", "Study"), deaths_steroid = c("Deaths", "(steroid)"), deaths_placebo = c("Deaths", "(placebo)"), OR = c("", "OR")) |> fp_append_row(mean = 0.531, lower = 0.386, upper = 0.731, study = "Summary", OR = "0.53", is.summary = TRUE) |> fp_decorate_graph(box = gpar(lty = 2, col = "lightgray"), graph.pos = 4) |> fp_set_zebra_style("#f9f9f9") ## ----message=FALSE------------------------------------------------------------ data("inventors_vs_mello") inventors <- inventors_vs_mello |> mutate( cicol = paste(rep(" ", 20), collapse = ""), weights = ifelse(is.na(weights), "", sprintf("%0.1f%%", weights)) ) for (letter in letters[1:6]) { col_name <- paste0("rb.", letter) inventors[[col_name]] <- lapply(inventors[[col_name]], function(val) { if (is.na(val) || val == "") { col <- "white" } else { col <- switch(val, "+" = "green", "-" = "red", "?" = "gold", "black") } grid::textGrob("\u25CF", gp = gpar(col = col)) }) } fp_inventors <- inventors |> forestplot(mean = est, lower = lb, upper = ub, labeltext = author, txt_gp = fpTxtGp(summary = gpar(fontface = "bold", cex = 1)), graph.pos = 2, xlog = TRUE, clip = c(0.05, 100), graphwidth = grid::unit(0.3, "npc"), colgap = grid::unit(1.5, "mm")) |> fp_extract_labels( Study = author, E1 = ai, N1 = n1i, E2 = ci, N2 = n2i, Weight = weights, OR = orci, CI = cicol, A = rb.a, B = rb.b, C = rb.c, D = rb.d, E = rb.e, F = rb.f, na = "" ) |> fp_set_summary(startsWith(type, "subtotal") | startsWith(type, "total") | type %in% c("header")) summary_rows <- which(fp_inventors$is.summary) ## ----fig.width=10, fig.height=6, message=FALSE-------------------------------- fp_inventors |> fp_decorate_graph(graph.pos = 9) |> fp_align_where(align = "l", cols = "Study") |> fp_align_where(align = "r", cols = c("E1", "N1", "E2", "N2", "Weight", "OR")) |> fp_align_where(align = "c", cols = c("CI", LETTERS[1:6])) |> fp_txt_where(rows = summary_rows, cols = "Study", gp = gpar(col = "#222222")) |> fp_align_where(rows = summary_rows, cols = "Study", align = "l") |> fp_add_header( Study = "Study or Subgroup", E1 = "Events", N1 = "Total", E2 = "Events", N2 = "Total", Weight = "Weight", OR = "", CI = "", A = "A", B = "B", C = "C", D = "D", E = "E", F = "F" ) |> fp_add_header( fp_span("Caffeine", columns = c(2,3)) |> fp_align_center(), fp_span("Decaf", columns = c(4,5)) |> fp_align_center() ) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue", hrz_lines = "#999999") |> fp_set_zebra_style(c("#f9f9f9", "#ffffff")) ## ----message=FALSE------------------------------------------------------------ inventors |> rename(mean = est, lower = lb, upper = ub) |> group_by(group) |> fp_extract_labeltext(author, orci, na = "") |> head(4) ## ----fig.width=10, fig.height=6, message=FALSE-------------------------------- fp_inventors |> fp_decorate_graph(graph.pos = 9) |> fp_align_where(align = "l", cols = "Study") |> fp_align_where(align = "r", cols = c("E1", "N1", "E2", "N2", "Weight", "OR")) |> fp_align_where(align = "c", cols = c("CI", LETTERS[1:6])) |> fp_txt_where(rows = summary_rows, cols = "Study", gp = gpar(col = "#222222")) |> fp_align_where(rows = summary_rows, cols = "Study", align = "l") |> fp_add_header( Study = "Study or Subgroup", E1 = "Events", N1 = "Total", E2 = "Events", N2 = "Total", Weight = "Weight", OR = "", CI = "", A = "A", B = "B", C = "C", D = "D", E = "E", F = "F" ) |> fp_add_header( fp_span("Caffeine", columns = c(2,3)) |> fp_align_center(), fp_span("Decaf", columns = c(4,5)) |> fp_align_center(), E = "E" ) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") |> fp_set_zebra_style(c("#f9f9f9", "#ffffff")) ## ----------------------------------------------------------------------------- data(dfHRQoL) dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), xlab = "EQ-5D index") |> fp_add_header(est = expression(beta)) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") ## ----------------------------------------------------------------------------- # You can set directly the font to desired value, the next three lines are just for handling MacOs on CRAN font <- "mono" if (grepl("Ubuntu", Sys.info()["version"])) { font <- "HersheyGothicEnglish" } dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), xlab = "EQ-5D index") |> fp_add_header(est = "Est.") |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue", txt_gp = fpTxtGp(label = gpar(fontfamily = font))) ## ----------------------------------------------------------------------------- dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), xlab = "EQ-5D index") |> fp_add_header(est = "Est.") |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue", txt_gp = fpTxtGp(label = list(gpar(fontfamily = font), gpar(fontfamily = "", col = "#660000")), ticks = gpar(fontfamily = "", cex = 1), xlab = gpar(fontfamily = font, cex = 1.5))) ## ----------------------------------------------------------------------------- dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), clip = c(-.1, Inf), xlab = "EQ-5D index") |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") ## ----------------------------------------------------------------------------- dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), boxsize = 0.2, clip = c(-.1, Inf), xlab = "EQ-5D index") |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") ## ----fig.width=10, fig.height=4----------------------------------------------- fp_sweden <- dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), title = "Sweden", clip = c(-.1, Inf), xlab = "EQ-5D index", new_page = FALSE) fp_denmark <- dfHRQoL |> filter(group == "Denmark") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), title = "Denmark", clip = c(-.1, Inf), xlab = "EQ-5D index", new_page = FALSE) library(grid) grid.newpage() borderWidth <- unit(4, "pt") width <- unit(convertX(unit(1, "npc") - borderWidth, unitTo = "npc", valueOnly = TRUE)/2, "npc") pushViewport(viewport(layout = grid.layout(nrow = 1, ncol = 3, widths = unit.c(width, borderWidth, width)) ) ) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) fp_sweden |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") upViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) grid.rect(gp = gpar(fill = "#dddddd", col = "#eeeeee")) upViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) fp_denmark |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") upViewport(2) ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(clip = c(-.1, 0.075), ci.vertices = TRUE, ci.vertices.height = 0.05, boxsize = .1, lineheight = "lines", xlab = "EQ-5D index") |> fp_add_lines("steelblue") |> fp_add_header("Variable") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555")), default = gpar(vertices = TRUE)) ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555")), default = gpar(vertices = TRUE)) |> fp_set_zebra_style("#F5F9F9") ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), lty.ci = c(1, 2), xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555")), default = gpar(vertices = TRUE)) ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(legend = c("Swedes", "Danes"), fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555"))) ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(legend = c("Swedes", "Danes"), legend_args = fpLegend(pos = list(x = .85, y = 0.25), gp = gpar(col = "#CCCCCC", fill = "#F9F9F9")), fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555"))) ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), xticks = c(-.1, -0.05, 0, .05), xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555"))) ## ----------------------------------------------------------------------------- xticks <- seq(from = -.1, to = .05, by = 0.025) xtlab <- rep(c(TRUE, FALSE), length.out = length(xticks)) attr(xticks, "labels") <- xtlab dfHRQoL |> group_by(group) |> forestplot(fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), xticks = xticks, xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555"))) ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), xticks = c(-.1, -0.05, 0, .05), zero = 0, xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555"))) |> fp_decorate_graph(grid = structure(c(-.1, -.05, .05), gp = gpar(lty = 2, col = "#CCCCFF"))) ## ----------------------------------------------------------------------------- dfHRQoL |> group_by(group) |> forestplot(fn.ci_norm = c(fpDrawNormalCI, fpDrawCircleCI), boxsize = .25, # We set the box size to better visualize the type line.margin = .1, # We need to add this to avoid crowding clip = c(-.125, 0.075), xlab = "EQ-5D index") |> fp_set_style(box = c("blue", "darkred") |> lapply(function(x) gpar(fill = x, col = "#555555"))) |> fp_decorate_graph(grid = structure(c(-.1, -.05, .05), gp = gpar(lty = 2, col = "#CCCCFF"))) ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # grid_arg <- c(-.1, -.05, .05) # attr(grid_arg, "gp") <- gpar(lty = 2, col = "#CCCCFF") # # identical(grid_arg, # structure(c(-.1, -.05, .05), # gp = gpar(lty = 2, col = "#CCCCFF"))) # # Returns TRUE ## ----fig.width = 7, fig.height = 3-------------------------------------------- dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), clip = c(-.1, Inf), xlab = "EQ-5D index") |> fp_set_favors(low = "Favours worse", high = "Favours better", txt_gp = gpar(cex = 0.7)) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue") ## ----------------------------------------------------------------------------- dfHRQoL |> filter(group == "Sweden") |> mutate(est = sprintf("%.2f", mean), .after = labeltext) |> forestplot(labeltext = c(labeltext, est), clip = c(-.1, Inf), xlab = "EQ-5D index") |> fp_set_favors(low = "Favours worse", high = "Favours better", position = "inside", arrows = FALSE) |> fp_set_style(box = "royalblue", line = "darkblue", summary = "royalblue")