diff --git a/.github/workflows/check_on_push.yml b/.github/workflows/check_on_push.yml index 277ebc0..2cbe199 100644 --- a/.github/workflows/check_on_push.yml +++ b/.github/workflows/check_on_push.yml @@ -121,7 +121,6 @@ jobs: # Rscript -e 'install.packages(c("ggdist", "ggforce"))' - name: Run R CMD build and R CMD check run: | - Rscript -e 'install.packages(c("rlang"))' R CMD build . R CMD check monocle3*tar.gz shell: bash diff --git a/DESCRIPTION b/DESCRIPTION index 8ad65bd..1934814 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -93,7 +93,6 @@ Imports: RColorBrewer, Rcpp (>= 1.0.1), reshape2 (>= 1.4.3), - rlang (>= 1.1.3), rsample (>= 0.0.5), RhpcBLASctl, RcppAnnoy, diff --git a/NAMESPACE b/NAMESPACE index 2929b91..4f7c182 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method(select_se,data.frame) -S3method(select_se,grouped_df) export("fData<-") export("pData<-") export("principal_graph<-") @@ -72,7 +70,6 @@ export(save_transform_models) export(search_cds_nn_index) export(search_nn_index) export(search_nn_matrix) -export(select_se) export(set_cds_nn_index) export(set_cds_row_order_matrix) export(set_matrix_control) diff --git a/R/cluster_cells.R b/R/cluster_cells.R index 69455dd..f0ed42b 100644 --- a/R/cluster_cells.R +++ b/R/cluster_cells.R @@ -599,6 +599,8 @@ compute_partitions <- function(g, optim_res, qval_thresh=0.05, verbose = FALSE){ + # The cells membership may have information about the + # clusters to which cells' nearest neighbors belong. cell_membership <- as.factor(igraph::membership(optim_res)) membership_matrix <- Matrix::sparse.model.matrix( ~ cell_membership + 0) num_links <- Matrix::t(membership_matrix) %*% @@ -617,6 +619,10 @@ compute_partitions <- function(g, num_links <- num_links_ij / total_edges + # Deal with zero total edges. + num_links[is.nan(num_links)] <- 0 + cluster_mat[is.nan(cluster_mat)] <- 0 + cluster_mat <- matrix(stats::p.adjust(cluster_mat), nrow=length(louvain_modules), ncol=length(louvain_modules)) diff --git a/R/deprec_dplyr.R b/R/deprec_dplyr.R deleted file mode 100644 index a89a251..0000000 --- a/R/deprec_dplyr.R +++ /dev/null @@ -1,152 +0,0 @@ -# MIT License -# -# Copyright (c) 2023 dplyr authors -# -# Permission is hereby granted, free of charge, to any person obtaining a copy -# of this software and associated documentation files (the "Software"), to deal -# in the Software without restriction, including without limitation the rights -# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -# copies of the Software, and to permit persons to whom the Software is -# furnished to do so, subject to the following conditions: -# -# The above copyright notice and this permission notice shall be included in all -# copies or substantial portions of the Software. -# -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -# SOFTWARE. -# -# -# Deprecated SE versions of main verbs. -# -# dplyr used to offer twin versions of each verb suffixed with an -# underscore. These versions had standard evaluation (SE) semantics: -# rather than taking arguments by code, like NSE verbs, they took -# arguments by value. Their purpose was to make it possible to -# program with dplyr. However, dplyr now uses tidy evaluation -# semantics. NSE verbs still capture their arguments, but you can now -# unquote parts of these arguments. This offers full programmability -# with NSE verbs. Thus, the underscored versions are now superfluous. -# -# Unquoting triggers immediate evaluation of its operand and inlines -# the result within the captured expression. This result can be a -# value or an expression to be evaluated later with the rest of the -# argument. See `vignette("programming")` for more information. -# - - -warn_underscored_se <- function() { - return(NULL) - warn(paste( - "The underscored versions are deprecated in favour of", - "tidy evaluation idioms. Please see the documentation", - "for `quo()` in rlang" - )) -} - - -warn_text_se <- function() { - return(NULL) - warn("Text parsing is deprecated, please supply an expression or formula") -} - -compat_lazy_se <- function(lazy, env = rlang::caller_env(), warn = TRUE) { - # Note: warn_underscored is disabled above. - if (warn) monocle3:::warn_underscored_se() - - if (missing(lazy)) { - return(rlang::quo()) - } - if (rlang::is_quosure(lazy)) { - return(lazy) - } - if (rlang::is_formula(lazy)) { - return(rlang::as_quosure(lazy, env)) - } - - out <- switch(typeof(lazy), - symbol = , - language = rlang::new_quosure(lazy, env), - character = { - if (warn) monocle3:::warn_text_se() - rlang::parse_quo(lazy[[1]], env) - }, - logical = , - integer = , - double = { - if (length(lazy) > 1) { - warn("Truncating vector to length 1") - lazy <- lazy[[1]] - } - rlang::new_quosure(lazy, env) - }, - list = - if (inherits(lazy, "lazy")) { - lazy = rlang::new_quosure(lazy$expr, lazy$env) - } - ) - - if (rlang::is_null(out)) { - abort(sprintf("Can't convert a %s to a quosure", typeof(lazy))) - } else { - out - } -} - - -compat_lazy_dots_se <- function(dots, env, ..., .named = FALSE) { - if (missing(dots)) { - dots <- list() - } - if (inherits(dots, c("lazy", "formula"))) { - dots <- list(dots) - } else { - dots <- unclass(dots) - } - dots <- c(dots, list(...)) - - warn <- TRUE - for (i in seq_along(dots)) { - dots[[i]] <- monocle3:::compat_lazy_se(dots[[i]], env, warn) - warn <- FALSE - } - - named <- rlang::have_name(dots) - if (.named && any(!named)) { - nms <- vapply(dots[!named], function(x) rlang::expr_text(rlang::get_expr(x)), character(1)) - names(dots)[!named] <- nms - } - - names(dots) <- rlang::names2(dots) - dots -} - - -# Generic select_se. -#' @export -select_se <- function(.data, ..., .dots = list()) { - # lazy_deprec("select", hint = FALSE) # Disable warning message and remove function definition. - UseMethod("select_se") -} - - -# select_se for data.frames. -#' @export -select_se.data.frame <- function(.data, ..., .dots = list()) { - dots <- monocle3:::compat_lazy_dots_se(.dots, rlang::caller_env(), ...) - dplyr::select(.data, !!!dots) -} - - -# select_se for grouped data frames. -#' @export -select_se.grouped_df <- function(.data, ..., .dots = list()) { - dots <- monocle3:::compat_lazy_dots_se(.dots, rlang::caller_env(), ...) - dplyr::select(.data, !!!dots) -} - - diff --git a/R/order_cells.R b/R/order_cells.R index 6d0c574..9473726 100644 --- a/R/order_cells.R +++ b/R/order_cells.R @@ -245,15 +245,16 @@ select_trajectory_roots <- function(cds, x=1, y=2, # nocov start if (use_3d){ edge_df <- dp_mst %>% igraph::as_data_frame() %>% - monocle3::select_se(source = "from", target = "to") %>% + # select() and select_() behave the same with these arguments. + dplyr::select(source = "from", target = "to") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se(source="sample_name", + dplyr::select(source="sample_name", source_prin_graph_dim_1="prin_graph_dim_1", source_prin_graph_dim_2="prin_graph_dim_2", source_prin_graph_dim_3="prin_graph_dim_3"), by = "source") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se(target="sample_name", + dplyr::select(target="sample_name", target_prin_graph_dim_1="prin_graph_dim_1", target_prin_graph_dim_2="prin_graph_dim_2", target_prin_graph_dim_3="prin_graph_dim_3"), @@ -261,14 +262,15 @@ select_trajectory_roots <- function(cds, x=1, y=2, # nocov start }else{ edge_df <- dp_mst %>% igraph::as_data_frame() %>% - monocle3::select_se(source = "from", target = "to") %>% + # select() and select_() behave the same with these arguments. + dplyr::select(source = "from", target = "to") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se(source="sample_name", + dplyr::select(source="sample_name", source_prin_graph_dim_1="prin_graph_dim_1", source_prin_graph_dim_2="prin_graph_dim_2"), by = "source") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se(target="sample_name", + dplyr::select(target="sample_name", target_prin_graph_dim_1="prin_graph_dim_1", target_prin_graph_dim_2="prin_graph_dim_2"), by = "target") diff --git a/R/plotting.R b/R/plotting.R index 30147c5..99563e9 100644 --- a/R/plotting.R +++ b/R/plotting.R @@ -284,29 +284,31 @@ plot_cells_3d <- function(cds, ## Graph info if (show_trajectory_graph) { + # select() and select_() behave differently here so embrace x, y, and z. ica_space_df <- t(cds@principal_graph_aux[[reduction_method]]$dp_mst) %>% as.data.frame() %>% - monocle3::select_se(prin_graph_dim_1 = x, prin_graph_dim_2 = y, - prin_graph_dim_3 = z) %>% + dplyr::select(prin_graph_dim_1 = {{x}}, prin_graph_dim_2 = {{y}}, + prin_graph_dim_3 = {{z}}) %>% dplyr::mutate(sample_name = rownames(.), sample_state = rownames(.)) dp_mst <- cds@principal_graph[[reduction_method]] + # select() and select_() behave the same with these arguments. edge_df <- dp_mst %>% igraph::as_data_frame() %>% - monocle3::select_se(source = "from", target = "to") %>% + dplyr::select(source = "from", target = "to") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se(source="sample_name", - source_prin_graph_dim_1="prin_graph_dim_1", - source_prin_graph_dim_2="prin_graph_dim_2", - source_prin_graph_dim_3="prin_graph_dim_3"), + dplyr::select(source="sample_name", + source_prin_graph_dim_1="prin_graph_dim_1", + source_prin_graph_dim_2="prin_graph_dim_2", + source_prin_graph_dim_3="prin_graph_dim_3"), by = "source") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se(target="sample_name", - target_prin_graph_dim_1="prin_graph_dim_1", - target_prin_graph_dim_2="prin_graph_dim_2", - target_prin_graph_dim_3="prin_graph_dim_3"), + dplyr::select(target="sample_name", + target_prin_graph_dim_1="prin_graph_dim_1", + target_prin_graph_dim_2="prin_graph_dim_2", + target_prin_graph_dim_3="prin_graph_dim_3"), by = "target") if(nrow(edge_df) < 1) warning('bad loop: nrow(edge_df) < 1') @@ -547,25 +549,27 @@ plot_cells <- function(cds, ## Graph info if (show_trajectory_graph) { + # select() and select_() behave differently here so embrace x and y. ica_space_df <- t(cds@principal_graph_aux[[reduction_method]]$dp_mst) %>% as.data.frame() %>% - monocle3::select_se(prin_graph_dim_1 = x, prin_graph_dim_2 = y) %>% + dplyr::select(prin_graph_dim_1 = {{x}}, prin_graph_dim_2 = {{y}}) %>% dplyr::mutate(sample_name = rownames(.), sample_state = rownames(.)) dp_mst <- cds@principal_graph[[reduction_method]] + # select() and select_() behave the same with these arguments. edge_df <- dp_mst %>% igraph::as_data_frame() %>% - monocle3::select_se(source = "from", target = "to") %>% + dplyr::select(source = "from", target = "to") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se( + dplyr::select( source="sample_name", source_prin_graph_dim_1="prin_graph_dim_1", source_prin_graph_dim_2="prin_graph_dim_2"), by = "source") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se( + dplyr::select( target="sample_name", target_prin_graph_dim_1="prin_graph_dim_1", target_prin_graph_dim_2="prin_graph_dim_2"), @@ -1883,12 +1887,14 @@ plot_genes_by_group <- function(cds, g <- ggplot(ExpVal, aes(y = Gene, x = Group)) + geom_point(aes(colour = group_color_class, size = mean)) + #viridis::scale_color_viridis(name = 'percentage') + - scale_size(name = 'log(mean + 0.1)', range = c(0, max.size)) + #scale_size(name = 'log(mean + 0.1)', range = c(0, max.size)) + scale_size(name = paste0('log(mean + ', pseudocount, ')'), range = c(0, max.size)) }else{ g <- ggplot(ExpVal, aes(y = Gene, x = Group)) + geom_point(aes(colour = percentage, size = mean)) + viridis::scale_color_viridis(name = 'percentage') + - scale_size(name = 'log(mean + 0.1)', range = c(0, max.size)) + #scale_size(name = 'log(mean + 0.1)', range = c(0, max.size)) + scale_size(name = paste0('log(mean + ', pseudocount, ')'), range = c(0, max.size)) } } else { if (color_by_group){ @@ -1899,7 +1905,8 @@ plot_genes_by_group <- function(cds, }else{ g <- ggplot(ExpVal, aes(y = Gene, x = Group)) + geom_point(aes(colour = mean, size = percentage)) + - viridis::scale_color_viridis(name = 'log(mean + 0.1)') + + #viridis::scale_color_viridis(name = 'log(mean + 0.1)') + + viridis::scale_color_viridis(name = paste0('log(mean + ', pseudocount, ')')) + scale_size(name = 'percentage', range = c(0, max.size)) } } diff --git a/R/select_cells.R b/R/select_cells.R index 7f0ad89..55dddfa 100644 --- a/R/select_cells.R +++ b/R/select_cells.R @@ -218,24 +218,26 @@ choose_graph_segments <- function(cds, dp_mst <- cds@principal_graph[[reduction_method]] + # select() and select_() behave the same with these arguments. princ_points <- t(cds@principal_graph_aux[[reduction_method]]$dp_mst) %>% as.data.frame() %>% - monocle3::select_se(x = 1, y = 2) %>% + dplyr::select(x = 1, y = 2) %>% dplyr::mutate(sample_name = rownames(.), sample_state = rownames(.)) row.names(princ_points) <- princ_points$sample_name + # select() and select_() behave the same with these arguments. edge_df <- dp_mst %>% igraph::as_data_frame() %>% - monocle3::select_se(source = "from", target = "to") %>% + dplyr::select(source = "from", target = "to") %>% dplyr::left_join(princ_points %>% - monocle3::select_se(source="sample_name", - source_prin_graph_dim_1="x", - source_prin_graph_dim_2="y"), + dplyr::select(source="sample_name", + source_prin_graph_dim_1="x", + source_prin_graph_dim_2="y"), by = "source") %>% dplyr::left_join(princ_points %>% - monocle3::select_se(target="sample_name", - target_prin_graph_dim_1="x", - target_prin_graph_dim_2="y"), + dplyr::select(target="sample_name", + target_prin_graph_dim_1="x", + target_prin_graph_dim_2="y"), by = "target") data_df <- data.frame(SingleCellExperiment::reducedDims(cds)[[reduction_method]]) @@ -441,24 +443,26 @@ plot_principal_graph <- function(cds, ## Graph info + # select() and select_() behave the same with these arguments. ica_space_df <- t(cds@principal_graph_aux[[reduction_method]]$dp_mst) %>% as.data.frame() %>% - monocle3::select_se(prin_graph_dim_1 = 1, prin_graph_dim_2 = 2) %>% + dplyr::select(prin_graph_dim_1 = 1, prin_graph_dim_2 = 2) %>% dplyr::mutate(sample_name = rownames(.), sample_state = rownames(.)) dp_mst <- cds@principal_graph[[reduction_method]] + # select() and select_() behave the same with these arguments. edge_df <- dp_mst %>% igraph::as_data_frame() %>% - monocle3::select_se(source = "from", target = "to") %>% + dplyr::select(source = "from", target = "to") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se( + dplyr::select( source="sample_name", source_prin_graph_dim_1="prin_graph_dim_1", source_prin_graph_dim_2="prin_graph_dim_2"), by = "source") %>% dplyr::left_join(ica_space_df %>% - monocle3::select_se( + dplyr::select( target="sample_name", target_prin_graph_dim_1="prin_graph_dim_1", target_prin_graph_dim_2="prin_graph_dim_2"), diff --git a/tests/testthat/test-deprec_dplyr.R b/tests/testthat/test-deprec_dplyr.R deleted file mode 100644 index a943ad3..0000000 --- a/tests/testthat/test-deprec_dplyr.R +++ /dev/null @@ -1,77 +0,0 @@ -# MIT License -# -# Copyright (c) 2023 dplyr authors -# -# Permission is hereby granted, free of charge, to any person obtaining a copy -# of this software and associated documentation files (the "Software"), to deal -# in the Software without restriction, including without limitation the rights -# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -# copies of the Software, and to permit persons to whom the Software is -# furnished to do so, subject to the following conditions: -# -# The above copyright notice and this permission notice shall be included in all -# copies or substantial portions of the Software. -# -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -# SOFTWARE. -# - -library(tibble) -library(rlang) -library(dplyr) - - -test_that("can select negatively (#2519)", { - withr::local_options(lifecycle_verbosity = "quiet") - - expect_identical(monocle3::select_se(mtcars, ~ -cyl), mtcars[-2]) -}) - -test_that("select yields proper names", { - withr::local_options(lifecycle_verbosity = "quiet") - - expect_identical(names(monocle3::select_se(mtcars, ~ cyl:hp)), c("cyl", "disp", "hp")) -}) - - -df <- tibble( - a = c(1:3, 2:3), - b = letters[c(1:4, 4L)] -) - - -test_that("monocle3::select_se() works", { - withr::local_options(lifecycle_verbosity = "quiet") - - expect_equal( - monocle3::select_se(df, ~ a), - select(df, a) - ) - - expect_equal( - monocle3::select_se(df, ~ -a), - select(df, -a) - ) - - expect_equal( - monocle3::select_se(df, .dots = "a"), - select(df, a) - ) - - expect_equal( - monocle3::select_se(df, .dots = list(quote(-a))), - select(df, -a) - ) - - expect_equal( - monocle3::select_se(df, .dots = list(~ -a)), - select(df, -a) - ) -}) - -