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)]
             )
         }
     }