#' @include utilities.R
NULL
#' Draw a Textual Table
#' @description Draw a textual table. \itemize{ \item \code{ggtexttable()}: draw
#'  a textual table. \item \code{ttheme()}: customize table theme. \item
#'  \code{rownames_style(), colnames_style(), tbody_style()}: helper functions
#'  to customize the table row names, column names and body.
#'  \item \code{table_cell_font()}: access to a table cell for changing the text font (size and face).
#'  \item \code{table_cell_bg()}: access to a table cell for changing the background (fill, color, linewidth).
#'  \item \code{tab_cell_crossout()}: cross out a table cell.
#'  \item \code{tab_ncol(), tab_nrow()}: returns, respectively, the number of columns and rows in a ggtexttable.
#'  \item \code{tab_add_hline()}: Creates horizontal lines or separators at the top or the bottom side of a given specified row.
#'  \item \code{tab_add_vline()}: Creates vertical lines or separators at the right or the left side of a given specified column.
#'  \item \code{tab_add_border(), tbody_add_border(), thead_add_border()}: Add borders to table; tbody is for table body and thead is for table head.
#'  \item \code{tab_add_title(),tab_add_footnote()}: Add title, subtitle and footnote to a table.
#'   }
#' @inheritParams gridExtra::tableGrob
#' @param x a \code{data.frame} or \code{matrix}.
#' @param theme a list, as returned by the function \code{ttheme()}, defining the
#'  parameters of the table theme. Allowed values include one of \code{ttheme()}
#'  and \code{ttheme_clean()}.
#' @param base_style character string the table style/theme. The available themes
#'  are illustrated in the
#'  \href{https://rpkgs.datanovia.com/ggpubr/files/ggtexttable-theme.pdf}{ggtexttable-theme.pdf}
#'   file. Allowed values include one of \code{c("default", "blank", "classic",
#'  "minimal", "light", "lBlack", "lBlue", "lRed", "lGreen", "lViolet", "lCyan",
#'  "lOrange", "lBlackWhite", "lBlueWhite", "lRedWhite", "lGreenWhite",
#'  "lVioletWhite", "lCyanWhite", "lOrangeWhite", "mBlack", "mBlue", "mRed",
#'  "mGreen", "mViolet", "mCyan", "mOrange", "mBlackWhite", "mBlueWhite",
#'  "mRedWhite", "mGreenWhite", "mVioletWhite", "mCyanWhite", "mOrangeWhite" )}.
#'  Note that, l = "light"; m = "medium".
#' @param colnames.style a list, as returned by the function
#'  \code{colnames_style()}, defining the style of the table column names.
#'  Considered only when \code{base_size = "default"}.
#' @param rownames.style a list, as returned by the function
#'  \code{rownames_style()}, defining the style of the table row names.
#'  Considered only when \code{base_size = "default"}.
#' @param tbody.style a list, as returned by the function \code{tbody_style()},
#'  defining the style of the table body. Considered only when \code{base_size =
#'  "default"}.
#' @param color,face,size text font color, face and size, respectively. Allowed
#'  values for face include c("plain", "bold", "italic", "bold.italic").
#' @param fill background color.
#' @param linewidth,linecolor line width and color, respectively.
#' @param alpha numeric value specifying fill color transparency.
#' Value should be in [0, 1], where 0 is full transparency and 1 is no transparency.
#' @param at.row a numeric vector of row indexes; for example \code{at.row = c(1, 2)}.
#' @param row.side row side to which the horizontal line should be added. Can be one of \code{c("bottom", "top")}.
#' @param from.column integer indicating the column from which to start drawing the horizontal line.
#' @param to.column integer indicating the column to which the horizontal line should end.
#' @param linetype line type
#' @param at.column a numeric vector of column indexes; for example \code{at.column = c(1, 2)}.
#' @param column.side column side to which the vertical line should be added. Can be one of \code{c("left", "right")}.
#' @param from.row integer indicating the row from which to start drawing the horizontal line.
#' @param to.row integer indicating the row to which the vertical line should end.
#' @param ... extra parameters for text justification, e.g.: hjust and x. Default
#'  is "centre" for the body and header, and "right" for the row names. Left
#'  justification: \code{hjust = 0, x = 0.1}. Right justification: \code{hjust = 1, x = 0.9}.
#' @return an object of class ggplot.
#'
#'
#' @examples
#' # data
#' df <- head(iris)
#'
#' # Default table
#' # Remove row names using rows = NULL
#' ggtexttable(df, rows = NULL)
#'
#' # Text justification for individual cells/rows/columns (#335)
#' # First column is left justified i.e., hjust = 0 , x = 0.1
#' # Remaining columns are right justified i.e., hjust = 1 , x = 0.9
#' table_theme <- ttheme(
#'   tbody.style = tbody_style(
#'     hjust = as.vector(matrix(c(0, 1, 1, 1, 1), ncol = 5, nrow = nrow(df), byrow = TRUE)),
#'     x = as.vector(matrix(c(.1, .9, .9, .9, .9), ncol = 5, nrow = nrow(df), byrow = TRUE))
#'   )
#' )
#' ggtexttable(df, rows = NULL, theme = table_theme)
#'
#' # Blank theme
#' ggtexttable(df, rows = NULL, theme = ttheme("blank"))
#'
#' # light theme
#' ggtexttable(df, rows = NULL, theme = ttheme("light"))
#'
#' # Column names border only
#' ggtexttable(df, rows = NULL, theme = ttheme("blank")) %>%
#'   tab_add_hline(at.row = 1:2, row.side = "top", linewidth = 2)
#'
#' # classic theme
#' ggtexttable(df, rows = NULL, theme = ttheme("classic"))
#'
#' # minimal theme
#' ggtexttable(df, rows = NULL, theme = ttheme("minimal"))
#'
#' # Medium blue (mBlue) theme
#' ggtexttable(df, rows = NULL, theme = ttheme("mBlue"))
#'
#'
#' # Customize the table as you want
#' ggtexttable(df,
#'   rows = NULL,
#'   theme = ttheme(
#'     colnames.style = colnames_style(color = "white", fill = "#8cc257"),
#'     tbody.style = tbody_style(color = "black", fill = c("#e8f3de", "#d3e8bb"))
#'   )
#' )
#'
#' # Use RColorBrewer palette
#' # Provide as many fill color as there are rows in the table body, here nrow = 6
#' ggtexttable(df,
#'   theme = ttheme(
#'     colnames.style = colnames_style(fill = "white"),
#'     tbody.style = tbody_style(fill = get_palette("RdBu", 6))
#'   )
#' )
#'
#' # Text justification
#' # ::::::::::::::::::::::::::::::::::::::::::::::
#' # Default is "centre" for the body and header, and "right" for the row names.
#' # Left justification: hjust=0, x=0.1
#' # Right justification: hjust=1, x=0.9
#' tbody.style <- tbody_style(
#'   color = "black",
#'   fill = c("#e8f3de", "#d3e8bb"), hjust = 1, x = 0.9
#' )
#' ggtexttable(head(iris),
#'   rows = NULL,
#'   theme = ttheme(
#'     colnames.style = colnames_style(color = "white", fill = "#8cc257"),
#'     tbody.style = tbody.style
#'   )
#' )
#'
#' # Access and modify the font and
#' # the background of table cells
#' # :::::::::::::::::::::::::::::::::::::::::::::
#' tab <- ggtexttable(head(iris),
#'   rows = NULL,
#'   theme = ttheme("classic")
#' )
#' tab <- table_cell_font(tab,
#'   row = 3, column = 2,
#'   face = "bold"
#' )
#' tab <- table_cell_bg(tab,
#'   row = 4, column = 3, linewidth = 5,
#'   fill = "darkolivegreen1", color = "darkolivegreen4"
#' )
#' tab
#'
#' # Change table cells background and font for column 3,
#' # Spaning from row 2 to the last row in the data
#' tab <- ggtexttable(df, rows = NULL, theme = ttheme("classic"))
#' tab %>%
#'   table_cell_bg(row = 2:tab_nrow(tab), column = 3, fill = "darkblue") %>%
#'   table_cell_font(row = 2:tab_nrow(tab), column = 3, face = "italic", color = "white")
#'
#' # Add separators and borders
#' # :::::::::::::::::::::::::::::::::::::::::::::::::::
#' # Table with blank theme
#' tab <- ggtexttable(df, theme = ttheme("blank"), rows = NULL)
#' # Add horizontal and vertical lines
#' tab %>%
#'   tab_add_hline(at.row = c(1, 2), row.side = "top", linewidth = 3, linetype = 1) %>%
#'   tab_add_hline(at.row = c(7), row.side = "bottom", linewidth = 3, linetype = 1) %>%
#'   tab_add_vline(at.column = 2:tab_ncol(tab), column.side = "left", from.row = 2, linetype = 2)
#'
#' # Add borders to table body and header
#' # Cross out some cells
#' tab %>%
#'   tbody_add_border() %>%
#'   thead_add_border() %>%
#'   tab_cell_crossout(
#'     row = c(2, 4), column = 3, linecolor = "red",
#'     reduce.size.by = 0.6
#'   )
#'
#' # Add titles andd footnote
#' # :::::::::::::::::::::::::::::::::::::::::::::::::::
#' # Add titles and footnote
#' # Wrap subtitle into multiple lines using strwrap()
#' main.title <- "Edgar Anderson's Iris Data"
#' subtitle <- paste0(
#'   "This famous (Fisher's or Anderson's) iris data set gives the measurements",
#'   " in centimeters of the variables sepal length and width and petal length and width,",
#'   " respectively, for 50 flowers from each of 3 species of iris.",
#'   " The species are Iris setosa, versicolor, and virginica."
#' ) %>%
#'   strwrap(width = 80) %>%
#'   paste(collapse = "\n")
#'
#' tab <- ggtexttable(head(iris), theme = ttheme("light"))
#' tab %>%
#'   tab_add_title(text = subtitle, face = "plain", size = 10) %>%
#'   tab_add_title(text = main.title, face = "bold", padding = unit(0.1, "line")) %>%
#'   tab_add_footnote(text = "*Table created using ggpubr", size = 10, face = "italic")
#'
#'
#' # Combine density plot and summary table
#' # :::::::::::::::::::::::::::::::::::::
#' # Density plot of "Sepal.Length"
#' density.p <- ggdensity(iris,
#'   x = "Sepal.Length",
#'   fill = "Species", palette = "jco"
#' )
#'
#' # Draw the summary table of Sepal.Length
#' # Descriptive statistics by groups
#' stable <- desc_statby(iris,
#'   measure.var = "Sepal.Length",
#'   grps = "Species"
#' )
#' stable <- stable[, c("Species", "length", "mean", "sd")]
#' stable.p <- ggtexttable(stable,
#'   rows = NULL,
#'   theme = ttheme("mOrange")
#' )
#'
#' # Arrange the plots on the same page
#' ggarrange(density.p, stable.p,
#'   ncol = 1, nrow = 2,
#'   heights = c(1, 0.5)
#' )
#'
#' @rdname ggtexttable
#' @export
ggtexttable <- function(x, rows = rownames(x), cols = colnames(x), vp = NULL,
                        theme = ttheme(), ...) {
  style <- attr(theme, "style")
  res <- gridExtra::tableGrob(x,
    rows = rows, cols = cols, vp = vp,
    theme = theme, ...
  )
  if (style == "minimal") {
    # minimal = blank theme + left vertical line
    res <- tab_add_vline(
      res,
      at.column = 2:tab_ncol(res), column.side = "left",
      from.row = 2, to.row = tab_nrow(res)
    )
  } else if (style == "light") {
    # light = blank theme + horizontal line
    res <- tab_add_hline(
      res,
      at.row = c(1, tab_nrow(res)), row.side = "bottom",
      linewidth = 1.5, linetype = 1, from.column = 1
    )
  }
  .grob <- res
  res <- as_ggplot(res)
  attr(res, "ggtexttableGrob") <- .grob
  return(res)
}

#' @export
#' @rdname ggtexttable
ttheme <- function(base_style = "default", base_size = 11, base_colour = "black", padding = unit(c(4, 4), "mm"),
                   colnames.style = colnames_style(size = base_size),
                   rownames.style = rownames_style(size = base_size),
                   tbody.style = tbody_style(size = base_size)) {
  style <- tstyle(base_style, size = base_size)
  if (!is.null(style)) {
    if (missing(colnames.style)) colnames.style <- style$colnames.style
    if (missing(rownames.style)) rownames.style <- style$rownames.style
    if (missing(tbody.style)) tbody.style <- style$tbody.style
  }

  .ttheme <- gridExtra::ttheme_default(
    base_size = base_size,
    base_colour = base_colour,
    padding = padding
  )

  .ttheme$colhead <- do.call(.add_item, c(list(.list = .ttheme$colhead), colnames.style))
  .ttheme$rowhead <- do.call(.add_item, c(list(.list = .ttheme$rowhead), rownames.style))
  .ttheme$core <- do.call(.add_item, c(list(.list = .ttheme$core), tbody.style))
  attr(.ttheme, "style") <- base_style

  .ttheme
}


#' @export
#' @rdname ggtexttable
colnames_style <- function(color = "black", face = "bold", size = 12,
                           fill = "grey80", linewidth = 1, linecolor = "white",
                           parse = FALSE, ...) {
  list(
    fg_params = list(
      parse = parse, col = color,
      fontface = face, fontsize = size
    ) %>%
      .add_item(...), # Accept extra parameters
    bg_params = list(fill = fill, lwd = linewidth, col = linecolor)
  )
}

#' @export
#' @rdname ggtexttable
rownames_style <- function(color = "black", face = "italic", size = 12,
                           fill = NA, linewidth = 1, linecolor = "white",
                           parse = FALSE, ...) {
  list(
    fg_params = list(
      parse = parse, col = color,
      fontface = face, fontsize = size, hjust = 1, x = 0.95
    ) %>%
      .add_item(...), # Accept extra parameters
    bg_params = list(fill = fill, lwd = linewidth, col = linecolor)
  )
}


#' @export
#' @rdname ggtexttable
tbody_style <- function(color = "black", face = "plain", size = 12,
                        fill = c("grey95", "grey90"),
                        linewidth = 1, linecolor = "white",
                        parse = FALSE, ...) {
  list(
    fg_params = list(
      parse = parse, col = color,
      fontface = face, fontsize = size
    ) %>%
      .add_item(...), # Accept extra parameters
    bg_params = list(fill = fill, lwd = linewidth, col = linecolor)
  )
}


#' @export
#' @rdname ggtexttable
#' @param tab an object from \code{ggtexttable} or from \code{gridExtra::tableGrob()}.
#' @param row,column an integer specifying the row and the column numbers for the cell of interest.
table_cell_font <- function(tab, row, column, face = NULL, size = NULL, color = NULL) {
  tabGrob <- get_tablegrob(tab)
  cells <- expand.grid(row = row, column = column)
  for (i in seq_len(nrow(cells))) {
    # Match the body cells ("core-fg") as well as the header row ("colhead-fg"),
    # so an individual header cell can be styled (row 1), not only body cells (#535).
    tc <- .find_cell(tabGrob, cells$row[i], cells$column[i], c("core-fg", "colhead-fg"))
    tabGrob$grobs[tc][[1]][["gp"]] <- grid::gpar(fontface = face, fontsize = size, col = color)
  }
  tab_return_same_class_as_input(tabGrob, input = tab)
}

#' @export
#' @rdname ggtexttable
table_cell_bg <- function(tab, row, column, fill = NULL, color = NULL, linewidth = NULL, alpha = NULL) {
  tabGrob <- get_tablegrob(tab)
  cells <- expand.grid(row = row, column = column)
  for (i in seq_len(nrow(cells))) {
    # Match body ("core-bg") and header ("colhead-bg") backgrounds, so a single
    # header cell background can be changed too (#535).
    tc <- .find_cell(tabGrob, cells$row[i], cells$column[i], c("core-bg", "colhead-bg"))
    tabGrob$grobs[tc][[1]][["gp"]] <- grid::gpar(
      fill = fill, col = color, lwd = linewidth, alpha = alpha
    )
  }
  tab_return_same_class_as_input(tabGrob, input = tab)
}

.find_cell <- function(tab, row, column, name = "core-fg") {
  l <- tab$layout
  which(l$t == row & l$l == column & l$name %in% name)
}

#' @export
#' @rdname ggtexttable
#' @param reduce.size.by Numeric value in [0, 1] to reduce the size by.
tab_cell_crossout <- function(tab, row, column, linetype = 1, linewidth = 1, linecolor = "black", reduce.size.by = 0) {
  required_package("gtable")
  tabgrob <- get_tablegrob(tab)
  crosses <- replicate(
    n = length(row),
    tab_cross(linetype = linetype, linewidth = linewidth, linecolor = linecolor, reduce.size.by = reduce.size.by),
    simplify = FALSE
  )
  tabgrob <- gtable::gtable_add_grob(
    tabgrob,
    grobs = crosses,
    t = row, b = row,
    l = column, r = column
  )
  tab_return_same_class_as_input(tabgrob, input = tab)
}

tab_cross <- function(linetype = 1, linewidth = 1, linecolor = "black", reduce.size.by = 0) {
  reduce <- reduce.size.by / 2
  grid::grobTree(
    grid::segmentsGrob( # diagonal line ul -> lr
      x0 = unit(0 + reduce, "npc"),
      y0 = unit(1 - reduce, "npc"),
      x1 = unit(1 - reduce, "npc"),
      y1 = unit(0 + reduce, "npc"),
      gp = grid::gpar(lty = linetype, lwd = linewidth, col = linecolor, reduce = reduce)
    ),
    grid::segmentsGrob( # diagonal line ll -> ur
      x0 = unit(0 + reduce, "npc"),
      y0 = unit(0 + reduce, "npc"),
      x1 = unit(1 - reduce, "npc"),
      y1 = unit(1 - reduce, "npc"),
      gp = grid::gpar(lty = linetype, lwd = linewidth, col = linecolor)
    )
  )
}


#' @export
#' @rdname  ggtexttable
tab_ncol <- function(tab) {
  ncol(get_tablegrob(tab))
}

#' @export
#' @rdname  ggtexttable
tab_nrow <- function(tab) {
  nrow(get_tablegrob(tab))
}

#' @export
#' @rdname ggtexttable
tab_add_hline <- function(tab, at.row = 2:tab_nrow(tab), row.side = c("bottom", "top"),
                          from.column = 1, to.column = tab_ncol(tab),
                          linetype = 1, linewidth = 1, linecolor = "black") {
  required_package("gtable")
  row.side <- match.arg(row.side)
  tabgrob <- get_tablegrob(tab)
  separators <- replicate(
    n = length(at.row),
    tab_hline(row.side = row.side, linetype = linetype, linewidth = linewidth, linecolor = linecolor),
    simplify = FALSE
  )
  tabgrob <- gtable::gtable_add_grob(
    tabgrob,
    grobs = separators,
    t = at.row, b = at.row,
    l = from.column, r = to.column
  )
  tab_return_same_class_as_input(tabgrob, input = tab)
}

# Create hline at the top or the bottom side of a given row
tab_hline <- function(row.side = c("bottom", "top"), linetype = 1, linewidth = 1, linecolor = "black") {
  row.side <- match.arg(row.side)
  y0 <- y1 <- unit(0, "npc")
  if (row.side == "top") y0 <- y1 <- unit(1, "npc")
  grid::segmentsGrob(
    x0 = unit(0, "npc"), x1 = unit(1, "npc"),
    y0 = y0, y1 = y1,
    gp = grid::gpar(lty = linetype, lwd = linewidth, col = linecolor)
  )
}


#' @export
#' @rdname ggtexttable
tab_add_vline <- function(tab, at.column = 2:tab_ncol(tab), column.side = c("left", "right"),
                          from.row = 1, to.row = tab_nrow(tab),
                          linetype = 1, linewidth = 1, linecolor = "black") {
  required_package("gtable")
  column.side <- match.arg(column.side)
  tabgrob <- get_tablegrob(tab)
  separators <- replicate(
    n = length(at.column),
    tab_vline(column.side = column.side, linetype = linetype, linewidth = linewidth, linecolor = linecolor),
    simplify = FALSE
  )
  tabgrob <- gtable::gtable_add_grob(
    tabgrob,
    grobs = separators,
    t = from.row, b = to.row,
    l = at.column, r = at.column
  )
  tab_return_same_class_as_input(tabgrob, input = tab)
}
# Create vline at the left or the right side of a given column
tab_vline <- function(column.side = c("left", "right"), linetype = 1, linewidth = 1, linecolor = "black") {
  column.side <- match.arg(column.side)
  x0 <- x1 <- unit(0, "npc")
  if (column.side == "right") x0 <- x1 <- unit(1, "npc")
  grid::segmentsGrob(
    x0 = x0, x1 = x1,
    y0 = unit(0, "npc"), y1 = unit(1, "npc"),
    gp = grid::gpar(lty = linetype, lwd = linewidth, col = linecolor)
  )
}

#' @export
#' @rdname ggtexttable
tab_add_border <- function(tab, from.row = 2, to.row = tab_nrow(tab),
                           from.column = 1, to.column = tab_ncol(tab),
                           linetype = 1, linewidth = 1, linecolor = "black") {
  required_package("gtable")
  tabgrob <- get_tablegrob(tab)
  border <- grid::rectGrob(
    gp = grid::gpar(fill = NA, lty = linetype, lwd = linewidth, col = linecolor)
  )
  tabgrob <- gtable::gtable_add_grob(
    tabgrob,
    grobs = border,
    t = from.row, b = to.row,
    l = from.column, r = to.column
  )
  tab_return_same_class_as_input(tabgrob, input = tab)
}

#' @export
#' @rdname ggtexttable
tbody_add_border <- function(tab, from.row = 2, to.row = tab_nrow(tab),
                             from.column = 1, to.column = tab_ncol(tab),
                             linetype = 1, linewidth = 1, linecolor = "black") {
  tab_add_border(
    tab,
    from.row = from.row, to.row = to.row,
    from.column = from.column, to.column = to.column,
    linetype = linetype, linewidth = linewidth, linecolor = linecolor
  )
}

#' @export
#' @rdname ggtexttable
thead_add_border <- function(tab, from.row = 1, to.row = 1,
                             from.column = 1, to.column = tab_ncol(tab),
                             linetype = 1, linewidth = 1, linecolor = "black") {
  tab_add_border(
    tab,
    from.row = from.row, to.row = to.row,
    from.column = from.column, to.column = to.column,
    linetype = linetype, linewidth = linewidth, linecolor = linecolor
  )
}

# Anchor x-position for a title/footnote text grob derived from `just`, so that
# `just` actually positions the text across the table width. Previously x was
# hardcoded, so "center"/"right" only aligned the text around a fixed left/right
# anchor and a centred title spilled off-canvas and clipped (#302). The `left`,
# `center` and `right` defaults keep each function's historical home position
# byte-identical (title left = 0.02, footnote right = 0.95).
.tab_text_x <- function(just, left = 0.02, center = 0.5, right = 0.98, home = left) {
  # A numeric or unrecognized `just` keeps the historical hardcoded anchor
  # (`home`), so those calls are unchanged; only the named string justifications
  # reposition the text.
  if (!is.character(just) || length(just) != 1) {
    return(home)
  }
  switch(just,
    "left" = left,
    "center" = center, "centre" = center, "middle" = center,
    "right" = right,
    home
  )
}

#' @export
#' @rdname ggtexttable
#' @param text text to be added as title or footnote.
tab_add_title <- function(tab, text, face = NULL, size = NULL, color = NULL,
                          family = NULL, padding = unit(1.5, "line"),
                          just = "left", hjust = NULL, vjust = NULL) {
  required_package("gtable")
  tabgrob <- get_tablegrob(tab)
  text <- grid::textGrob(
    text,
    x = .tab_text_x(just), just = just, hjust = hjust, vjust = vjust,
    gp = grid::gpar(fontsize = size, fontface = face, fontfamily = family, col = color)
  )
  # Add row at the top
  tabgrob <- gtable::gtable_add_rows(
    tabgrob,
    heights = grid::grobHeight(text) + padding,
    pos = 0
  )
  tabgrob <- gtable::gtable_add_grob(
    tabgrob, list(text),
    t = 1, b = 1, l = 1, r = ncol(tabgrob),
    # Don't clip the title to the (often narrow) table width, so a title wider
    # than the table is fully visible instead of being cut off (#302).
    clip = "off"
  )
  tab_return_same_class_as_input(tabgrob, input = tab)
}


#' @export
#' @rdname ggtexttable
#' @param text text to be added as title or footnote.
#' @param family font family
#' @param just The justification of the text relative to its (x, y) location. If
#'   there are two values, the first value specifies horizontal justification
#'   and the second value specifies vertical justification. Possible string
#'   values are: "left", "right", "centre", "center", "bottom", and "top". For
#'   numeric values, 0 means left (bottom) alignment and 1 means right (top)
#'   alignment.
#' @param hjust A numeric vector specifying horizontal justification. If
#'   specified, overrides the just setting.
#' @param vjust A numeric vector specifying vertical justification. If
#'   specified, overrides the just setting.
#'
tab_add_footnote <- function(tab, text, face = NULL, size = NULL, color = NULL,
                             family = NULL, padding = unit(1.5, "line"),
                             just = "right", hjust = NULL, vjust = NULL) {
  required_package("gtable")
  tabgrob <- get_tablegrob(tab)
  text <- grid::textGrob(
    text,
    x = .tab_text_x(just, right = 0.95, home = 0.95), just = just, hjust = hjust, vjust = vjust,
    gp = grid::gpar(fontsize = size, fontface = face, fontfamily = family, col = color)
  )
  # Add row at the bottom
  tabgrob <- gtable::gtable_add_rows(
    tabgrob,
    heights = grid::grobHeight(text) + padding,
    pos = -1
  )
  tabgrob <- gtable::gtable_add_grob(
    tabgrob, list(text),
    t = nrow(tabgrob), b = nrow(tabgrob), l = 1, r = ncol(tabgrob),
    # Don't clip a footnote wider than the table width (#302).
    clip = "off"
  )
  tab_return_same_class_as_input(tabgrob, input = tab)
}


# ::::::::::::::::::::::::::::::::::::::::
# Helper function
# ::::::::::::::::::::::::::::::::::::::::

is_ggtexttable <- function(tab) {
  !is.null(attr(tab, "ggtexttableGrob"))
}
is_tablegrob <- function(tab) {
  inherits(tab, "gtable") & inherits(tab, "grob")
}

# Transform a table grob in ggtexttable like object
as_ggtexttable <- function(tabgrob) {
  res <- as_ggplot(tabgrob)
  attr(res, "ggtexttableGrob") <- tabgrob
  res
}

# Extract tableGrob from ggtexttable()
get_tablegrob <- function(tab) {
  if (is_ggtexttable(tab)) {
    tabgrob <- attr(tab, "ggtexttableGrob")
  } else if (is_tablegrob(tab)) {
    tabgrob <- tab
  } else {
    stop("tab should be an object from either ggpubr::ggtexttable() or gridExtra::tableGrob().")
  }
  tabgrob
}

# Return the same class as the input data,
# which can be either ggtextable or a gridExtra::tableGrob
tab_return_same_class_as_input <- function(tabgrob, input) {
  if (is_ggtexttable(input)) {
    return(as_ggtexttable(tabgrob))
  } else if (is_tablegrob(input)) {
    return(tabgrob)
  }
  tabgrob
}


# Define table style
tstyle <- function(pal, size = 12) {
  allowed.palettes <- c(
    "default", "blank", "classic", "minimal", "light",
    "lBlack", "lBlue", "lRed", "lGreen", "lViolet", "lCyan", "lOrange",
    "lBlackWhite", "lBlueWhite", "lRedWhite", "lGreenWhite", "lVioletWhite", "lCyanWhite", "lOrangeWhite",
    "mBlack", "mBlue", "mRed", "mGreen", "mViolet", "mCyan", "mOrange",
    "mBlackWhite", "mBlueWhite", "mRedWhite", "mGreenWhite", "mVioletWhite", "mCyanWhite", "mOrangeWhite"
  )
  if (!(pal %in% allowed.palettes)) {
    stop(pal, " is not a supported palette")
  }

  style <- switch(pal,
    blank = list(
      colnames.style = colnames_style(fill = NA, linecolor = NA, size = size),
      rownames.style = rownames_style(fill = NA, linecolor = NA, size = size),
      tbody.style = tbody_style(fill = NA, linecolor = NA, size = size)
    ),
    classic = list(
      colnames.style = colnames_style(fill = NA, linecolor = "black", size = size),
      rownames.style = rownames_style(fill = NA, linecolor = NA, size = size),
      tbody.style = tbody_style(fill = NA, linecolor = "black", size = size)
    ),
    minimal = list(
      colnames.style = colnames_style(fill = NA, linecolor = NA, size = size),
      rownames.style = rownames_style(fill = NA, linecolor = NA, size = size),
      tbody.style = tbody_style(fill = NA, linecolor = NA, size = size)
    ),
    light = list(
      colnames.style = colnames_style(fill = NA, linecolor = NA, size = size),
      rownames.style = rownames_style(fill = NA, linecolor = NA, size = size),
      tbody.style = tbody_style(fill = NA, linecolor = NA, size = size)
    ),
    lBlack = list(
      colnames.style = colnames_style(
        color = "black", fill = "white", size = size,
        linecolor = NA, linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#D9D9D9", "white"),
        linecolor = NA, size = size
      )
    ),
    lBlue = list(
      colnames.style = colnames_style(
        color = "#2F5D94", fill = "white",
        linecolor = NA, linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "#2F5D94", fill = c("#DAE6F2", "white"),
        linecolor = NA, size = size
      )
    ),
    lRed = list(
      colnames.style = colnames_style(
        color = "#A3262A", fill = "white",
        linecolor = NA, linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "#A3262A", fill = c("#F7DBDA", "white"),
        linecolor = NA, size = size
      )
    ),
    lGreen = list(
      colnames.style = colnames_style(
        color = "#7F993A", fill = "white",
        linecolor = NA, linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "#7F993A", fill = c("#E8F3DE", "white"),
        linecolor = NA, size = size
      )
    ),
    lViolet = list(
      colnames.style = colnames_style(
        color = "#67417B", fill = "white",
        linecolor = NA, linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "#67417B", fill = c("#E6DEEC", "white"),
        linecolor = NA, size = size
      )
    ),
    lCyan = list(
      colnames.style = colnames_style(
        color = "#00889E", fill = "white",
        linecolor = NA, linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "#00889E", fill = c("#D5EFF4", "white"),
        linecolor = NA, size = size
      )
    ),
    lOrange = list(
      colnames.style = colnames_style(
        color = "#F15F00", fill = "white",
        linecolor = NA, linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "#F15F00", fill = c("#FBE5D4", "white"),
        linecolor = NA, size = size
      )
    ),
    lBlackWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "black", size = size,
        linecolor = "black", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = "white",
        linecolor = "black", size = size
      )
    ),
    lBlueWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#477DC0", size = size,
        linecolor = "#477DC0", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = "white",
        linecolor = "#477DC0", size = size
      )
    ),
    lRedWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#D04042", size = size,
        linecolor = "#D04042", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = "white",
        linecolor = "#D04042", size = size
      )
    ),
    lGreenWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#8CC257", size = size,
        linecolor = "#8CC257", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = "white",
        linecolor = "#8CC257", size = size
      )
    ),
    lVioletWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#895AA3", size = size,
        linecolor = "#895AA3", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = "white",
        linecolor = "#895AA3", size = size
      )
    ),
    lCyanWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#00AEC9", size = size,
        linecolor = "#00AEC9", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = "white",
        linecolor = "#00AEC9", size = size
      )
    ),
    lOrangeWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#FB8F2D", size = size,
        linecolor = "#FB8F2D", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = "white",
        linecolor = "#FB8F2D", size = size
      )
    ),
    mBlack = list(
      colnames.style = colnames_style(
        color = "white", fill = "black", size = size,
        linecolor = "white", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#A6A6A6", "#D9D9D9"),
        linecolor = "white", size = size
      )
    ),
    mBlue = list(
      colnames.style = colnames_style(
        color = "white", fill = "#477DC0",
        linecolor = "white", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#B5CBE5", "#DAE6F2"),
        linecolor = "white", size = size
      )
    ),
    mRed = list(
      colnames.style = colnames_style(
        color = "white", fill = "#D04042",
        linecolor = "white", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#EFB4B5", "#F7DBDA"),
        linecolor = "white", size = size
      )
    ),
    mGreen = list(
      colnames.style = colnames_style(
        color = "white", fill = "#8CC257",
        linecolor = "white", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#D3E8BB", "#E8F3DE"),
        linecolor = "white", size = size
      )
    ),
    mViolet = list(
      colnames.style = colnames_style(
        color = "white", fill = "#895AA3",
        linecolor = "white", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#D0BDDA", "#E6DEEC"),
        linecolor = "white", size = size
      )
    ),
    mCyan = list(
      colnames.style = colnames_style(
        color = "white", fill = "#00AEC9",
        linecolor = "white", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#ADDFEA", "#D5EFF4"),
        linecolor = "white", size = size
      )
    ),
    mOrange = list(
      colnames.style = colnames_style(
        color = "white", fill = "#EC8C2C",
        linecolor = "white", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#FDD2AF", "#FFE9D7"),
        linecolor = "white", size = size
      )
    ),
    mBlackWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "black", size = size,
        linecolor = "black", linewidth = 1
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#A6A6A6", "white"),
        linecolor = "black", size = size
      )
    ),
    mBlueWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#477DC0",
        linecolor = "#477DC0", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#B5CBE5", "white"),
        linecolor = "#477DC0", size = size
      )
    ),
    mRedWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#D04042",
        linecolor = "#D04042", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#EFB4B5", "white"),
        linecolor = "#D04042", size = size
      )
    ),
    mGreenWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#8CC257",
        linecolor = "#8CC257", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#D3E8BB", "white"),
        linecolor = "#8CC257", size = size
      )
    ),
    mVioletWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#895AA3",
        linecolor = "#895AA3", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#D0BDDA", "white"),
        linecolor = "#895AA3", size = size
      )
    ),
    mCyanWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#00AEC9",
        linecolor = "#00AEC9", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#ADDFEA", "white"),
        linecolor = "#00AEC9", size = size
      )
    ),
    mOrangeWhite = list(
      colnames.style = colnames_style(
        color = "white", fill = "#EC8C2C",
        linecolor = "#EC8C2C", linewidth = 1, size = size
      ),
      rownames.style = rownames_style(size = size),
      tbody.style = tbody_style(
        color = "black", fill = c("#FDD2AF", "white"),
        linecolor = "#EC8C2C", size = size
      )
    ),
    NULL
  )

  style
}
