Merge pull request #94 from mikelove/master

Adding `mutate_features` and `mutate_samples`

Author: stemangiola

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: tidySummarizedExperiment
 Title: Brings SummarizedExperiment to the Tidyverse 
-Version: 1.15.0
+Version: 1.15.1
 Authors@R: c(person("Stefano", "Mangiola", email = "mangiolastefano@gmail.com",
                   role = c("aut", "cre")) )
 Description: The tidySummarizedExperiment package provides a set of tools for creating and
@@ -54,7 +54,7 @@ Biarch: true
 biocViews: AssayDomain, Infrastructure, RNASeq, DifferentialExpression, GeneExpression, Normalization, Clustering, QualityControl, Sequencing, Transcription, Transcriptomics
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 LazyDataCompression: xz
 URL: https://github.com/stemangiola/tidySummarizedExperiment

NAMESPACE

@@ -38,6 +38,8 @@ S3method(tidy,SummarizedExperiment)
 S3method(unite,SummarizedExperiment)
 S3method(unnest,tidySummarizedExperiment_nested)
 export("%>%")
+export(mutate_features)
+export(mutate_samples)
 export(tidy)
 export(unnest_summarized_experiment)
 importFrom(S4Vectors,"metadata<-")

R/dplyr_methods.R

@@ -350,23 +350,23 @@ mutate.SummarizedExperiment <- function(.data, ...) {
         .data <- ping_old_special_column_into_metadata(.data)
     }
 
-    secial_columns <- get_special_columns(
+    special_columns <- get_special_columns(
         # Decrease the size of the dataset
         .data[1:min(100, nrow(.data)), 1:min(20, ncol(.data))]
     ) |> c(get_needed_columns(.data))
 
     tst <-
         intersect(
             cols,
-            secial_columns
+            special_columns
         ) |> 
         length() |>
         gt(0)
 
 
     if (tst) {
         columns <-
-            secial_columns |>
+            special_columns |>
                 paste(collapse=", ")
         stop(
             "tidySummarizedExperiment says:",
@@ -390,6 +390,46 @@ mutate.SummarizedExperiment <- function(.data, ...) {
         update_SE_from_tibble(.data)
 }
 
+#' Mutate features
+#'
+#' Allows mutate call on features (rowData)
+#' of a SummarizedExperiment
+#'
+#' @param .data a SummarizedExperiment
+#' @param ... extra arguments passed to dplyr::mutate
+#'
+#' @return a SummarizedExperiment with modified rowData
+#' 
+#' @export
+mutate_features <- function(.data, ...) {
+  feature_info <- rowData(.data) |>
+    tibble::as_tibble() |>
+    dplyr::mutate(...) |>
+    as("DataFrame")
+  rowData(.data) <- feature_info
+  return(.data)
+}
+
+#' Mutate samples
+#'
+#' Allows mutate call on samples (colData)
+#' of a SummarizedExperiment
+#'
+#' @param .data a SummarizedExperiment
+#' @param ... extra arguments passed to dplyr::mutate
+#'
+#' @return a SummarizedExperiment with modified colData
+#'
+#' @export
+mutate_samples <- function(.data, ...) {
+  sample_info <- colData(.data) |>
+    tibble::as_tibble() |>
+    dplyr::mutate(...) |>
+    as("DataFrame")
+  colData(.data) <- sample_info
+  return(.data)
+}
+
 #' @name rename
 #' @rdname rename
 #' @inherit dplyr::rename
@@ -434,23 +474,23 @@ rename.SummarizedExperiment <- function(.data, ...) {
         " Please run two `rename` commands for",
         " sample-wise and feature-wise columns.")
 
-    secial_columns <- get_special_columns(
+    special_columns <- get_special_columns(
         # Decrease the size of the dataset
         .data[1:min(100, nrow(.data)), 1:min(20, ncol(.data))]
     ) |> c(get_needed_columns(.data))
 
     tst <-
         intersect(
             cols |> names(),
-            secial_columns
+            special_columns
         ) |>
         length() |>
         gt(0)
 
     # If column in view-only columns stop
     if (tst) {
         columns <-
-            secial_columns |>
+            special_columns |>
             paste(collapse=", ")
         stop(
             "tidySummarizedExperiment says:",

R/print_method.R

@@ -13,6 +13,7 @@
 #' @importFrom pillar get_extent
 #' @importFrom pillar style_subtle
 #' @importFrom pillar tbl_format_header
+#' @importFrom cli col_br_black
 #' @export
 tbl_format_header.tidySummarizedExperiment <- function(x, setup, ...) {
 
@@ -32,12 +33,12 @@ tbl_format_header.tidySummarizedExperiment <- function(x, setup, ...) {
                 named_header
             ) %>%
             # Add further info single-cell
-            append(sprintf(
-                "\033[90m Features=%s | Samples=%s | Assays=%s\033[39m",
+            append( cli::col_br_black( sprintf(
+                " Features=%s | Samples=%s | Assays=",
                 number_of_features,
                 number_of_samples,
                 assay_names %>% paste(collapse=", ")
-            ), after = 1)
+            )), after = 1)
     }
     style_subtle(pillar___format_comment(header, width=setup$width))
 }

R/tidyr_methods.R

@@ -362,19 +362,19 @@ extract.SummarizedExperiment <- function(data, col,
     }
 
 
-    secial_columns <- get_special_columns(  
+    special_columns <- get_special_columns(  
         # Decrease the size of the dataset
         data[1:min(100, nrow(data)), 1:min(20, ncol(data))]
     ) |> 
         c(get_needed_columns(data))
 
-    tst <- intersect(quo_names(into),  secial_columns) %>%
+    tst <- intersect(quo_names(into),  special_columns) %>%
         length() %>%
         gt(0) & remove
 
 
     if (tst) {
-        columns <- secial_columns |>  paste(collapse=", ")
+        columns <- special_columns |>  paste(collapse=", ")
         stop(
             "tidySummarizedExperiment says:",
             " you are trying to rename a column that is view only",
@@ -554,7 +554,7 @@ unite.SummarizedExperiment <- function(data, col, ...,
         data <- ping_old_special_column_into_metadata(data)
     }
 
-    secial_columns <- get_special_columns(
+    special_columns <- get_special_columns(
         # Decrease the size of the dataset
         data[1:min(100, nrow(data)), 1:min(20, ncol(data))]
     ) |> 
@@ -563,13 +563,13 @@ unite.SummarizedExperiment <- function(data, col, ...,
     tst <-
         intersect(
             cols %>% quo_names(),
-            secial_columns
+            special_columns
         ) %>%
         length() %>%
         gt(0) & remove
 
     if (tst) {
-        columns <- secial_columns |>  paste(collapse=", ")
+        columns <- special_columns |>  paste(collapse=", ")
         stop(
             "tidySummarizedExperiment says:",
             " you are trying to rename a column that is view only",
@@ -656,7 +656,7 @@ separate.SummarizedExperiment <- function(data, col,
         data <- ping_old_special_column_into_metadata(data)
     }
 
-    secial_columns <- get_special_columns(
+    special_columns <- get_special_columns(
         # Decrease the size of the dataset
         data[1:min(100, nrow(data)), 1:min(20, ncol(data))]
     ) |> 
@@ -665,13 +665,13 @@ separate.SummarizedExperiment <- function(data, col,
     tst <-
         intersect(
             cols %>% quo_names(),
-            secial_columns
+            special_columns
         ) %>%
         length() %>%
         gt(0) & remove
 
     if (tst) {
-        columns <- secial_columns |>  paste(collapse=", ")
+        columns <- special_columns |>  paste(collapse=", ")
         stop(
             "tidySummarizedExperiment says:",
             " you are trying to rename a column that is view only",

R/utilities.R

@@ -377,7 +377,7 @@ update_SE_from_tibble <- function(.data_mutated, se, column_belonging = NULL) {
     # where a unique value cannot be linked to sample or feature
     c(names(column_belonging[column_belonging == f_(se)$name]))
 
-  secial_columns <- get_special_columns(
+  special_columns <- get_special_columns(
     # Decrease the size of the dataset
     se[1:min(100, nrow(se)), min(1, ncol(se)):min(20, ncol(se))]
   ) 
@@ -393,7 +393,7 @@ update_SE_from_tibble <- function(.data_mutated, se, column_belonging = NULL) {
     select_if(!colnames(.) %in% setdiff(colnames_col, s_(se)$name)) %>% 
 
     # Eliminate special columns that are read only. Assays
-    select_if(!colnames(.) %in% secial_columns) %>%
+    select_if(!colnames(.) %in% special_columns) %>%
     select_if(!colnames(.) %in% colnames_row) %>%
     # Replace for subset
     select(!!s_(se)$symbol, get_subset_columns(., !!s_(se)$symbol)) %>% 
@@ -436,7 +436,7 @@ update_SE_from_tibble <- function(.data_mutated, se, column_belonging = NULL) {
     .data_mutated %>%
 
     # Eliminate special columns that are read only 
-    select_if(!colnames(.) %in% secial_columns) %>%
+    select_if(!colnames(.) %in% special_columns) %>%
 
     #eliminate sample columns directly
     select_if(!colnames(.) %in% c(s_(se)$name, colnames(col_data))) %>%

man/ggplot.Rd

@@ -205,3 +205,21 @@ test_that("group_split splits with mutliple arguments", {
     length() |> 
     expect_equal(4)
 })
+
+test_that("mutate features", {
+  pasilla %>%
+    mutate_features(new = 1:nrow(pasilla)) %>%
+    rowData() %>%
+    as_tibble() %>%
+    pull(new) %>%
+    expect_equal(1:nrow(pasilla))
+})
+
+test_that("mutate samples", {
+  pasilla %>%
+    mutate_samples(new = 1:ncol(pasilla)) %>%
+    colData() %>%
+    as_tibble() %>%
+    pull(new) %>%
+    expect_equal(1:ncol(pasilla))
+})