Flowchart

Flowchart Diagram

Flowchart Diagram LR

Confounding Diagram

Customized flowchart with ggplot2

library(ggplot2)

data <- data.frame(x= 1:100, y= 1:100)

data %>% 
  ggplot(aes(x, y)) +
  scale_x_continuous(minor_breaks = seq(10, 100, 10)) +
  scale_y_continuous(minor_breaks = seq(10, 100, 10)) +
  theme_linedraw() -> p



xm1 <- 20
xm2 <- 65
w1 <- 10
w2 <- 25
y1 <- 100
ht <- 15
height_box <- 15
num_vertical_arrow <- 3
num_vertical_box <- num_vertical_arrow + 1
height_arrow <- (100 - height_box * num_vertical_box) / num_vertical_arrow
ytop <- seq(100, 0, -((100 - height_box * num_vertical_box)/num_vertical_arrow + height_box))

bw <- 0.25
width_border <- 0.25
size_font <- 2
width_arrow <- 0.8



label1 <- "Step I \n Enrollment \n Records \n (N = 2,045)"
label2 <- "Exclusion \n Records \n (N = 762)"
label3 <- "Study Population \n (N = 599)"
label4 <- "Outcome Analysis \n Population \n (N = 576)"



p <- p + geom_rect(
             xmin = xm1 - w1
           , xmax = xm1 + w1
           , ymin = y1 - ht
           , ymax = ytop[1]
           , color = 'black'
           , fill = 'white'
           , size = bw
         )
p <- p + annotate(
             'text'
           , x = xm1
           , y = ytop[1] - ht / 2
           , label = label1
           ## , parse = TRUE
           , size = size_font
         )


p <- p + geom_rect(
             xmin = xm1 - w1
           , xmax = xm1 + w1
           , ymin = ytop[2] - ht
           , ymax = ytop[2]
           , color = 'black'
           , fill = 'white'
           , size = bw
         )
p <- p + annotate(
             'text'
           , x = xm1
           , y = ytop[2] -  ht / 2
           , label = label2
           , size = size_font
         )

p <- p + geom_segment(
        x = xm1
      , xend = xm1
      , y = ytop[1] - ht - bw
      , yend = ytop[2] + bw
      , size = width_arrow
      , linejoin = "round"
      , lineend = "round"
      , arrow = arrow(length = unit(2, "mm"), type= "open"))


## row 3
p <- p + geom_rect(
             xmin = xm1 - w1
           , xmax = xm1 + w1
           , ymin = ytop[3] - ht
           , ymax = ytop[3]
           , color = 'black'
           , fill = 'white'
           , size = bw
         )
p <- p + annotate(
             'text'
           , x = xm1
           , y = ytop[3] -  ht / 2
           , label = label3
           , size = size_font
         )

p <- p + geom_segment(
        x = xm1
      , xend = xm1
      , y = ytop[2] - ht - bw
      , yend = ytop[3] + bw
      , size = width_arrow
      , linejoin = "round"
      , lineend = "round"
      , arrow = arrow(length = unit(2, "mm"), type= "open"))

## row 4
p <- p + geom_rect(
             xmin = xm1 - w1
           , xmax = xm1 + w1
           , ymin = ytop[4] - ht
           , ymax = ytop[4]
           , color = 'black'
           , fill = 'white'
           , size = bw
         )
p <- p + annotate(
             'text'
           , x = xm1
           , y = ytop[4] -  ht / 2
           , label = label4
           , size = size_font
         )

p <- p + geom_segment(
        x = xm1
      , xend = xm1
      , y = ytop[3] - ht - width_border
      , yend = ytop[4] + width_border
      , size = width_arrow
      , linejoin = "round"
      , lineend = "round"
      , arrow = arrow(length = unit(2, "mm"), type= "open"))



## column b1
labelb1 <- "Excluded (n = 17)"
labelb2 <- "Excluded (n=78)"
labelb3 <- "Excluded (n = 2)"

p <- p + geom_rect(
             xmin = xm2 - w2
           , xmax = xm2 + w2
           , ymin = ytop[1] - height_box - height_arrow / 2 - ht / 2 * 1.6
           , ymax = ytop[1] - height_box - height_arrow / 2 + ht / 2 * 1.6
           , color = 'black'
           , fill = 'white'
           , size = bw
         )
p <- p + annotate(
             'text'
           , x = xm2
           , y = ytop[1] - height_box - height_arrow / 2
           , label = labelb1
           , size = size_font
         )

p <- p + geom_segment(
        x = xm1 + width_border
      , xend = xm2 - w2 - width_border
      , y = ytop[1] - height_box - height_arrow / 2  
      , yend = ytop[1] - height_box - height_arrow / 2 
      , size = width_arrow
      , linejoin = "round"
      , lineend = "round"
      , arrow = arrow(length = unit(2, "mm"), type= "open"))

## column b2
p <- p + geom_rect(
             xmin = xm2 - w2
           , xmax = xm2 + w2
           , ymin = ytop[2] - height_box - height_arrow / 2 - ht / 2
           , ymax = ytop[2] - height_box - height_arrow / 2 + ht / 2
           , color = 'black'
           , fill = 'white'
           , size = bw
         )
p <- p + annotate(
             'text'
           , x = xm2
           , y = ytop[2] - height_box - height_arrow / 2
           , label = labelb2
           , size = size_font
         )

p <- p + geom_segment(
        x = xm1 + width_border
      , xend = xm2 - w2 - width_border
      , y = ytop[2] - height_box - height_arrow / 2
      , yend = ytop[2] - height_box - height_arrow / 2
      , size = width_arrow
      , linejoin = "round"
      , lineend = "round"
      , arrow = arrow(length = unit(2, "mm"), type= "open"))


## column b3

p <- p + geom_rect(
             xmin = xm2 - w2
           , xmax = xm2 + w2
           , ymin = ytop[3] - height_box - height_arrow / 2 - ht / 2
           , ymax = ytop[3] - height_box - height_arrow / 2 + ht / 2
           , color = 'black'
           , fill = 'white'
           , size = bw
         )
p <- p + annotate(
             'text'
           , x = xm2
           , y = ytop[3] - height_box - height_arrow / 2
           , label = labelb3
           , size = size_font
         )

p <- p + geom_segment(
        x = xm1 + width_border
      , xend = xm2 - w2 - width_border
      , y = ytop[3] - height_box - height_arrow / 2
      , yend = ytop[3] - height_box - height_arrow / 2
      , size = width_arrow
      , linejoin = "round"
      , lineend = "round"
      , arrow = arrow(length = unit(2, "mm"), type= "open"))

p <- p + theme_void()


p

Computing Environment

R version 4.2.0 (2022-04-22) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 20.04.3 LTS

Matrix products: default BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0 LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0

locale: [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
[4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
[7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] tgsify_0.0.1 showtext_0.9-5 showtextdb_3.0
[4] sysfonts_0.8.8 dtplyr_1.2.1 htmltools_0.5.3
[7] DiagrammeRsvg_0.1 DiagrammeR_1.0.9 Wu_0.0.0.9000
[10] flexdashboard_0.5.2 lme4_1.1-29 Matrix_1.4-0
[13] mgcv_1.8-38 nlme_3.1-152 png_0.1-7
[16] scales_1.2.0 nnet_7.3-16 labelled_2.9.1
[19] kableExtra_1.3.4 plotly_4.10.0 gridExtra_2.3
[22] ggplot2_3.3.6 DT_0.23 tableone_0.13.2
[25] magrittr_2.0.3 lubridate_1.8.0 dplyr_1.0.9
[28] plyr_1.8.7 data.table_1.14.2 rmdformats_1.0.4
[31] knitr_1.39

loaded via a namespace (and not attached): [1] webshot_0.5.3 RColorBrewer_1.1-3 httr_1.4.3 tools_4.2.0
[5] bslib_0.3.1 utf8_1.2.2 R6_2.5.1 DBI_1.1.2
[9] lazyeval_0.2.2 colorspace_2.0-3 withr_2.5.0 tidyselect_1.1.2
[13] curl_4.3.2 compiler_4.2.0 cli_3.3.0 rvest_1.0.2
[17] xml2_1.3.3 labeling_0.4.2 bookdown_0.27 sass_0.4.1
[21] systemfonts_1.0.4 stringr_1.4.0 digest_0.6.29 minqa_1.2.4
[25] rmarkdown_2.14 svglite_2.1.0 pkgconfig_2.0.3 fastmap_1.1.0
[29] highr_0.9 htmlwidgets_1.5.4 rlang_1.0.4 rstudioapi_0.13
[33] visNetwork_2.1.0 jquerylib_0.1.4 generics_0.1.3 farver_2.1.1
[37] jsonlite_1.8.0 Rcpp_1.0.9 munsell_0.5.0 fansi_1.0.3
[41] lifecycle_1.0.1 stringi_1.7.8 yaml_2.3.5 MASS_7.3-54
[45] grid_4.2.0 forcats_0.5.1 lattice_0.20-45 haven_2.5.0
[49] splines_4.2.0 hms_1.1.1 klippy_0.0.0.9500 pillar_1.8.0
[53] boot_1.3-28 glue_1.6.2 evaluate_0.15 V8_4.2.1
[57] mitools_2.4 vctrs_0.4.1 nloptr_2.0.3 gtable_0.3.0
[61] purrr_0.3.4 tidyr_1.2.0 assertthat_0.2.1 xfun_0.31
[65] survey_4.1-1 survival_3.2-13 viridisLite_0.4.0 tibble_3.1.8
[69] ellipsis_0.3.2