Fix unique special columns

DESCRIPTION

@@ -57,7 +57,7 @@ Biarch: true
 biocViews: AssayDomain, Infrastructure, RNASeq, DifferentialExpression, GeneExpression, Normalization, Clustering, QualityControl, Sequencing
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.1
 Roxygen: list(markdown = TRUE)
 URL: https://github.com/stemangiola/tidySingleCellExperiment
 BugReports: https://github.com/stemangiola/tidySingleCellExperiment/issues

NAMESPACE

@@ -141,6 +141,7 @@ importFrom(rlang,quo_squash)
 importFrom(stringr,regex)
 importFrom(stringr,str_detect)
 importFrom(stringr,str_replace)
+importFrom(stringr,str_replace_all)
 importFrom(tibble,as_tibble)
 importFrom(tibble,enframe)
 importFrom(tibble,glimpse)

R/tibble_methods.R

@@ -61,6 +61,7 @@
 #'     as_tibble()
 NULL
 
+
 #' @export
 #' @importFrom purrr reduce
 #' @importFrom purrr map
@@ -82,20 +83,7 @@ as_tibble.SingleCellExperiment <- function(x, ...,
 
             # Only if I have reduced dimensions and special datasets
             ncol(x@int_colData@listData$reducedDims) > 0 ~ (.) %>% dplyr::bind_cols(
-                get_special_datasets(x, ...) %>%
-                    map(~ .x %>% when(
-
-                        # If row == 1 do a trick
-                        dim(.) %>% is.null() ~ {
-                            (.) %>%
-                                tibble::enframe() %>%
-                                spread(name, value)
-                        },
-
-                        # Otherwise continue normally
-                        ~ as_tibble(.)
-                    )) %>%
-                    reduce(dplyr::bind_cols)
+              special_datasets_to_tibble(x, ...)
             ),
 
             # Otherwise skip

R/utilities.R

@@ -261,7 +261,19 @@ as_meta_data <- function(.data, SingleCellExperiment_object) {
     # Solve CRAN warnings
     . <- NULL
 
-    col_to_exclude <- get_special_columns(SingleCellExperiment_object)
+    col_to_exclude <-
+
+      # special_datasets_to_tibble(SingleCellExperiment_object) |>
+      # colnames()
+      get_special_columns(SingleCellExperiment_object) |>
+
+
+      # I need this in case we have multiple reduced dimension data frames with overlapping names of the columns.
+      # For example multiple PCA versions
+      vctrs::vec_as_names(repair = "unique") |>
+
+    # To avoid name change by the bind_cols of as_tibble
+    trick_to_avoid_renaming_of_already_unique_columns_by_dplyr()
 
     .data_df =
       .data %>%
@@ -405,3 +417,32 @@ add_attr = function(var, attribute, name) {
   attr(var, name) <- attribute
   var
 }
+
+special_datasets_to_tibble = function(.singleCellExperiment, ...){
+  x =
+    .singleCellExperiment |>
+    get_special_datasets(...) %>%
+    map(~ .x %>% when(
+
+      # If row == 1 do a trick
+      dim(.) %>% is.null() ~ {
+        (.) %>%
+          tibble::enframe() %>%
+          spread(name, value)
+      },
+
+      # Otherwise continue normally
+      ~ as_tibble(.)
+    )) %>%
+    reduce(dplyr::bind_cols)
+
+  # To avoid name change by the bind_cols of as_tibble
+  colnames(x) = colnames(x) |> trick_to_avoid_renaming_of_already_unique_columns_by_dplyr()
+
+  x
+}
+
+#' @importFrom stringr str_replace_all
+trick_to_avoid_renaming_of_already_unique_columns_by_dplyr = function(x){
+  x |> str_replace_all("\\.\\.\\.", "___")
+}

tests/testthat/test-methods.R

@@ -13,3 +13,19 @@ test_that("join_features",{
 
 
 })
+
+
+test_that("duplicated PCA matrices",{
+
+  pbmc_small@int_colData@listData$reducedDims$PCA2 = pbmc_small@int_colData@listData$reducedDims$PCA
+
+  pbmc_small %>%
+    mutate(aa = 1) |>
+    as_tibble() |>
+    ncol() |>
+    expect_equal(
+      (pbmc_small |> as_tibble() |> ncol()) + 1
+    )
+
+
+})