R ggplot plot and grid.arrange workflow

f_ggplot_grid_workflow.R

## Erik's workflow template for plots in R ggplot2
library(erikmisc) # https://github.com/erikerhardt/erikmisc/

# https://patchwork.data-imaginist.com/articles/guides/layout.html

# When lazy evaluation (nonstandard evaluation NSE) is an issue with plots into a list
#   force evaluation by running cowplot (have not found a better way using force() or eval() or tidy_eval())
#  p_list[[ i_plot ]] <- p |> cowplot::plot_grid()



  # patchwork model selection plot design
  #   appears: after model selection if no x variables
  #            at end to summarize ROC with model selection
  plot_design <-
    "AAAABB
     AAAABB
     CCCCDD
     CCCCDD
     EEEEEE
     EEEEEE"

  out[[ "plot_rf_train_all_summary" ]] <-
    cowplot::plot_grid(out$plot_o_class              ) +
    cowplot::plot_grid(out$plot_o_class_subsample    ) +
    cowplot::plot_grid(out$plot_o_class_sel          ) +
    cowplot::plot_grid(out$plot_o_class_sel_subsample) +
    cowplot::plot_grid(plotlist = out$plot_o_class_sel_ROC$plot_roc, nrow = 1) +
    patchwork::plot_layout(design = plot_design) +
    patchwork::plot_annotation(
      title       = text_formula
    , subtitle    = text_formula_sel
    , caption     = paste0(
                      "Full model AUC = "
                    , round(out$o_class_AUC, 3)
                    , ";  "
                    , "Selected model AUC = "
                    , round(out$o_class_sel_AUC, 3)
                    )
    , tag_levels  = "A"
    ) +
    theme(plot.caption = element_text(hjust = 0)) # Default is hjust=1, Caption align left


ggplot2::theme_set(ggplot2::theme_bw())  # set theme_bw for all plots

# cowplot template
cowplot::plot_grid(
    plotlist         = p_list
  , align            = c("none", "h", "v", "hv")[4]
  , axis             = c("none", "l", "r", "t", "b", "lr", "tb", "tblr")[1]
  , nrow             = 1
  , ncol             = NULL
  , rel_widths       = 1
  , rel_heights      = 1
  , labels           = "AUTO" # "auto", c("A", "B")
  , label_size       = 14
  , label_fontfamily = NULL
  , label_fontface   = "bold"
  , label_colour     = NULL
  , label_x          = 0
  , label_y          = 1
  , hjust            = -0.5
  , vjust            = 1.5
  , scale            = 1
  , greedy           = TRUE
  , byrow            = TRUE
)


## References
# subscripts and symbols: https://rstudio-pubs-static.s3.amazonaws.com/136237_170402e5f0b54561bf7605bdea98267a.html
# latex in plots: https://www.stefanom.io/latex2exp/

## Example
library(ggplot2)
p <- ggplot(mpg, aes(x = displ, y = hwy, colour = class)) 
p <- p + theme_bw()
# plot a reference line for the global mean (assuming no groups)
#p <- p + geom_hline(aes(yintercept = 0), colour = "black", linetype = "solid", linewidth = 0.2, alpha = 0.3)
p <- p + geom_hline(aes(yintercept = mean(displ)), colour = "black", linetype = c("none", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash")[3], linewidth = 0.3, alpha = 0.5)
#p <- p + geom_hline(aes(yintercept = 5), colour = "black", linetype = c("none", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash")[2], linewidth = 0.3, alpha = 0.25)
#p <- p + geom_vline(aes(xintercept = 5), colour = "black", linetype = c("none", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash")[2], linewidth = 0.3, alpha = 0.25)
p <- p + geom_smooth(method = lm, se = FALSE, aes(group = class, colour = class), linewidth = 1)
# colored line for each patient
p <- p + geom_line(aes(group = class, colour = class), alpha = 0.5)
# boxplot, size=.75 to stand out behind CI
#p <- p + geom_boxplot(size = 0.25, alpha = 0.5)
# points for observed data
p <- p + geom_point(aes(colour = class), alpha = 0.5)
# diamond at mean for each group
p <- p + stat_summary(fun = mean, geom = "point", shape = 18, size = 6, alpha = 1)
# confidence limits based on normal distribution
p <- p + stat_summary(fun.data = "mean_cl_normal", geom = "errorbar", width = 0.2, alpha = 0.8)
#p <- p + ggrepel::geom_text_repel() # print label = Val text so they do not overlap
#p <- p + scale_y_continuous(limits = c(0, 10), breaks = seq(0, 10, by = 2), expand = expansion(mult = 0, add = 0))
#p <- p + scale_x_continuous(limits = c(0, 10), breaks = seq(0, 10, by = 2), expand = expansion(mult = 0, add = 0))
#p <- p + scale_y_continuous(labels = scales::label_number_si())        # numbers like 250K
#p <- p + scale_y_continuous(labels = scales::dollar_format())  # dollars
#p <- p + scale_y_continuous(labels = scales::percent)          # percent
#p <- p + scale_y_discrete(limits = rev) # reverse axis
#p <- p + geom_abline(intercept = 0, slope = 1, alpha = 0.25) # draw a y=x 1:1 line
#p <- p + coord_fixed(ratio = 1) # equal axes
#p <- p + facet_grid(surv_prog ~ pci_part_id_ps, scales = "free_y", drop = TRUE)
#p <- p + facet_wrap(~ class, drop = TRUE)
#p <- p + coord_flip() # swap axes

# facet labeller: https://ggplot2.tidyverse.org/reference/labeller.html

p <- p + labs(
                title     = "title"
              , subtitle  = "subtitle"
              , x         = "x"
              , y         = "y"
              , caption = paste0(  "Caption 1"
                                , "\nCaption 2"
                                )
              , colour    = "Class"
              #, shape     = "Class"
              #, linetype  = "General Health"  #"Diagnosis"
              #, fill      = "Diagnosis"
              #, tag = "A"
              )
p <- p + guides(
                size       = "none"
              , alpha      = "none"
              ) # remove specific guides from the legend
p <- p + theme(legend.position = "bottom") # "none"
#p <- p + theme(legend.key.width= unit(2, 'in')) # legend.key.height= unit(0.5, 'in'),  # Size of colorbar
p <- p + theme(legend.box="vertical", legend.margin=margin()) # stack vertically
#p <- p + guides(fill = guide_legend(ncol = 1, byrow = FALSE)) # shape levels of one legend
#p <- p + theme( # legend position inside plot (top-right = c(1,1),c(0.95,0.95))
#            legend.justification  = c(1, 1)         # x, y anchor position of legend to align with position in plot
#          , legend.position       = c(0.95, 0.95)   # x, y position inside plot for legend anchor
#          #, legend.background     = element_blank() # blank background so points/grid shows through
#          #, legend.key            = element_blank() # blank background so points/grid shows through
#          )
#p <- p + theme(axis.text.x = element_text(angle = 15, vjust = 1, hjust = 1)) # rotate labels
p <- p + theme(plot.caption = element_text(hjust = 0), plot.caption.position = "plot") # Default is hjust=1, Caption align left (*.position all the way left)
#p <- p + theme(plot.title.position = "plot") # move title to far left, https://github.com/tidyverse/ggplot2/issues/3252
#p <- p + theme(axis.title.x = element_blank(), axis.text.x = element_blank(), axis.ticks.x = element_blank()) # remove axis labels
p <- p + guides(colour = guide_legend(reverse = TRUE))
print(p)

## histogram
p <- ggplot(data = nesarc_sub, aes(x = DailyCigsSmoked))
p <- p + geom_histogram(aes(y = ..density..), boundary = 0, binwidth = 2)
p <- p + geom_rug()
p <- p + geom_density(alpha = 0.2, fill = "gray50", adjust = 1.5)
p <- p + labs(x = "Estimated Cigarettes Smoked per Month"
            , y = ""
            , title = "Monthly cigaretts smoked for Young Smoking Adults"
            )
p


# blank plot used as a place holder
p_blank <- 
  ggplot() +
  theme_void() +
  geom_text(aes(0, 0, label = "N/A")) +
  xlab(NULL) #optional, but safer in case another theme is applied later

# Title for cowplot::plot_grid()
p0 <- ggplot()
p0 <- p0 + labs(
                  title     = "Title"
                , subtitle  = "Subtitle"
                )


# Extract the legend
#   https://stackoverflow.com/questions/12041042/how-to-plot-just-the-legends-in-ggplot2
f_extract_legend <- function(p_gplot){
   tmp <- ggplot_gtable(ggplot_build(p_gplot))
   leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
   legend <- tmp$grobs[[leg]]
   return(legend)
}
p_legend <- f_extract_legend(p)
#grid.newpage()
#grid.draw(legend) 
ggsave(
    paste0("plot_legend", ".png")
  , plot   = p_legend
  , width  = 4
  , height = 1
  ## png, jpeg
  , dpi    = 300
  , bg     = "white"
  ## pdf
  #, units  = "in"
  #, useDingbats = FALSE
  )


p_list <- 
  list(
    p
  , p
  , p_blank
  , p_legend
  )

                       
# For bolder labels, remove the labs(tag=) argument and use this
p_list <- erikmisc::e_plot_grid_corner_label_list(p_list)

## Arrange in a grid
library(gridExtra)
library(grid)
lay_grid <-
  # rbind(
  #   c(1, 1, 1, 1, 2, 2)
  # , c(1, 1, 1, 1, 3, 3)
  # , c(1, 1, 1, 1, 3, 3)
  # , c(1, 1, 1, 1, 3, 3)
  # , c(1, 1, 1, 5, 5, 5)
  # , c(4, 4, 4, 5, 5, 5)
  # )
  rbind(
    c(1, 2, 3)
  , c(4, 4, 4)
  )
p_arranged <-
  #gridExtra::grid.arrange(
  gridExtra::arrangeGrob(
    grobs         = p_list
  , layout_matrix = lay_grid
  , top           = "top title"
  , bottom        = "bottom\ntitle"
  , left          = "left label"
  , right         = "right label"
  ) %>%
  ggpubr::as_ggplot()

                       
## cowplot version
p_arranged <-
  cowplot::plot_grid(
    plotlist = p_list
  , nrow = NULL
  , ncol = 2
  )
                       
# Title in cowplot plot_grid
# https://stackoverflow.com/questions/50973713/ggplot2-creating-themed-title-subtitle-with-cowplot
f_draw_label_theme <-
  function(
    this_label
  , this_theme   = NULL
  , this_element = "text"
  , ...
  ) {

  if (is.null(this_theme)) {
    this_theme <- ggplot2::theme_get()
  }
  if (!this_element %in% names(this_theme)) {
    stop("Element must be a valid ggplot theme element name")
  }

  elements <- ggplot2::calc_element(this_element, this_theme)

  cowplot::draw_label(
    this_label
  , fontfamily  = elements$family
  , fontface    = elements$face
  , colour      = elements$color
  , size        = elements$size
  , ...
  )
}

cowplot_title <-
  cowplot::ggdraw() +
  f_draw_label_theme(
    paste0(
      "Support group: "
    , n_PSH_ES
    , ";  "
    , "Response: "
    , this_var_list
    )
  #, theme = theme_georgia()
  , this_element = "plot.title"
  , x = 0.01 #0.05
  , hjust = 0
  , vjust = 1
  )
cowplot_subtitle <-
  cowplot::ggdraw() +
  f_draw_label_theme(
    "By census tract, 2016"
  , this_theme = theme_georgia()
  , this_element = "plot.subtitle"
  , x = 0.05
  , hjust = 0
  , vjust = 1
  )

p.arranged2 <-
  cowplot::plot_grid(
    cowplot_title
  #, cowplot_subtitle
  , p.arranged
  , ncol = 1
  , rel_heights = c(0.04, 1)
  )

p.arranged2 %>% print()
                       
                       
                       
# write to pdf or other image format
ggsave(
    "plot_name.png"
  , plot   = p_arranged
  , width  = 6
  , height = 8
  ## png, jpeg
  , dpi    = 300
  , bg     = "white"
  ## pdf
  #, units  = "in"
  #, useDingbats = FALSE
  )


## Table in a ggplot plot grid panel

# https://cran.r-project.org/web/packages/tablesgg/vignettes/tablesgg.pdf
# install.packages("tablesgg")
#library(tablesgg)

tab_plot <-
  tablesgg::textTable(
    #dat1 %>% as.data.frame()
    #dat2 %>% as.data.frame()
    #dat2_long %>% as.data.frame()
    # reorder columns and sort data
    dat2_long %>% select(name, date, value) %>% arrange(name, date) %>% as.data.frame()
  , title = "Title for data"
  , subtitle = c("Title and subtitle", "are optional")
  , foot = "A footnote is available, too"
  # and additional options are available.
  )
p2 <-
  tablesgg::plot(
    tab_plot
  #, plot.margin = c(1, 1, 1, 1) # 4 is default: top, right, bottom, and left
  )



########################################
## ggpairs
# https://www.blopig.com/blog/2019/06/a-brief-introduction-to-ggpairs/

dat <-
  datasets::mtcars %>%
  tibble::as_tibble(
    rownames = "model"
  ) %>%
  dplyr::mutate(
    cyl = cyl %>% factor(levels = c(4, 6, 8), labels = c("four", "six", "eight"))
  , vs  = vs  %>% factor(levels = c(0, 1)   , labels = c("V-shaped", "straight"))
  , am  = am  %>% factor(levels = c(0, 1)   , labels = c("automatic", "manual"))
  )

## Scatterplot matrix
library(ggplot2)
library(GGally)
p <-
  ggpairs(
    dat %>% select(mpg, disp, hp, cyl, am)
  , title = "Title"
  , mapping = ggplot2::aes(color = cyl, alpha = 0.5)
  , legend = 1        # create legend for color mapping
  , diag  = list(
              continuous =
                wrap(
                  c("densityDiag", "barDiag", "blankDiag")[1]
                , alpha = 1/2
                )
            , discrete =
                c("barDiag", "blankDiag")[1]
            )
  # scatterplots on top so response as first variable has y on vertical axis
  , upper = list(
              continuous =
                wrap(
                  c("points", "smooth", "smooth_loess", "density", "cor", "blank")[2]
                , se = FALSE
                , alpha = 1/2
                , size = 1
                )
            , discrete =
                c("ratio", "facetbar", "blank")[2]
            , combo =
                wrap(
                  c("box", "box_no_facet", "dot", "dot_no_facet", "facethist", "facetdensity", "denstrip", "blank")[2]
                #, bins = 10  # for facethist
                )
            )
  , lower = list(
              continuous =
                wrap(
                  c("points", "smooth", "smooth_loess", "density", "cor", "blank")[5]
                #, se = FALSE
                #, alpha = 1/2
                #, size = 1
                )
            , discrete =
                c("ratio", "facetbar", "blank")[2]
            , combo =
                wrap(
                  c("box", "box_no_facet", "dot", "dot_no_facet", "facethist", "facetdensity", "denstrip", "blank")[5]
                , bins = 10  # for facethist
                )
            )
  , progress = FALSE
  )
p <- p + theme_bw()
p <- p + theme(legend.position = "bottom")
print(p)

                       
# A parallel coordinate plot is another way of seeing patterns of observations over a range of variables.
# http://www.inside-r.org/packages/cran/GGally/docs/ggparcoord
library(ggplot2)
library(GGally)

# univariate min/max scaling
p_uniminmax <-
  ggparcoord(
    data = dat_water
  , columns = c(5, 2, 4, 1, 3) #1:5
  , groupColumn = 5 # color (pick the response)
  #, order = "anyClass"
  , scale = "uniminmax" # "uniminmax". "globalminmax"
  , showPoints = FALSE
  , title = "Parallel Coordinate Plot for the Water Data"
  #, alphaLines = 1/3
  #, shadeBox = "white"
  #, boxplot = TRUE
  ) + theme_bw()
print(p_uniminmax)
                       

                       
# Base graphics plot                       
par_old <- par(no.readonly = TRUE)
par(mfrow = c(1, 2))
# plot
par(par_old)

                       
# Correlation plots
# https://cran.r-project.org/web/packages/corrplot/vignettes/corrplot-intro.html



## Outliers plot
Var_outlier_plot <- list()
Var_outlier_plot[["list"]][["Depression"]] <-
  c(
    "depr_PHQ2_Value"
  , "depr_PHQ9_Value"
  )
Var_outlier_plot[["label"]][["Depression"]] <-
  c(
    "Depression (PHQ-2)"
  , "Depression (PHQ-9)"
  )
par(mfrow=c(1,3))
for (i_table in 1:length(Var_outlier_plot$list)) {
  ## i_table = 2

  table_name <- names(Var_outlier_plot$list)[[i_table]]
  var_names  <- Var_outlier_plot$list[[i_table]]

  for (i_plot in 1:length(var_names)) {
    ## i_plot = 1
    #if (i_plot > 3) {next}

    dat_this <- dat_clean[[table_name]]

    ind_all <- 1:nrow(dat_this)

    # addessing issue when there's all NAs
    if ( all(is.na(dat_this[[ var_names[i_plot] ]])) ) {
      val_y <- ind_all
    } else {
      val_y <- dat_this[[ var_names[i_plot] ]]
    }

    plot(
      x     = ind_all
    , y     = val_y  # dat_this[[ var_names[i_plot] ]]
    , type  = "p"
    , main  = paste0("Before: ", var_names[i_plot])
    , xlab  = ""
    , ylab  = ""
    , col   = dat_this$demo_Site %>% factor()
    , pch   = 20  #3
    , xlim  = c(1, nrow(dat_this) * 1.2)
    )
    ### uncomment to label with row number
    # text(
    #   x     = ind_all
    # , y     = val_y # dat_this[[ var_names[i_plot] ]]
    # , labels = ind_all
    # , pos   = 4 # 1 = below, 2 = left, 3 = above, 4 = right
    # )
  } # i_plot
} # i_table
par(mfrow=c(1,1))