Skip to content

Commit

Permalink
Merge pull request #39 from stemangiola/change-cell-column-name
Browse files Browse the repository at this point in the history 
deprecate cell column
  • Loading branch information
@stemangiola
stemangiola authored Jan 28, 2022
2 parents 96ee5cf + 13fe6b9 commit cc94262
Show file tree
Hide file tree
Showing 18 changed files with 475 additions and 180 deletions.
4 changes: 4 additions & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,9 @@ export(tidy)
export(unite)
export(unnest)
export(unnest_single_cell_experiment)
importFrom(S4Vectors,"metadata<-")
importFrom(S4Vectors,DataFrame)
importFrom(S4Vectors,metadata)
importFrom(SingleCellExperiment,cbind)
importFrom(SingleCellExperiment,counts)
importFrom(SummarizedExperiment,"colData<-")
Expand Down Expand Up @@ -133,6 +135,8 @@ importFrom(rlang,is_spliced)
importFrom(rlang,names2)
importFrom(rlang,quo_name)
importFrom(rlang,quo_squash)
importFrom(stringr,regex)
importFrom(stringr,str_detect)
importFrom(stringr,str_replace)
importFrom(tibble,as_tibble)
importFrom(tibble,enframe)
Expand Down
143 changes: 120 additions & 23 deletions R/dplyr_methods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ arrange.SingleCellExperiment <- function(.data, ..., .by_group=FALSE) {
as_tibble() %>%
dplyr::arrange(..., .by_group=.by_group)

.data[, new_metadata$cell]
.data[, pull(new_metadata, !!c_(.data)$symbol)]

}

Expand Down Expand Up @@ -215,6 +215,14 @@ NULL
distinct.SingleCellExperiment <- function(.data, ..., .keep_all=FALSE) {
message(data_frame_returned_message)

distinct_columns =
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)

# Deprecation of special column names
if(is_sample_feature_deprecated_used(.data, distinct_columns)){
.data= ping_old_special_column_into_metadata(.data)
}

.data %>%
as_tibble() %>%
dplyr::distinct(..., .keep_all=.keep_all)
Expand Down Expand Up @@ -294,19 +302,28 @@ NULL
#'
#' @export
filter.SingleCellExperiment <- function(.data, ..., .preserve=FALSE) {
new_meta <- .data %>%

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
.data,
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)
)){
.data= ping_old_special_column_into_metadata(.data)
}

new_meta <- .data %>%
as_tibble() %>%
dplyr::filter(..., .preserve=.preserve) # %>% as_meta_data(.data)

# Try to solve missing colnames
if(colnames(.data) %>% is.null()){
message("tidySingleCellExperiment says: the input object does not have cell names (colnames(...)). \n Therefore, the cell column in the filtered tibble abstraction will still include an incremental integer vector.")
new_meta$cell = as.integer(new_meta$cell)
new_meta = new_meta %>% mutate(!!c_(.data)$symbol := as.integer(!!c_(.data)$symbol))

}


.data[, new_meta$cell]
.data[, pull(new_meta, !!c_(.data)$symbol)]

}

Expand Down Expand Up @@ -361,6 +378,14 @@ NULL
group_by.SingleCellExperiment <- function(.data, ..., .add=FALSE, .drop=group_by_drop_default(.data)) {
message(data_frame_returned_message)

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
.data,
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)
)){
.data= ping_old_special_column_into_metadata(.data)
}

.data %>%
as_tibble() %>%
dplyr::group_by(..., .add=.add, .drop=.drop)
Expand Down Expand Up @@ -447,6 +472,13 @@ NULL
summarise.SingleCellExperiment <- function(.data, ...) {
message(data_frame_returned_message)

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
.data,
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)
)){
.data= ping_old_special_column_into_metadata(.data)
}

.data %>%
as_tibble() %>%
Expand Down Expand Up @@ -554,12 +586,20 @@ mutate.SingleCellExperiment <- function(.data, ...) {
# Check that we are not modifying a key column
cols <- enquos(...) %>% names()

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
.data,
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)
)){
.data= ping_old_special_column_into_metadata(.data)
}

tst <-
intersect(
cols %>%
names(),
get_special_columns(.data) %>%
c(get_needed_columns())
c(get_needed_columns(.data))
) %>%
length() %>%
gt(0)
Expand Down Expand Up @@ -642,15 +682,15 @@ rename.SingleCellExperiment <- function(.data, ...) {
cols %>%
names(),
get_special_columns(.data) %>%
c(get_needed_columns())
c(get_needed_columns(.data))
) %>%
length() %>%
gt(0)

if (tst) {
columns =
get_special_columns(.data) %>%
c(get_needed_columns()) %>%
c(get_needed_columns(.data)) %>%
paste(collapse=", ")
stop(
"tidySingleCellExperiment says: you are trying to rename a column that is view only",
Expand Down Expand Up @@ -742,13 +782,19 @@ NULL
#' @export
left_join.SingleCellExperiment <- function(x, y, by=NULL, copy=FALSE, suffix=c(".x", ".y"),
...) {

# Deprecation of special column names
if(is_sample_feature_deprecated_used( x, when(by, !is.null(.) ~ by, ~ colnames(y)))){
x= ping_old_special_column_into_metadata(x)
}

x %>%
as_tibble() %>%
dplyr::left_join(y, by=by, copy=copy, suffix=suffix, ...) %>%
when(

# If duplicated cells returns tibble
dplyr::count(., cell) %>%
dplyr::count(., !!c_(x)$symbol) %>%
filter(n > 1) %>%
nrow() %>%
gt(0) ~ {
Expand Down Expand Up @@ -793,13 +839,19 @@ NULL
#' @importFrom SummarizedExperiment colData
#' @export
inner_join.SingleCellExperiment <- function(x, y, by=NULL, copy=FALSE, suffix=c(".x", ".y"), ...) {

# Deprecation of special column names
if(is_sample_feature_deprecated_used( x, when(by, !is.null(.) ~ by, ~ colnames(y)))){
x= ping_old_special_column_into_metadata(x)
}

x %>%
as_tibble() %>%
dplyr::inner_join(y, by=by, copy=copy, suffix=suffix, ...) %>%
when(

# If duplicated cells returns tibble
count(., cell) %>%
count(., !!c_(x)$symbol) %>%
filter(n > 1) %>%
nrow() %>%
gt(0) ~ {
Expand All @@ -809,7 +861,7 @@ inner_join.SingleCellExperiment <- function(x, y, by=NULL, copy=FALSE, suffix=c(

# Otherwise return updated tidySingleCellExperiment
~ {
new_obj <- x[, .$cell]
new_obj <- x[, pull(., c_(x)$name)]
colData(new_obj) <- (.) %>% as_meta_data(new_obj)
new_obj
}
Expand Down Expand Up @@ -849,13 +901,19 @@ NULL
#' @export
right_join.SingleCellExperiment <- function(x, y, by=NULL, copy=FALSE, suffix=c(".x", ".y"),
...) {

# Deprecation of special column names
if(is_sample_feature_deprecated_used( x, when(by, !is.null(.) ~ by, ~ colnames(y)))){
x= ping_old_special_column_into_metadata(x)
}

x %>%
as_tibble() %>%
dplyr::right_join(y, by=by, copy=copy, suffix=suffix, ...) %>%
when(

# If duplicated cells returns tibble
count(., cell) %>%
count(., !!c_(x)$symbol) %>%
filter(n > 1) %>%
nrow() %>%
gt(0) ~ {
Expand All @@ -865,7 +923,7 @@ right_join.SingleCellExperiment <- function(x, y, by=NULL, copy=FALSE, suffix=c(

# Otherwise return updated tidySingleCellExperiment
~ {
new_obj <- x[, .$cell]
new_obj <- x[, pull(., c_(x)$name)]
colData(new_obj) <- (.) %>% as_meta_data(new_obj)
new_obj
}
Expand Down Expand Up @@ -905,13 +963,19 @@ NULL
#' @export
full_join.SingleCellExperiment <- function(x, y, by=NULL, copy=FALSE, suffix=c(".x", ".y"),
...) {

# Deprecation of special column names
if(is_sample_feature_deprecated_used( x, when(by, !is.null(.) ~ by, ~ colnames(y)))){
x= ping_old_special_column_into_metadata(x)
}

x %>%
as_tibble() %>%
dplyr::full_join(y, by=by, copy=copy, suffix=suffix, ...) %>%
when(

# If duplicated cells returns tibble
count(., cell) %>%
count(., !!c_(x)$symbol) %>%
filter(n > 1) %>%
nrow() %>%
gt(0) ~ {
Expand All @@ -921,7 +985,7 @@ full_join.SingleCellExperiment <- function(x, y, by=NULL, copy=FALSE, suffix=c("

# Otherwise return updated tidySingleCellExperiment
~ {
new_obj <- x[, .$cell]
new_obj <- x[, pull(., c_(x)$name)]
colData(new_obj) <- (.) %>% as_meta_data(x)
new_obj
}
Expand Down Expand Up @@ -1065,13 +1129,22 @@ NULL
#' @importFrom SummarizedExperiment colData
#' @export
select.SingleCellExperiment <- function(.data, ...) {

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
.data,
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)
)){
.data= ping_old_special_column_into_metadata(.data)
}

.data %>%
as_tibble() %>%
select_helper(...) %>%
when(

# If key columns are missing
(get_needed_columns() %in% colnames(.)) %>%
(get_needed_columns(.data) %in% colnames(.)) %>%
all() %>%
`!`() ~ {
message("tidySingleCellExperiment says: Key columns are missing. A data frame is returned for independent data analysis.")
Expand Down Expand Up @@ -1148,19 +1221,19 @@ sample_n.SingleCellExperiment <- function(tbl, size, replace=FALSE,

new_meta = colData(tbl) %>%
as.data.frame() %>%
as_tibble(rownames = "cell") %>%
as_tibble(rownames = c_(tbl)$name) %>%
dplyr::sample_n( size, replace = replace, weight = weight, .env = .env, ...)

count_cells = new_meta %>% select(cell) %>% count(cell)
count_cells = new_meta %>% select(!!c_(tbl)$symbol) %>% count(!!c_(tbl)$symbol)

# If repeted cells
if(count_cells$n %>% max() %>% gt(1)){
message("tidySingleCellExperiment says: When sampling with replacement a data frame is returned for independent data analysis.")
tbl %>%
as_tibble() %>%
right_join(new_meta %>% select(cell), by = "cell")
right_join(new_meta %>% select(!!c_(tbl)$symbol), by = c_(tbl)$name)
} else{
new_obj = tbl[, new_meta %>% pull(cell)]
new_obj = tbl[, new_meta %>% pull(!!c_(tbl)$symbol)]
new_obj
}
}
Expand All @@ -1185,19 +1258,19 @@ sample_frac.SingleCellExperiment <- function(tbl, size=1, replace=FALSE,

new_meta = colData(tbl) %>%
as.data.frame() %>%
as_tibble(rownames = "cell") %>%
as_tibble(rownames = c_(tbl)$name) %>%
dplyr::sample_frac( size, replace = replace, weight = weight, .env = .env, ...)

count_cells = new_meta %>% select(cell) %>% count(cell)
count_cells = new_meta %>% select(!!c_(tbl)$symbol) %>% count(!!c_(tbl)$symbol)

# If repeted cells
if(count_cells$n %>% max() %>% gt(1)){
message("tidySingleCellExperiment says: When sampling with replacement a data frame is returned for independent data analysis.")
tbl %>%
as_tibble() %>%
right_join(new_meta %>% select(cell), by = "cell")
right_join(new_meta %>% select(!!c_(tbl)$symbol), by = c_(tbl)$name)
} else{
new_obj = tbl[, new_meta %>% pull(cell)]
new_obj = tbl[, new_meta %>% pull(!!c_(tbl)$symbol)]
new_obj
}
}
Expand Down Expand Up @@ -1266,6 +1339,14 @@ count.default <- function(x, ..., wt=NULL, sort=FALSE, name=NULL, .drop=group_by
count.SingleCellExperiment <- function(x, ..., wt=NULL, sort=FALSE, name=NULL, .drop=group_by_drop_default(x)) {
message(data_frame_returned_message)

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
x,
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)
)){
x= ping_old_special_column_into_metadata(x)
}

x %>%
as_tibble() %>%
dplyr::count(..., wt=!!enquo(wt), sort=sort, name=name, .drop=.drop)
Expand All @@ -1289,6 +1370,14 @@ add_count.default <- function(x, ..., wt = NULL, sort = FALSE, name = NULL, .dro
#' @rdname count
add_count.SingleCellExperiment <- function(x, ..., wt = NULL, sort = FALSE, name = NULL, .drop = group_by_drop_default(x)) {

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
x,
(enquos(..., .ignore_empty = "all") %>% map(~ quo_name(.x)) %>% unlist)
)){
x= ping_old_special_column_into_metadata(x)
}

colData(x) =
x %>%
as_tibble %>%
Expand Down Expand Up @@ -1342,6 +1431,14 @@ pull.SingleCellExperiment <- function(.data, var=-1, name=NULL, ...) {
var <- enquo(var)
name <- enquo(name)

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
.data,
quo_name(var)
)){
.data= ping_old_special_column_into_metadata(.data)
}

.data %>%
as_tibble() %>%
dplyr::pull(var=!!var, name=!!name, ...)
Expand Down
11 changes: 10 additions & 1 deletion R/ggplot2_methods.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,13 +47,22 @@
#' library(ggplot2)
#'
#' tidySingleCellExperiment::pbmc_small %>%
#'
#'
#' tidySingleCellExperiment::ggplot(aes(groups, nCount_RNA)) +
#' geom_boxplot()
NULL

#' @export
ggplot.SingleCellExperiment <- function(data=NULL, mapping=aes(), ..., environment=parent.frame()) {

# Deprecation of special column names
if(is_sample_feature_deprecated_used(
data,
mapping %>% unlist() %>% map(~ quo_name(.x)) %>% unlist() %>% as.character()
)){
data= ping_old_special_column_into_metadata(data)
}

data %>%
as_tibble() %>%
ggplot2::ggplot(mapping=mapping)
Expand Down
Loading

0 comments on commit cc94262

Please sign in to comment.