The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

Husby’s Multi Faceted Forest Plot

library(EpiForsk)
library(stringr)
library(ggplot2)
library(dplyr)
#> 
#> Vedhæfter pakke: 'dplyr'
#> De følgende objekter er maskerede fra 'package:stats':
#> 
#>     filter, lag
#> De følgende objekter er maskerede fra 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)
library(cowplot)
library(grDevices)

Example 1: Plain text

If you are on a windows system you can set the fonts in the following way

windowsFonts(Calibri = windowsFont("TT Calibri"))
windowsFonts(Helvetica = windowsFont("TT Helvetica"))
windowsFonts(Arial = windowsFont("TT Arial"))
plot_data <- andh_forest_data %>%
  mutate(
    order = rev(row_number()) + 1,
    text = paste0(
      case_when(
        indent == 0 ~ "", 
        indent == 1 ~ "  ", 
        indent == 2 ~ "    ",
        TRUE ~ "      "
      ),
      text
      )
    ) %>%
  pivot_longer(
    cols = A_est:C_u, 
    names_to = c("headline", ".value"),
    names_sep = "_",
    values_to = "value")
plot_options <- data.frame(
  headline       = c(   "A",   "B",   "C"),
  color          = c("red2", "dodgerblue2", "springgreen2"),
  fill           = c("red4", "dodgerblue4", "springgreen4"),
  lower_vertical = c(  -0.2,  -0.4,  -0.2),
  mid_vertical   = c(     0,     0,     0),
  upper_vertical = c(   0.2,   0.1,   0.2),
  xlim_lower     = c(  -0.3,  -0.5,  -0.2),
  xlim_upper     = c(   0.3,   0.3,   0.2),
  headline_text  = c("Language",
                     "Mathematics",
                     "Intelligence"),
  xlab           = c("Difference in language z-score\ncompared with no exposure",
                     "Difference in mathematics z-score\ncompared with no exposure",
                     "Difference in IQ\ncompared with no exposure")
)
shared_theme <- theme(
  legend.position = "none",
  plot.title = element_text(
    face = "bold", 
    family = "Arial",
    size = 12, 
    hjust = 0.5, 
    vjust = 1
  ),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.grid.minor = element_blank(),
  axis.ticks.length = unit(0.20,"cm"),
  axis.title.x = element_text(
    margin = margin(15, 0, 0, 0), 
    size = 10, 
    face = "bold", 
    family = "Arial"
  ),
  axis.text.x = element_text(
    size = 12, 
    face = "plain", 
    family = "Arial", 
    margin = margin(5, 0, 0, 0)
  ),
  axis.line.x = element_line(size = 0.5),
  axis.title.y = element_blank(),
  axis.line.y = element_line(color = "white", size = 0.5),
  axis.ticks.y = element_blank()
)
#> Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
#> ℹ Please use the `linewidth` argument instead.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
plot_list <- lapply(plot_options$headline, function(x) {
  option <- plot_options %>% filter(headline == x)
  plot_data %>% 
    filter(headline == x) %>%
    slice(-1) %>%
    ggplot(aes(y = order)) + 
    geom_linerange(
      aes(xmin = l, xmax = u),
      color = option$color,
      alpha = 0.7,
      size = 1.2
    ) +
    geom_point(
      aes(x = est), 
      size = 2, 
      shape = 22, 
      color = "black",
      fill = option$fill
    ) +
    geom_vline(
      xintercept = option$lower_vertical, 
      linetype = 2,
      alpha = 0.5
    ) + 
    geom_vline(
      xintercept = option$mid_vertical, 
      linetype = 2
    ) + 
    geom_vline(
      xintercept = option$upper_vertical, 
      linetype = 2,
      alpha = 0.5
    ) +
    coord_cartesian(
      xlim = c(option$xlim_lower, option$xlim_upper), 
      ylim = c(0, 19), 
      expand = FALSE
      ) + 
    xlab(option$xlab) +
    ggtitle(option$headline_text) +
    annotate(
      "text", 
      label = "suggests benefit", 
      x = 0.025, 
      y = 1, 
      size = 2,
      color = "black", 
      fontface = "italic", 
      hjust = 0
    ) + 
    annotate(
      "text",
      label = "suggests harm", 
      x = -0.025, 
      y = 1, 
      size = 2,
      color = "black", 
      fontface = "italic",
      hjust = 1
    ) + 
    theme_bw() +
    shared_theme + 
    theme(
      plot.title = element_text(color = "black"),
      axis.title.x = element_text(color = "black"),
      axis.text.x = element_text(color = "black"),
      axis.line.x = element_line(color = "black"),
      axis.ticks.x = element_line(colour = "black"),
      axis.text.y = element_blank()
    )
})
#> Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
#> ℹ Please use `linewidth` instead.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
label_data <- plot_data %>%
  group_by(type, text, order) %>%
  slice(1) %>%
  ungroup() 
# %>% mutate(text = str_replace(text, "beta", "\u03b2"))
label_plot <- label_data %>%
  ggplot(aes(y = order)) + 
  geom_point(aes(x = est)) +
  xlab(plot_options$xlab[1]) +
  ggtitle(plot_options$headline_text[1]) +
  coord_cartesian(
    xlim = c(98,99), 
    ylim = c(0, 19),
    expand = FALSE
    ) + 
  scale_y_continuous(
    breaks = label_data$order, 
    labels = label_data$text
  ) +
  theme_bw() +
  shared_theme + 
  theme(
    plot.title = element_text(color = "white"),
    axis.title.x = element_text(color = "white"),
    axis.text.x = element_text(color = "white"),
    axis.line.x = element_line(color = "white"),
    axis.ticks.x = element_line(colour = "white"),
    axis.text.y = element_text(
      color = "black",
      hjust = 0,
      face = label_data$type
    )
  )
#> Warning: Vectorized input to `element_text()` is not officially supported.
#> ℹ Results may be unexpected or may change in future versions of ggplot2.
plot_grid(plotlist = c(list(label_plot), plot_list), 
          rel_widths = c(1.1, 1, 1, 1), 
          ncol = 4)

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.