Skip to content

Commit

Permalink
Merge pull request #37 from stemangiola/dev
Browse files Browse the repository at this point in the history 
Dev
  • Loading branch information
@stemangiola
stemangiola authored Feb 1, 2022
2 parents 49e0436 + 1e6dade commit 5cb976d
Show file tree
Hide file tree
Showing 20 changed files with 420 additions and 163 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ Description: tidySingleCellExperiment is an adapter that abstracts the 'SingleCe
License: GPL-3
Depends:
R (>= 4.0.0),
ttservice,
SingleCellExperiment
Imports:
SummarizedExperiment,
Expand Down
9 changes: 5 additions & 4 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,6 @@ S3method(ggplot,SingleCellExperiment)
S3method(glimpse,tidySingleCellExperiment)
S3method(group_by,SingleCellExperiment)
S3method(inner_join,SingleCellExperiment)
S3method(join_features,SingleCellExperiment)
S3method(join_features,default)
S3method(join_transcripts,Seurat)
S3method(join_transcripts,default)
S3method(left_join,SingleCellExperiment)
Expand Down Expand Up @@ -78,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 @@ -135,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 All @@ -147,7 +149,6 @@ importFrom(tidyr,separate)
importFrom(tidyr,spread)
importFrom(tidyr,unite)
importFrom(tidyr,unnest)
importFrom(tidyselect,contains)
importFrom(tidyselect,eval_select)
importFrom(tidyselect,everything)
importFrom(ttservice,join_features)
importFrom(utils,tail)
152 changes: 128 additions & 24 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,13 +302,29 @@ 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)
new_obj <- .data[, new_meta$cell]
# colData(new_obj)=new_meta

new_obj
# 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 = new_meta %>% mutate(!!c_(.data)$symbol := as.integer(!!c_(.data)$symbol))

}


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

}


Expand Down Expand Up @@ -354,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 @@ -440,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 @@ -547,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 @@ -635,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 @@ -735,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 @@ -786,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 @@ -802,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 @@ -842,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 @@ -858,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 @@ -898,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 @@ -914,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 @@ -1058,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 @@ -1141,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 @@ -1178,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 @@ -1259,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 @@ -1282,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 @@ -1335,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
Loading

0 comments on commit 5cb976d

Please sign in to comment.