#' @include utilities.R ggpar.R stat_chull.R stat_conf_ellipse.R
NULL
#' Text
#' @description Add text to a plot.
#' @inheritParams ggscatter
#' @param data a data frame
#' @param x,y x and y variables for drawing.
#' @param label the name of the column containing point labels. Can be also a
#'   character vector with length = nrow(data).
#' @param color text font color.
#' @param size text font size.
#' @param face text font style. Allowed values are one of c("plain", "bold",
#'   "italic", "bold.italic").
#' @param parse If \code{TRUE}, the labels will be parsed into expressions and
#'   displayed as described in \code{?plotmath}.
#' @param family character vector specifying font family.
#' @param show.legend logical. Should text be included in the legends? NA, the
#'   default, includes if any aesthetics are mapped. FALSE never includes, and
#'   TRUE always includes.
#' @param label.select can be of two formats: \itemize{ \item a character vector
#'   specifying some labels to show. \item a list containing one or the
#'   combination of the following components: \itemize{ \item \code{top.up} and
#'   \code{top.down}: to display the labels  of the top up/down points. For
#'   example, \code{label.select = list(top.up = 10, top.down = 4)}. \item
#'   \code{criteria}: to filter, for example, by x and y variables values, use
#'   this: \code{label.select = list(criteria = "`y` > 2 & `y` < 5 & `x` \%in\%
#'   c('A', 'B')")}. } }
#' @param repel a logical value, whether to use ggrepel to avoid overplotting
#'   text labels or not.
#' @param label.rectangle logical value. If TRUE, add rectangle underneath the
#'   text, making it easier to read.
#' @param grouping.vars grouping variables to sort the data by, when the user
#'   wants to display the top n up/down labels.
#' @param position Position adjustment, either as a string, or the result of a
#'   call to a position adjustment function.
#' @param ggp a ggplot. If not NULL, points are added to an existing plot.
#' @param ... other arguments to be passed to \code{\link{ggpar}}.
#' @details The plot can be easily customized using the function ggpar(). Read
#'   ?ggpar for changing: \itemize{ \item main title and axis labels: main,
#'   xlab, ylab \item axis limits: xlim, ylim (e.g.: ylim = c(0, 30)) \item axis
#'   scales: xscale, yscale (e.g.: yscale = "log2") \item color palettes:
#'   palette = "Dark2" or palette = c("gray", "blue", "red") \item legend title,
#'   labels and position: legend = "right"  }
#' @seealso \code{\link{ggpar}}
#' @examples
#' # Load data
#' data("mtcars")
#' df <- mtcars
#' df$cyl <- as.factor(df$cyl)
#' df$name <- rownames(df)
#' head(df[, c("wt", "mpg", "cyl")], 3)
#'
#' # Textual annotation
#' # +++++++++++++++++
#' ggtext(df,
#'   x = "wt", y = "mpg",
#'   color = "cyl", palette = c("#00AFBB", "#E7B800", "#FC4E07"),
#'   label = "name", repel = TRUE
#' )
#'
#' # Add rectangle around label
#' ggtext(df,
#'   x = "wt", y = "mpg",
#'   color = "cyl", palette = c("#00AFBB", "#E7B800", "#FC4E07"),
#'   label = "name", repel = TRUE, label.rectangle = TRUE
#' )
#'
#' @export
ggtext <- function(data, x = NULL, y = NULL, label = NULL,
                   color = "black", palette = NULL,
                   size = 11, face = "plain", family = "", show.legend = NA,
                   label.select = NULL, repel = FALSE, label.rectangle = FALSE,
                   parse = FALSE,
                   grouping.vars = NULL,
                   position = "identity",
                   ggp = NULL, ggtheme = theme_pubr(),
                   ...) {
  . <- NULL
  .dots <- list(...)
  data <- as.data.frame(data)
  if (length(label) > 1) {
    if (length(label) != nrow(data)) {
      stop(
        "The argument label should be a column name or a vector of length = nrow(data). ",
        "It seems that length(label) != nrow(data)"
      )
    } else {
      data$label.xx <- label
    }
    label <- "label.xx"
  }

  if (is.null(ggp)) {
    p <- ggplot(data, create_aes(list(x = x, y = y)))
  } else {
    p <- ggp
  }

  # Add textual annotation
  # ++++++
  alpha <- 1
  if (!is.null(list(...)$alpha)) alpha <- list(...)$alpha

  if (is.null(label)) {
    return(p)
  }

  lab_data <- data

  # Special case for density plot and histogram
  # y is calculated as ..count.. or ..density..
  # we should estimate label y from ggplot2 output
  .is_density_plot <- y[1] %in% c("..count..", "..density..")
  if (.is_density_plot) {
    lab_data <- .hist_label_data(p, grouping.vars = list(...)$facet.by, x = x)
    y <- "lab.y"

    # hist.data <- ggplot_build(p)$data[[1]][, c("x", "y", "count", "density")]
    # hist.x <- hist.data$x
    # hist.y <- hist.data$y
    # break.x <- c(0, hist.x) %>% unique()
    # label.break <- seq_len(length(break.x) - 1)
    # lab.y <- .select_vec(data, x) %>%
    #   cut(breaks = break.x, labels = label.break) %>%
    #   hist.y[.]
    # lab_data$lab.y <- lab.y
    # y <- "lab.y"
    # lab_data <- lab_data %>% dplyr::filter(!is.na(lab.y))
  }

  # Select some labels to show
  if (!is.null(label.select)) {
    lab_data <- .get_label_data(lab_data, x, y,
      label = label,
      label.select = label.select,
      grouping.vars = grouping.vars
    )
  }

  if (repel) {
    max.overlaps <- getOption("ggrepel.max.overlaps", default = Inf)
    ggfunc <- ggrepel::geom_text_repel
    if (label.rectangle) ggfunc <- ggrepel::geom_label_repel
    p <- p + geom_exec(ggfunc,
      data = lab_data, x = x, y = y,
      label = label, fontface = face,
      family = family, show.legend = show.legend,
      size = size / 3, color = color,
      alpha = alpha, parse = parse,
      box.padding = unit(0.35, "lines"),
      point.padding = unit(0.3, "lines"),
      force = 1, segment.size = 0.2, seed = 123,
      max.overlaps = max.overlaps
    )
  } else {
    ggfunc <- geom_text
    vjust <- -0.7
    hjust <- NULL
    if (label.rectangle) {
      ggfunc <- geom_label
      vjust <- -0.4
    }
    vjust <- ifelse(is.null(.dots$vjust), vjust, .dots$vjust)
    if (!is.null(.dots$hjust)) hjust <- .dots$hjust
    p <- p + geom_exec(ggfunc,
      data = lab_data, x = x, y = y, color = color,
      label = label, fontface = face, family = family, show.legend = show.legend,
      size = size / 3, color = color, parse = parse,
      vjust = vjust, hjust = hjust, alpha = alpha, position = position
    )
  }

  # p <- ggpar(p, palette = palette, ggtheme = ggtheme, ...)
  if (family != "") {
    p <- p + theme(text = element_text(family = family))
  }

  p
}


# data: data frame
# x, y: x and y variables
# label: label columns
# label.select: select some labels. Can be a character vector, or a list
#   with the following components (top.up, top.down)
# grouping.vars grouping variables
.get_label_data <- function(data, x, y, label = NULL,
                            label.select = NULL, grouping.vars = NULL) {
  if (.is_list(label.select)) {
    expected.components <- c("top.up", "top.down", "criteria")
    if (!any(expected.components %in% names(label.select))) {
      stop(
        "If label.select is a list, it should contain one or the combination ",
        "of the following element: ", .collapse(expected.components, sep = ", ")
      )
    }
  }

  data <- as.data.frame(data)

  if (is.null(label)) {
    lab_data <- NULL
  } else if (is.null(label.select)) {
    lab_data <- data
  } else if (.is_list(label.select)) {
    lab_data <- data
    top_up <- top_down <- . <- NULL

    if (!is.null(label.select$top.up)) {
      top_up <- .top_up(data, x, y,
        n = label.select$top.up,
        grouping.vars = grouping.vars
      )
    }

    if (!is.null(label.select$top.down)) {
      top_down <- .top_down(data, x, y,
        n = label.select$top.down,
        grouping.vars = grouping.vars
      )
    }

    if (!is.null(top_up) | !is.null(top_down)) {
      lab_data <- rbind(top_up, top_down)
    }

    if (!is.null(label.select$criteria)) {
      criteria <- gsub("`y`", y, label.select$criteria) %>%
        gsub("`x`", x, .)
      lab_data <- dplyr::filter(lab_data, !!rlang::parse_expr(criteria))
    }
  } else {
    lab_data <- subset(data, data[[label]] %in% label.select,
      drop = FALSE
    )
  }

  return(lab_data)
}


# Get histogram/density label y coord from ggplot output
# grouping.vars : facet variables
# x: x variable name
.hist_label_data <- function(p, grouping.vars = NULL, x = NULL) {
  . <- NULL
  # x <- .mapping(p) %>%.$x
  hist.data <- ggplot_build(p)$data[[1]]
  data <- p$data

  if (is.null(grouping.vars)) {
    return(.hist_label_y(hist.data, data, x))
  }


  data <- p$data %>%
    df_nest_by(vars = grouping.vars)

  hist.data <- hist.data %>%
    df_nest_by(vars = "PANEL") %>%
    .$data

  data <- data %>% mutate(hist.data = hist.data)
  lab.data <- purrr::map2(data$hist.data, data$data, .hist_label_y, x)

  data <- data %>%
    mutate(lab.data = lab.data) %>%
    df_select(vars = c("lab.data", grouping.vars)) %>%
    tidyr::unnest()

  data
}

# Get histogram/density label y coord from ggplot output
# hist.data: histogram data. ggplot_build(p)$data[[1]]
# data: data frame
# x: x variable name
.hist_label_y <- function(hist.data, data, x) {
  . <- NULL
  hist.x <- hist.data$x
  hist.y <- hist.data$y
  break.x <- c(0, hist.x) %>% unique()
  label.break <- seq_len(length(break.x) - 1)
  lab.y <- .select_vec(data, x) %>%
    cut(breaks = break.x, labels = label.break) %>%
    hist.y[.]

  data$lab.y <- lab.y
  data <- data %>% dplyr::filter(!is.na(lab.y))
  data
}
