Add legacy argument compatibility

R/1.getClusters.R

@@ -36,11 +36,16 @@
 #' @export
 #'
 getClusters <- function(obj = NULL, ...) {
+  dots <- list(...)
+  legacy_arg <- pop_legacy_arg(obj, dots, "exp", missing(obj))
+  obj <- legacy_arg$value
+  dots <- legacy_arg$dots
+
   # check datatype
   cls <- class(obj)
 
   if ("cell_data_set" %in% cls) {
-    extra_params <- list(cds_obj = obj, assays = "counts", ...)
+    extra_params <- c(list(cds_obj = obj, assays = "counts"), dots)
     exp <- do.call(pre_pseudotime_matrix, extra_params)
   } else if ("matrix" %in% cls | "data.frame" %in% cls) {
     exp <- obj

R/2.clusterData.R

@@ -105,6 +105,21 @@ clusterData <- function(obj = NULL,
                         clusterNum = NULL,
                         subcluster = NULL,
                         ...) {
+  dots <- list(...)
+  legacy_arg <- pop_legacy_arg(obj, dots, "exp", missing(obj))
+  obj <- legacy_arg$value
+  dots <- legacy_arg$dots
+
+  legacy_arg <- pop_legacy_arg(clusterMethod, dots, "cluster.method",
+                               missing(clusterMethod))
+  clusterMethod <- legacy_arg$value
+  dots <- legacy_arg$dots
+
+  legacy_arg <- pop_legacy_arg(clusterNum, dots, "cluster.num",
+                               missing(clusterNum))
+  clusterNum <- legacy_arg$value
+  dots <- legacy_arg$dots
+
   if (!requireNamespace("Biobase", quietly = TRUE)) {
     stop("Package 'Biobase' is required. Please install it.")
   }
@@ -114,7 +129,7 @@ clusterData <- function(obj = NULL,
   # pkg <- attr(cls,"package")
 
   if ("cell_data_set" %in% cls) {
-    extra_params <- list(cds_obj = obj, assays = "counts", ...)
+    extra_params <- c(list(cds_obj = obj, assays = "counts"), dots)
 
     exp <- do.call(pre_pseudotime_matrix, extra_params)
   } else if ("matrix" %in% cls | "data.frame" %in% cls) {

R/4.visCluster.R

@@ -232,6 +232,94 @@ visCluster <- function(object = NULL,
                        gglist = NULL,
                        rowAnnotationObj = NULL,
                        ...) {
+  dots <- list(...)
+  call_names <- names(match.call(expand.dots = FALSE))
+  showColumnNames <- NULL
+
+  legacy_args <- c(
+    "plot.type" = "plotType",
+    "line.size" = "lineSize",
+    "line.col" = "lineCol",
+    "add.mline" = "addMline",
+    "mline.size" = "mlineSize",
+    "mline.col" = "mlineCol",
+    "ct.anno.col" = "ctAnnoCol",
+    "set.md" = "setMd",
+    "textbox.pos" = "textboxPos",
+    "textbox.size" = "textboxSize",
+    "panel.arg" = "panelArg",
+    "ggplot.panel.arg" = "ggplotPanelArg",
+    "annoTerm.data" = "annoTermData",
+    "annoTerm.mside" = "annoTermMside",
+    "term.anno.arg" = "termAnnoArg",
+    "add.bar" = "addBar",
+    "bar.width" = "barWidth",
+    "textbar.pos" = "textbarPos",
+    "go.col" = "goCol",
+    "go.size" = "goSize",
+    "by.go" = "byGo",
+    "annoKegg.data" = "annoKeggData",
+    "annoKegg.mside" = "annoKeggMside",
+    "kegg.anno.arg" = "keggAnnoArg",
+    "add.kegg.bar" = "addKeggBar",
+    "kegg.col" = "keggCol",
+    "kegg.size" = "keggSize",
+    "by.kegg" = "byKegg",
+    "word.wrap" = "wordWrap",
+    "add.new.line" = "addNewLine",
+    "add.box" = "addBox",
+    "box.col" = "boxCol",
+    "box.arg" = "boxArg",
+    "add.point" = "addPoint",
+    "point.arg" = "pointArg",
+    "add.line" = "addLine",
+    "line.side" = "lineSide",
+    "markGenes.side" = "markGenesSide",
+    "genes.gp" = "genesGp",
+    "term.text.limit" = "termTextLimit",
+    "mul.group" = "mulGroup",
+    "lgd.label" = "lgdLabel",
+    "show.row.names" = "showRowNames",
+    "subgroup.anno" = "subgroupAnno",
+    "annnoblock.text" = "annnoblockText",
+    "annnoblock.gp" = "annnoblockGp",
+    "add.sampleanno" = "addSampleAnno",
+    "sample.group" = "sampleGroup",
+    "sample.col" = "sampleCol",
+    "sample.order" = "sampleOrder",
+    "cluster.order" = "clusterOrder",
+    "sample.cell.order" = "sampleCellOrder",
+    "column.split" = "columnSplit",
+    "cluster.columns" = "clusterColumns",
+    "pseudotime.col" = "pseudotimeCol",
+    "row.annotation.obj" = "rowAnnotationObj"
+  )
+
+  if ("show_column_names" %in% names(dots)) {
+    showColumnNames <- dots[["show_column_names"]]
+    dots[["show_column_names"]] <- NULL
+  }
+
+  if ("show_row_names" %in% names(dots)) {
+    if (!("showRowNames" %in% call_names)) {
+      showRowNames <- dots[["show_row_names"]]
+    }
+    dots[["show_row_names"]] <- NULL
+  }
+
+  for (legacy_name in names(legacy_args)) {
+    if (!(legacy_name %in% names(dots))) {
+      next
+    }
+
+    current_name <- legacy_args[[legacy_name]]
+    if (!(current_name %in% call_names)) {
+      assign(current_name, dots[[legacy_name]])
+    }
+
+    dots[[legacy_name]] <- NULL
+  }
+
   if (!requireNamespace("ComplexHeatmap", quietly = TRUE)) {
     stop("Package 'ComplexHeatmap' is required. Please install it.")
   }
@@ -681,6 +769,10 @@ visCluster <- function(object = NULL,
       show_column_names <- TRUE
     }
 
+    if (!is.null(showColumnNames)) {
+      show_column_names <- showColumnNames
+    }
+
     # legend for monocle heatmap
     if (object$geneType == "non-branched") {
       rg <- range(as.numeric(as.character(sample.info)))
@@ -720,26 +812,30 @@ visCluster <- function(object = NULL,
       }
 
       # draw HT
-      htf <-
-        ComplexHeatmap::Heatmap(
-          as.matrix(mat),
-          name = "Z-score",
-          cluster_columns = clusterColumns,
-          show_row_names = showRowNames,
-          border = border,
-          column_split = column_split,
-          row_split = subgroup,
-          cluster_row_slices = cluster_row_slices,
-          column_names_side = "top",
-          show_column_names = show_column_names,
-          # border = TRUE,
-          top_annotation = topanno,
-          left_annotation = left_annotation_ht,
-          right_annotation = right_annotation,
-          col = col_fun,
-          use_raster = use_raster,
-          ...
+      htf <- do.call(
+        ComplexHeatmap::Heatmap,
+        c(
+          list(
+            matrix = as.matrix(mat),
+            name = "Z-score",
+            cluster_columns = clusterColumns,
+            show_row_names = showRowNames,
+            border = border,
+            column_split = column_split,
+            row_split = subgroup,
+            cluster_row_slices = cluster_row_slices,
+            column_names_side = "top",
+            show_column_names = show_column_names,
+            # border = TRUE,
+            top_annotation = topanno,
+            left_annotation = left_annotation_ht,
+            right_annotation = right_annotation,
+            col = col_fun,
+            use_raster = use_raster
+          ),
+          dots
         )
+      )
 
       # draw
       ComplexHeatmap::draw(htf,
@@ -974,7 +1070,7 @@ visCluster <- function(object = NULL,
           text,
           x = textboxPos[1],
           y = textboxPos[2],
-          gp = grid::gpar(fontsize = textboxSize, fontface = "italic", ...)
+          gp = grid::gpar(fontsize = textboxSize, fontface = "italic")
         )
 
         grid::popViewport()
@@ -1526,24 +1622,33 @@ visCluster <- function(object = NULL,
         show_column_names <- TRUE
       }
 
+      if (!is.null(showColumnNames)) {
+        show_column_names <- showColumnNames
+      }
+
       # pdf('test.pdf',height = 10,width = 10)
-      htf <- ComplexHeatmap::Heatmap(
-        as.matrix(mat),
-        name = "Z-score",
-        cluster_columns = clusterColumns,
-        show_row_names = showRowNames,
-        border = border,
-        column_split = column_split,
-        top_annotation = topanno,
-        right_annotation = right_annotation2,
-        left_annotation = left_annotation,
-        column_names_side = "top",
-        show_column_names = show_column_names,
-        row_split = subgroup,
-        cluster_row_slices = cluster_row_slices,
-        col = col_fun,
-        use_raster = use_raster,
-        ...
+      htf <- do.call(
+        ComplexHeatmap::Heatmap,
+        c(
+          list(
+            matrix = as.matrix(mat),
+            name = "Z-score",
+            cluster_columns = clusterColumns,
+            show_row_names = showRowNames,
+            border = border,
+            column_split = column_split,
+            top_annotation = topanno,
+            right_annotation = right_annotation2,
+            left_annotation = left_annotation,
+            column_names_side = "top",
+            show_column_names = show_column_names,
+            row_split = subgroup,
+            cluster_row_slices = cluster_row_slices,
+            col = col_fun,
+            use_raster = use_raster
+          ),
+          dots
+        )
       )
 
       # draw lines legend

R/compatibility.R

@@ -0,0 +1,11 @@
+pop_legacy_arg <- function(value, dots, legacy, current_missing) {
+  if (legacy %in% names(dots)) {
+    if (current_missing) {
+      value <- dots[[legacy]]
+    }
+
+    dots[[legacy]] <- NULL
+  }
+
+  list(value = value, dots = dots)
+}

tests/testthat/test-clusterData.R

@@ -20,4 +20,11 @@ test_that("clusterData works", {
       clusterMethod = "kmeans",
       clusterNum = 8)
   )
+
+  expect_no_error(
+    clusterData(
+      exp = exps,
+      cluster.method = "kmeans",
+      cluster.num = 8)
+  )
 })

tests/testthat/test-getClusters.R

@@ -12,4 +12,8 @@ test_that("getClusters works", {
   expect_no_error(
     getClusters(obj = exps)
   )
+
+  expect_no_error(
+    getClusters(exp = exps)
+  )
 })

tests/testthat/test-visCluster.R

@@ -24,6 +24,11 @@ test_that("visCluster works", {
                plotType = "line")
   )
 
+  expect_no_error(
+    visCluster(object = ck,
+               plot.type = "line")
+  )
+
   p2 <- visCluster(object = ck,
                    plotType = "heatmap")
 
@@ -33,4 +38,13 @@ test_that("visCluster works", {
     visCluster(object = ck,
                plotType = "heatmap")
   )
+
+  expect_no_error(
+    visCluster(object = ck,
+               plot.type = "heatmap",
+               column_names_rot = 45,
+               markGenes.side = "left",
+               cluster.order = c(1:8),
+               show_column_names = FALSE)
+  )
 })