gganno and ggheat: initialized data accepts row and column names

R/gganno.R

@@ -11,22 +11,25 @@
 #' @section ggfn:
 #'
 #' `ggfn` accept a ggplot2 object with a default data and mapping created by
-#' `ggplot(data, aes(.data$.x))` / `ggplot(data, ggplot2::aes(y = .data$.y))`.
-#' The original matrix will be converted into a data.frame with another 3
-#' columns added:
+#' `ggplot(data, aes(.data$x))` / `ggplot(data, ggplot2::aes(y = .data$y))`.
+#' The original matrix will be converted into a long-data.frame (`gganno` always
+#' regard row as the observations) with following columns:
 #' - `.slice`: the slice row (which = "row") or column (which = "column")
 #' number.
-#' - `.x`/`.y`: indicating the x-axis (or y-axis) coordinates. Don't use
+#' - `.row_names` and `.column_names`: the row and column names of the original
+#' matrix (only applicable when names exist).
+#' - `.row_index` and `.column_index`: the row and column index of the original
+#' matrix.
+#' - `x` / `y`: indicating the x-axis (or y-axis) coordinates. Don't use
 #' [coord_flip][ggplot2::coord_flip] to flip coordinates as it may disrupt
 #' internal operations.
-#' - `.index`: denoting the row index of the original matrix, where rows are
-#' uniformly considered as observations and columns as variables.
+#' - `value`: the actual matrix value of the annotation matrix.
 #'
 #' @inherit ggheat
 #' @seealso [eanno]
 #' @examples
 #' draw(gganno(function(p) {
-#' p + geom_point(aes(y = V1))
+#' p + geom_point(aes(y = value))
 #' }, matrix = rnorm(10L), height = unit(10, "cm"), width = unit(0.7, "npc")))
 #' @return A `ggAnno` object.
 #' @export
@@ -71,38 +74,56 @@ eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) {
  column = heatmap@column_order_list
  )
  }
- data <- as_tibble0(matrix, rownames = NULL) # nolint
  if (length(order_list) > 1L) {
  with_slice <- TRUE
  } else {
  with_slice <- FALSE
  }
+ row_nms <- rownames(matrix)
+ col_nms <- colnames(matrix)
+ data <- as_tibble0(matrix, rownames = NULL) # nolint
+ colnames(data) <- seq_len(ncol(data))
+ data$.row_index <- seq_len(nrow(data))
+ data <- tidyr::pivot_longer(data,
+ cols = !".row_index",
+ names_to = ".column_index",
+ values_to = "value"
+ )
+ data$.column_index <- as.integer(data$.column_index)
+ if (!is.null(row_nms)) data$.row_names <- row_nms[data$.row_index]
+ if (!is.null(col_nms)) data$.column_names <- col_nms[data$.column_index]
+
  coords <- data_frame0(
  .slice = rep(
  seq_along(order_list),
  times = lengths(order_list)
  ),
- .index = unlist(order_list, recursive = FALSE, use.names = FALSE),
- .x = seq_along(.data$.index)
+ .row_index = unlist(order_list, recursive = FALSE, use.names = FALSE),
+ x = seq_along(.data$.row_index)
+ )
+ data <- merge(coords, data, by = ".row_index", all = FALSE)
+ nms <- c(
+ ".slice", ".row_names", ".column_names",
+ ".row_index", ".column_index", "x", "y", "value"
  )
- data <- cbind(coords, data[match(coords$.index, seq_len(nrow(data))), ])
  if (which == "row") {
- data <- rename(data, c(.x = ".y"))
+ data <- rename(data, c(x = "y"))
  if (with_slice) {
  data <- lapply(split(data, data$.slice), function(subdata) {
- subdata$.y <- reverse_trans(subdata$.y)
+ subdata$y <- reverse_trans(subdata$y)
  subdata
  })
  data <- do.call(rbind, data)
  data <- as_tibble0(data, rownames = NULL)
  } else {
- data$.y <- reverse_trans(data$.y)
+ data$y <- reverse_trans(data$y)
  }
- p <- ggplot(data, aes(y = .data$.y))
+ p <- ggplot(data[intersect(nms, names(data))], aes(y = .data$y))
  } else {
- p <- ggplot(data, aes(x = .data$.x))
+ p <- ggplot(data[intersect(nms, names(data))], aes(x = .data$x))
  }
  p <- rlang::inject(object@fun(p, !!!object@dots))
+ object@dots <- list() # remove dots
  if (!ggplot2::is.ggplot(p)) {
  cli::cli_abort(
  sprintf("%s must return a {.cls ggplot2} object.", fn_id)
@@ -117,7 +138,7 @@ eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) {
  ))
  }
  # prepare scales --------------------------------------
- labels <- rownames(matrix) %||% ggplot2::waiver()
+ labels <- row_nms %||% ggplot2::waiver()
  if (which == "row") {
  facet_params <- list(
  rows = ggplot2::vars(.data$.slice),
@@ -198,7 +219,6 @@ eheat_prepare.ggAnno <- function(object, ..., viewport, heatmap, name) {
  elements = c("axis", "lab")
  )
  }
- object@dots <- list()
  object@legends_panel <- get_guides(gt, margins = "i")
  object@legends_margin <- get_guides(gt)
  object

R/ggheat.R

@@ -19,14 +19,16 @@
 #' @section ggfn:
 #'
 #' `ggfn` accept a ggplot2 object with a default data and mapping created by
-#' `ggplot(data, aes(.data$.column, .data$.row))`.
-#' the data contains 7 columns:
+#' `ggplot(data, aes(.data$x, .data$y))`. the data contains following columns:
 #' - `.slice`: slice number, combine `.slice_row` and `.slice_column`.
 #' - `.slice_row`: the slice row number
 #' - `.slice_column`: the slice column number
-#' - `.row` and `.column`: the row and column coordinates
+#' - `.row_names` and `.column_names`: the row and column names of the original
+#' matrix (only applicable when names exist).
 #' - `.row_index` and `.column_index`: the row and column index of the original
 #' matrix.
+#' - `x` and `y`: the `x` and `y` coordinates
+#' - `value`: the actual matrix value for the heatmap matrix.
 #'
 #' @note Maintaining the internal limits along the heatmap to align well with
 #' `ComplexHeatmap` is important.
@@ -86,9 +88,11 @@ eheat_prepare.ggHeatmap <- function(object, ...) {
  data <- tidyr::pivot_longer(data,
  cols = !".row_index",
  names_to = ".column_index",
- values_to = "values"
+ values_to = "value"
  )
  data$.column_index <- as.integer(data$.column_index)
+ if (!is.null(row_nms)) data$.row_names <- row_nms[data$.row_index]
+ if (!is.null(col_nms)) data$.column_names <- col_nms[data$.column_index]
 
  # prepare slice panels data ------------------------
  slice_list <- eheat_full_slice_index(order_list)
@@ -99,7 +103,7 @@ eheat_prepare.ggHeatmap <- function(object, ...) {
  # reverse y-axis as ggplot2 and ComplexHeatmap draw in different
  # direction, but we cannot draw anything if we use `scale_y_reverse`, I
  # don't know why?. So we just reverse the values
- data$.row <- reverse_trans(data$.row)
+ data$y <- reverse_trans(data$y)
  data
  })
  coords <- do.call(rbind, coords)
@@ -109,15 +113,21 @@ eheat_prepare.ggHeatmap <- function(object, ...) {
  )
 
  # create the ggplot2 object --------------------
- p <- ggplot(data, aes(.data$.column, .data$.row))
+ nms <- c(
+ ".slice", ".slice_row", ".slice_column",
+ ".row_names", ".column_names",
+ ".row_index", ".column_index",
+ "x", "y", "value"
+ )
+ p <- ggplot(data[intersect(nms, names(data))], aes(.data$x, .data$y))
 
  # special case for rect_gp$type == "none" ------
  if (!identical(rect_gp$type, "none")) {
  # https://stackoverflow.com/questions/72402570/why-doesnt-gplot2labs-overwrite-update-the-name-argument-of-scales-function
  # ggplot2::labs has relative low priorities, so user can provide scale
  # name to overwrite the name
  p <- p + ggplot2::geom_tile(
- aes(.data$.column, .data$.row, fill = .data$values),
+ aes(.data$x, .data$y, fill = .data$value),
  width = 1L, height = 1L
  ) + ggplot2::labs(fill = object@name)
  }
@@ -150,17 +160,17 @@ eheat_prepare.ggHeatmap <- function(object, ...) {
  }
  p$scales <- p$scales$non_position_scales()
  }
-
  # prepare scales ------------------------------
  scales <- lapply(c("row", "column"), function(axis) {
  if (axis == "row") {
  fn <- ggplot2::scale_y_continuous
  labels <- row_nms
+ cols <- c(".slice_row", "y", ".row_index")
  } else {
  fn <- ggplot2::scale_x_continuous
  labels <- col_nms
+ cols <- c(".slice_column", "x", ".column_index")
  }
- cols <- sprintf(c(".slice_%s", ".%s", ".%s_index"), axis)
  # prepapre scales for each slice panel
  eheat_scales(coords[cols], labels, scale_fn = fn)
  })

R/utils-complexheatmap.R

@@ -124,8 +124,8 @@ eheat_full_slice_index <- function(order_list) {
  .slice_column = j,
  .row_index = row_order[expand_idx[[1L]]],
  .column_index = column_order[expand_idx[[2L]]],
- .row = row_full[as.character(.data$.row_index)],
- .column = column_full[as.character(.data$.column_index)]
+ x = column_full[as.character(.data$.column_index)],
+ y = row_full[as.character(.data$.row_index)]
  )
  }
  }