## ----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")

