resovle R CMD test warnings

Author: zhanchen

R/print_methods.R

@@ -53,7 +53,7 @@
 #' @importFrom SummarizedExperiment assayNames assays rowData assays<- rowRanges
 #' @importFrom stats setNames
 #' @importFrom S4Vectors coolcat
-#' @importFrom purrr when map_chr keep
+#' @importFrom purrr map_chr keep
 #' @importFrom stringr str_replace
 #' @importFrom magrittr `%>%`
 #' @importFrom dplyr if_else mutate across
@@ -137,14 +137,15 @@ but they do not completely overlap.")
       # Reorder assays before printing
       x <- order_assays_internally_to_be_consistent(x)
 
-      my_tibble <- x |>
-        # If more than 30 genes, select first sample
-        when(
-          nrow(.) > 30 ~.[1:min(50, nrow(x)), min(1, ncol(x)), drop=FALSE] ,
-          ncol(.) == 0 ~ .,
-          ~ .[, 1:min(20, ncol(x)), drop=FALSE]
-        ) %>%
-        as_tibble()
+      tmp_x <- x
+      if (nrow(tmp_x) > 30) {
+        tmp_x <- tmp_x[1:min(50, nrow(x)), min(1, ncol(x)), drop = FALSE]
+      } else if (ncol(tmp_x) == 0) {
+        tmp_x <- tmp_x
+      } else {
+        tmp_x <- tmp_x[, 1:min(20, ncol(x)), drop = FALSE]
+      }
+      my_tibble <- tmp_x %>% as_tibble()
 
       my_tibble |>
         vctrs::new_data_frame(class=c("tidySummarizedExperiment", "tbl")) %>%

R/tibble_methods.R

@@ -33,12 +33,14 @@ as_tibble.SummarizedExperiment <- function(x, ...,
     setNames(c(s_(x)$name, colnames(colData(x))))
 
   range_info <-
-    skip_GRanges %>%
-    when(
-      (.) ~ tibble() %>% list,
-      ~  get_special_datasets(x)
-    ) %>%
-    reduce(left_join, by="coordinate")
+    {
+      if (isTRUE(skip_GRanges)) {
+        list(tibble())
+      } else {
+        get_special_datasets(x)
+      }
+    } %>%
+    reduce(left_join, by = "coordinate")
 
   gene_info <-
     rowData(x) %>%
@@ -59,9 +61,13 @@ as_tibble.SummarizedExperiment <- function(x, ...,
     count_info %>%
     full_join(sample_info, by=s_(x)$name) %>%
     full_join(gene_info, by=f_(x)$name) %>%
-    when(nrow(range_info) > 0 ~
-           (.) %>% left_join(range_info) %>% suppressMessages(),
-         ~ (.))
+    {
+      if (nrow(range_info) > 0) {
+        suppressMessages(left_join(., range_info))
+      } else {
+        .
+      }
+    }
 
   # This function outputs a tibble after subsetting the columns
   else subset_tibble_output(x, count_info, sample_info,

R/tidyse_utils.R

@@ -274,42 +274,26 @@ get_special_datasets <- function(se) {
     rowRanges()
 
   rr %>%
-    when(
-
-      # If no ranges
-      as.data.frame(.) %>%
-        nrow() %>%
-        magrittr::equals(0) ~ tibble(),
-
-      # If it is a range list (multiple rows per feature)
-      is(., "CompressedGRangesList") ~ {
-
-        # If GRanges does not have row names
+    {
+      if (nrow(as.data.frame(.)) == 0) {
+        tibble()
+      } else if (is(., "CompressedGRangesList")) {
         if (is.null(rr@partitioning@NAMES)) {
           rr@partitioning@NAMES <- as.character(1:nrow(se))
         }
-
         tibble::as_tibble(rr) %>%
           eliminate_GRanges_metadata_columns_also_present_in_Rowdata(se) %>%
           nest(GRangesList = -group_name) %>%
           dplyr::rename(!!f_(se)$symbol := group_name)
-
-      },
-
-      # If standard GRanges (one feature per line)
-      ~ {
-
-        # If GRanges does not have row names
+      } else {
         if (is.null(rr@ranges@NAMES)) {
           rr@ranges@NAMES <- as.character(1:nrow(se))
         }
-
         tibble::as_tibble(rr) %>%
           eliminate_GRanges_metadata_columns_also_present_in_Rowdata(se) %>%
           mutate(!!f_(se)$symbol := rr@ranges@NAMES)
       }
-
-    ) %>%
+    } %>%
     list()
 }
 
@@ -388,13 +372,13 @@ get_count_datasets <- function(se) {
           # In case I have a sparse matrix
           as.matrix() |>
           tibble::as_tibble(rownames = f_(se)$name, .name_repair = "minimal") %>%
-
-          # If the matrix does not have sample names, fix column names
-          when(colnames(.x) %>% is.null() & is.null(colnames(se)) ~ setNames(., c(
-            f_(se)$name,  seq_len(ncol(.x))
-          )),
-          ~ (.)
-          )
+          {
+            if (is.null(colnames(.x)) && is.null(colnames(se))) {
+              setNames(., c(f_(se)$name, seq_len(ncol(.x))))
+            } else {
+              .
+            }
+          }
 
         # Avoid dug if SE if completely empty, no rows, no columns
         if(.x |> select(-!!f_(se)$symbol) |> ncol() == 0) return(.x)
@@ -408,11 +392,15 @@ get_count_datasets <- function(se) {
 
     # Add dummy sample or feature if we have empty assay.
     # This is needed for a correct visualisation of the tibble form
-    map(~when(
-      f_(se)$name %in% colnames(.x) %>% not ~ mutate(.x, !!f_(se)$symbol := as.character(NA)),
-      s_(se)$name %in% colnames(.x) %>% not ~ mutate(.x, !!s_(se)$symbol := as.character(NA)),
-      ~ .x
-    ))
+    map(~{
+      if (!(f_(se)$name %in% colnames(.x))) {
+        mutate(.x, !!f_(se)$symbol := as.character(NA))
+      } else if (!(s_(se)$name %in% colnames(.x))) {
+        mutate(.x, !!s_(se)$symbol := as.character(NA))
+      } else {
+        .x
+      }
+    })
 
   # If assays is non empty
   if(list_assays |> length() > 0)

tests/testthat/test-header-formatting.R

@@ -4,7 +4,6 @@ library(stringr)
 library(dplyr)
 library(tidyprint)
 
-context("format_covariate_header")
 
 separator_row <- c(
   ".feature" = "               ",