Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

deprecate cell column #39

Merged
merged 8 commits into from
Jan 28, 2022
Merged

deprecate cell column #39

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
0de9a1f
deprecate cell column
stemangiola Nov 23, 2021
3c4deb8
fix vignette
stemangiola Nov 24, 2021
8073251
change abundance and fix docs
stemangiola Nov 24, 2021
a8357cb
fix docs
stemangiola Nov 24, 2021
d58a687
fix unnest
stemangiola Nov 24, 2021
9bc5126
fix arguments unnest
stemangiola Nov 24, 2021
507753e
update code and fixes
stemangiola Dec 20, 2021
13fe6b9
Merge branch 'dev' into change-cell-column-name
stemangiola Jan 28, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions NAMESPACE
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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