#' Balloon plot
#'
#' @description Plot a graphical matrix where each cell contains a dot whose
#'   size reflects the relative magnitude of the corresponding component. Useful
#'   to visualize contingency table formed by two categorical variables.
#'
#' @inheritParams ggpar
#' @param data a data frame. Can be: \itemize{ \item \bold{a standard
#'   contingency table} formed by two categorical variables: a data frame with
#'   row names and column names. The categories of the first variable are
#'   columns and the categories of the second variable are rows. \item \bold{a
#'   stretched contingency table}: a data frame containing at least three columns
#'   corresponding, respectively, to (1) the categories of the first variable,
#'   (2) the categories of the second variable, (3) the frequency value. In this
#'   case, you should specify the argument x and y in the function
#'   \code{ggballoonplot()}}.
#' @param x,y the column names specifying, respectively, the first and the
#'   second variable forming the contingency table. Required only when the data
#'   is a stretched contingency table.
#' @param color point border line color.
#' @param fill point fill color. Default is "lightgray". Considered only for
#'   points 21 to 25.
#' @param shape points shape. The default value is 21. Alternative values include
#'   22, 23, 24, 25.
#' @param size point size. By default, the points size reflects the relative
#'   magnitude of the value of the corresponding cell (\code{size = "value"}).
#'   Can be also numeric (\code{size = 4}).
#' @param size.range a numeric vector of length 2 that specifies the minimum and
#'   maximum size of the plotting symbol. Default values are \code{size.range =
#'   c(1, 10)}.
#' @param facet.by character vector, of length 1 or 2, specifying grouping variables for
#'   faceting the plot into multiple panels. Should be in the data.
#' @param show.label logical. If TRUE, show the data cell values as point
#'   labels.
#' @param font.label a vector of length 3 indicating respectively the size
#'   (e.g.: 14), the style (e.g.: "plain", "bold", "italic", "bold.italic") and
#'   the color (e.g.: "red") of point labels. For example font.label = c(14,
#'   "bold", "red"). To specify only the size and the style, use font.label =
#'   c(14, "plain").
#' @param rotate.x.text logical. If TRUE (default), rotate the x axis text.
#' @param ggtheme function, ggplot2 theme name. Default value is
#'   \code{theme_minimal()}. Set \code{ggtheme = NULL} to skip applying a ggpubr
#'   theme, so the plot keeps ggplot2 default theme or the theme set globally via
#'   \code{theme_set()}.
#' @param ... other arguments passed to the function \code{\link{ggpar}}
#'
#' @examples
#' # Define color palette
#' my_cols <- c(
#'   "#0D0887FF", "#6A00A8FF", "#B12A90FF",
#'   "#E16462FF", "#FCA636FF", "#F0F921FF"
#' )
#'
#' # Standard contingency table
#' # :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#' # Read a contingency table: housetasks
#' # Repartition of 13 housetasks in the couple
#' data <- read.delim(
#'   system.file("demo-data/housetasks.txt", package = "ggpubr"),
#'   row.names = 1
#' )
#' data
#'
#' # Basic ballon plot
#' ggballoonplot(data)
#'
#' # Change color and fill
#' ggballoonplot(data, color = "#0073C2FF", fill = "#0073C2FF")
#'
#'
#' # Change color according to the value of table cells
#' ggballoonplot(data, fill = "value") +
#'   scale_fill_gradientn(colors = my_cols)
#'
#' # Change the plotting symbol shape
#' ggballoonplot(data, fill = "value", shape = 23) +
#'   gradient_fill(c("blue", "white", "red"))
#'
#'
#' # Set points size to 8, but change fill color by values
#' # Sow labels
#' ggballoonplot(data,
#'   fill = "value", color = "lightgray",
#'   size = 10, show.label = TRUE
#' ) +
#'   gradient_fill(c("blue", "white", "red"))
#'
#' # Stretched contingency table
#' # :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#'
#' # Create an Example Data Frame Containing Car x Color data
#' carnames <- c("bmw", "renault", "mercedes", "seat")
#' carcolors <- c("red", "white", "silver", "green")
#' datavals <- round(rnorm(16, mean = 100, sd = 60), 1)
#' car_data <- data.frame(
#'   Car = rep(carnames, 4),
#'   Color = rep(carcolors, c(4, 4, 4, 4)),
#'   Value = datavals
#' )
#'
#' car_data
#'
#' ggballoonplot(car_data,
#'   x = "Car", y = "Color",
#'   size = "Value", fill = "Value"
#' ) +
#'   scale_fill_gradientn(colors = my_cols) +
#'   guides(size = "none")
#'
#'
#' # Grouped frequency table
#' # :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#' data("Titanic")
#' dframe <- as.data.frame(Titanic)
#' head(dframe)
#' ggballoonplot(
#'   dframe,
#'   x = "Class", y = "Sex",
#'   size = "Freq", fill = "Freq",
#'   facet.by = c("Survived", "Age"),
#'   ggtheme = theme_bw()
#' ) +
#'   scale_fill_gradientn(colors = my_cols)
#'
#' # Hair and Eye Color of Statistics Students
#' data(HairEyeColor)
#' ggballoonplot(as.data.frame(HairEyeColor),
#'   x = "Hair", y = "Eye", size = "Freq",
#'   ggtheme = theme_gray()
#' ) %>%
#'   facet("Sex")
#'
#' @export
ggballoonplot <- function(
  data, x = NULL, y = NULL, size = "value",
  facet.by = NULL, size.range = c(1, 10),
  shape = 21, color = "black", fill = "gray",
  show.label = FALSE, font.label = list(size = 12, color = "black"),
  rotate.x.text = TRUE,
  ggtheme = theme_minimal(), ...
) {
  if (inherits(data, "matrix")) {
    data <- as.data.frame(data)
  }

  # Check the data
  # ::::::::::::::::::::::::::::::::::::::::::::::::::::::


  # case 1: x and y specified. we assume that the data is stretched
  # if size not specified, then take the third column as size values
  # detect fill variable if misspecified
  if (!is.null(x) & !is.null(y)) {
    if (missing(size)) size <- colnames(data)[3]
    if (fill == "value" & !("value" %in% colnames(data))) {
      fill <- colnames(data)[3]
    }
    label <- colnames(data)[3]
  }


  # case 2: x and y are not specified
  # - check if the data is stretched:
  #     If yes, then consider the first 3 columns as x, y and size values
  #     If no, then stretch the data and continue
  else if (is.null(x) | is.null(y)) {
    if (.is_stretched(data)) {
      .cnames <- colnames(data)
      x <- .cnames[1]
      y <- .cnames[2]
      if (missing(size)) size <- .cnames[3]
      if (fill == "value" & !("value" %in% .cnames)) fill <- .cnames[3]
      label <- .cnames[3]
      # Reverse y levels so that it appears in the right order on the plot
      y.val <- dplyr::pull(data, 2)
      data[[2]] <- y.val %>% factor(levels = rev(.levels(y.val)))
    } else {
      data <- .df_stretch(data) # Stretch the data into 3 columns: .row|.col|.value
      x <- ".col"
      y <- ".row"
      if (missing(size)) size <- "value"
      label <- "value"
    }
  }

  p <- ggplot(data, create_aes(list(x = x, y = y))) +
    geom_exec(
      geom_point,
      data = data,
      size = size, fill = fill, shape = shape,
      color = color
    )

  p <- p +
    scale_size(range = size.range) +
    guides(size = guide_legend(reverse = TRUE)) +
    ggtheme
  # Blank the axis titles by default, but keep them when the user supplies
  # xlab/ylab (passed via ... to ggpar) so those labels are honored (#639).
  dots <- list(...)
  if (is.null(dots$xlab)) {
    p <- p + theme(axis.title.x = ggplot2::element_blank())
  }
  if (is.null(dots$ylab)) {
    p <- p + theme(axis.title.y = ggplot2::element_blank())
  }

  if (show.label) {
    font.label <- .check_lab_font(font.label)
    text.args <- font.label %>%
      .add_item(
        geomfunc = geom_text, data = data,
        x = x, y = y, label = label
      )
    p <- p + do.call(geom_exec, text.args)
  }

  if (rotate.x.text) {
    p <- p + rotate_x_text(45, hjust = 1, vjust = 1)
  }

  if (!is.null(facet.by)) {
    p <- facet(p, facet.by)
  }

  ggpar(p, ...)
}


# Font label
.check_lab_font <- function(font.label) {
  font.label <- .parse_font(font.label)
  font.label$size <- ifelse(is.null(font.label$size), 4, font.label$size / 3)
  font.label$color <- ifelse(is.null(font.label$color), "black", font.label$color)
  font.label$face <- ifelse(is.null(font.label$face), "plain", font.label$face)
  font.label
}


# Stretch a data frame with row names
# returns a data frame with 3 columns .row, .col, value
.df_stretch <- function(data) {
  .col.names <- colnames(data)
  .row.names <- rownames(data)
  data <- data %>%
    dplyr::mutate(.row = .row.names) %>%
    dplyr::select(.row, dplyr::everything())

  # Stretch the data into three columns
  .col <- .row <- NULL
  data <- data %>%
    tidyr::pivot_longer(
      cols = -".row",
      names_to = ".col",
      values_to = "value"
    ) %>%
    dplyr::mutate(
      .col = factor(.col, levels = .col.names),
      .row = factor(.row, levels = rev(.row.names))
    )
  data
}


# Check if the contingency table is in the stretched format
.is_stretched <- function(data, x = NULL, y = NULL) {
  stretched <- TRUE
  if (is.null(x) | is.null(y)) {
    if (.is_numeric_data(data)) {
      stretched <- FALSE
    } else {
      x <- dplyr::pull(data, 1)
      y <- dplyr::pull(data, 2)
      z <- dplyr::pull(data, 3)
      stretched <- (
        (is.character(x) | is.factor(x)) &
          (is.character(y) | is.factor(y)) &
          is.numeric(z)
      )
    }
  }

  stretched
}

# Check if a data matrix is numeric
.is_numeric_data <- function(x) {
  all(apply(x, 2, is.numeric))
}

# For tibble data. The first column should be row names
.is_correct_tbl <- function(x) {
  ok <- FALSE
  if (inherits(x, "tbl_df")) ok <- TRUE

  if (ok) {
    .rows <- dplyr::pull(x, 1)
    ok <- is.character(.rows) & .is_numeric_data(x[, -1])
  }

  ok
}
