├── .gitignore ├── README.md ├── create_figure.R ├── figure_build.Rproj ├── figure_data.xlsx └── final_plot.png /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Forest_plot_with_table 2 | 3 | ![](final_plot.png) 4 | -------------------------------------------------------------------------------- /create_figure.R: -------------------------------------------------------------------------------- 1 | # packages needed 2 | 3 | library(gridExtra) 4 | library(tidyverse) 5 | library(patchwork) 6 | 7 | # this table uses Fira Sans font - this will need to be installed 8 | # https://fonts.google.com/specimen/Fira+Sans 9 | 10 | library(extrafont) 11 | loadfonts(device = "win") 12 | 13 | windowsFonts("Fira Sans" = windowsFont("Fira Sans")) 14 | 15 | ################ read data scraped from original table ######################### 16 | 17 | data <- readxl::read_excel(here::here("figure_data.xlsx")) 18 | 19 | ######## format a copy of the data as character for the tables ################# 20 | 21 | # format the numbers with either no decimals (left) or one decimal (right) 22 | tdata <- data %>% mutate_at(4:6, ~sprintf(., fmt = '%#.1f')) %>% 23 | mutate_at(2:3, as.character) 24 | 25 | # hide NA values using a space 26 | tdata[is.na(tdata)] <- " " 27 | 28 | # pretty formatting for confidence intervals to match the table 29 | tdata$`Estimate (95% CI)` <- ifelse(tdata$Placebo == " ", " ", 30 | paste0(tdata$Estimate, 31 | " (", tdata$`CI low`, 32 | " to ", tdata$`CI high`, ")")) 33 | 34 | # indent the subgroup if there is a number in the placebo column 35 | tdata$Subgroup <- ifelse(tdata$Placebo == " ", 36 | tdata$Subgroup, 37 | paste0(" ", tdata$Subgroup)) 38 | 39 | # remove indent of the first row 40 | tdata$Subgroup[1] <- "All Patients" 41 | 42 | # insert a blank column so we can put the ggplot object on top 43 | tdata$` ` <- " " 44 | 45 | # correctly order columns 46 | tdata_print <- select(tdata, 47 | Subgroup, 48 | Inclisiran, 49 | Placebo, 50 | ` `, 51 | `Estimate (95% CI)`) 52 | 53 | #################### add row numbers for graph data ############################ 54 | 55 | gdata <- data 56 | gdata$row_num <- (nrow(gdata) - 1):0 57 | 58 | ### make some small data frames to help place the arrows and sub-axis labels ### 59 | 60 | # this df has the text labels 61 | xlab_df <- data.frame(text = c("Inclisiran Better", "Placebo Better"), 62 | x = c(-55, 10), 63 | y = c(0, 0)) 64 | 65 | # this df has the arrows 66 | arrow_df <- data.frame(id = c(1,2), 67 | xstart = c(-13, -9), 68 | xend = c(-95, 12), 69 | y = c(1, 1)) 70 | 71 | ########## the main figure - this will be overlaid on the table ################ 72 | 73 | center <- ggplot(data = gdata, aes(y = row_num, x = Estimate)) + 74 | geom_point(size = 3.25) + # the point estimates, with big dots 75 | geom_errorbarh(aes(y = row_num, 76 | xmin = `CI low`, 77 | xmax = `CI high`), 78 | height = .25) + # the CIs, with short ends 79 | theme_classic() + # base theme 80 | scale_y_continuous(expand = c(0,0), limits = c(-.65, 30.7)) + # remove padding 81 | theme(axis.title.y = element_blank(), # remove axis, make bg transparent 82 | axis.text.y = element_blank(), 83 | axis.ticks.y = element_blank(), 84 | axis.line.y = element_blank(), 85 | axis.ticks.length.x = unit(.1, "in"), 86 | text = element_text(family = "Fira Sans", size = 14), 87 | panel.background = element_rect(fill = "transparent"), 88 | plot.background = element_rect(fill = "transparent", color = NA), 89 | panel.grid.major = element_blank(), 90 | panel.grid.minor = element_blank(), 91 | legend.background = element_rect(fill = "transparent"), 92 | legend.box.background = element_rect(fill = "transparent")) + 93 | geom_vline(xintercept = 0, linetype = "dashed") + # add the null line 94 | scale_x_continuous(breaks = c(-100, -75, -50, -25, 0, 25), 95 | limits = c(-100, 25), 96 | labels = scales::number_format(accuracy = 0.1), 97 | expand = c(0,0)) + 98 | xlab("") 99 | 100 | ############## the ggplot object for the sub-axis labels ####################### 101 | 102 | arrows <- ggplot() + 103 | geom_segment(data = arrow_df, aes(x = xstart, xend = xend, y = y, yend = y), 104 | arrow = arrow(angle = 15, type = "closed", length = unit(0.08, "npc"))) + 105 | geom_text(data = xlab_df, aes(x = x, y = y, label = text), 106 | family = "Fira Sans", size = 4) + 107 | scale_y_continuous(expand = c(0,0), limits = c(-3, 7)) + 108 | scale_x_continuous(expand = c(0,0), limits = c(-100, 70)) + 109 | theme(panel.background = element_rect(fill = "transparent"), 110 | plot.background = element_rect(fill = "transparent", color = NA), 111 | panel.grid.major = element_blank(), 112 | panel.grid.minor = element_blank(), 113 | legend.background = element_rect(fill = "transparent"), 114 | legend.box.background = element_rect(fill = "transparent"), 115 | panel.border = element_blank(), 116 | axis.title.y = element_blank(), 117 | axis.text.y = element_blank(), 118 | axis.ticks.y = element_blank(), 119 | axis.line.y = element_blank(), 120 | axis.title.x = element_blank(), 121 | axis.text.x = element_blank(), 122 | axis.ticks.x = element_blank(), 123 | axis.line.x = element_blank()) 124 | 125 | ###### custom theme to prevent centering of text, change font, add bands ####### 126 | 127 | t1 <- ttheme_minimal(core=list( 128 | fg_params = list(hjust = 0, x = 0.05, fontfamily = "Fira Sans"), 129 | bg_params = list(fill=c(rep(c("#eff3f2", "white"), length.out=4))) 130 | ), 131 | colhead = list(fg_params = list(hjust = 0, x = 0.05, 132 | fontfamily = "Fira Sans"), 133 | bg_params = list(fill = "white")) 134 | ) 135 | 136 | 137 | # defining the layout 138 | # we want the table to take up the whole space, then overlay the ggplot on top 139 | # in the right spot 140 | # under both object, adds the arrows and labels 141 | 142 | layout <- c(area(t = 1, b = 20, l = 1, r = 15), 143 | area(t = 1, b = 20, l = 8, r = 11), 144 | area(t = 20, b = 21, l = 8, r = 13)) 145 | 146 | 147 | #combine the pieces 148 | 149 | final <- wrap_elements(tableGrob(tdata_print, theme = t1, rows = NULL)) + 150 | center + 151 | arrows + 152 | plot_layout(design = layout) 153 | 154 | # save the table as a png 155 | 156 | ggsave(dpi = 600, height = 10.2, 157 | width = 11, units = "in", 158 | filename = "final_plot.png") 159 | 160 | 161 | -------------------------------------------------------------------------------- /figure_build.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /figure_data.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rdboyes/Forest_plot_with_table/3fec971cf79c38dd39dd4e10764bf336a8d3db82/figure_data.xlsx -------------------------------------------------------------------------------- /final_plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rdboyes/Forest_plot_with_table/3fec971cf79c38dd39dd4e10764bf336a8d3db82/final_plot.png --------------------------------------------------------------------------------