From 9e4c25aea3fa8320c84bd77b0d4a9d0f6f0b6212 Mon Sep 17 00:00:00 2001 From: Nick-Eagles Date: Tue, 9 Apr 2024 09:53:22 -0400 Subject: [PATCH] Auto-style code --- R/add10xVisiumAnalysis.R | 5 +- R/add_images.R | 13 +++-- R/annotate_registered_clusters.R | 16 ++--- R/check_sce.R | 69 +++++++++++----------- R/check_spe.R | 15 ++--- R/fetch_data.R | 41 +++++++------ R/frame_limits.R | 21 +++---- R/gene_set_enrichment.R | 11 ++-- R/gene_set_enrichment_plot.R | 23 ++++---- R/geom_spatial.R | 17 +++--- R/img_edit.R | 37 ++++++------ R/img_update.R | 13 +++-- R/img_update_all.R | 11 ++-- R/layer_boxplot.R | 27 ++++----- R/layer_matrix_plot.R | 27 ++++----- R/layer_stat_cor.R | 11 ++-- R/layer_stat_cor_plot.R | 11 ++-- R/read10xVisiumAnalysis.R | 5 +- R/read10xVisiumWrapper.R | 21 +++---- R/registration_model.R | 7 ++- R/registration_pseudobulk.R | 13 ++--- R/registration_stats_anova.R | 17 +++--- R/registration_stats_enrichment.R | 15 +++-- R/registration_stats_pairwise.R | 15 +++-- R/registration_wrapper.R | 19 +++--- R/run_app.R | 97 ++++++++++++++++--------------- R/sig_genes_extract.R | 11 ++-- R/sig_genes_extract_all.R | 7 +-- R/vis_clus.R | 49 ++++++++-------- R/vis_clus_p.R | 25 ++++---- R/vis_gene.R | 33 +++++------ R/vis_gene_p.R | 35 +++++------ R/vis_grid_clus.R | 33 ++++++----- R/vis_grid_gene.R | 37 ++++++------ tests/testthat/test-vis_gene.R | 21 ++++--- 35 files changed, 424 insertions(+), 404 deletions(-) diff --git a/R/add10xVisiumAnalysis.R b/R/add10xVisiumAnalysis.R index de4f5fee..dbe49f86 100644 --- a/R/add10xVisiumAnalysis.R +++ b/R/add10xVisiumAnalysis.R @@ -29,8 +29,9 @@ #' #' ## Note that ?SpatialExperiment::read10xVisium doesn't include all the files #' ## we need to illustrate read10xVisiumWrapper(). -add10xVisiumAnalysis <- function(spe, - visium_analysis) { +add10xVisiumAnalysis <- function( + spe, + visium_analysis) { col_info <- colData(spe) barcode_present <- "barcode" %in% colnames(col_info) if (!barcode_present) { diff --git a/R/add_images.R b/R/add_images.R index bfdddbe5..e7b09e5c 100644 --- a/R/add_images.R +++ b/R/add_images.R @@ -43,12 +43,13 @@ #' )) #' } add_images <- - function(spe, - image_dir, - image_pattern, - image_id_current = "lowres", - image_id = image_pattern, - image_paths = locate_images(spe, image_dir, image_pattern)) { + function( + spe, + image_dir, + image_pattern, + image_id_current = "lowres", + image_id = image_pattern, + image_paths = locate_images(spe, image_dir, image_pattern)) { stopifnot(length(names(image_paths)) > 0) stopifnot(all(names(image_paths) %in% unique(spe$sample_id))) stopifnot(!any(duplicated(names(image_paths)))) diff --git a/R/annotate_registered_clusters.R b/R/annotate_registered_clusters.R index c2a9ec43..13e1d5ab 100644 --- a/R/annotate_registered_clusters.R +++ b/R/annotate_registered_clusters.R @@ -48,9 +48,10 @@ #' ## More relaxed merging threshold #' annotate_registered_clusters(cor_stats_layer, cutoff_merge_ratio = 1) annotate_registered_clusters <- - function(cor_stats_layer, - confidence_threshold = 0.25, - cutoff_merge_ratio = 0.25) { + function( + cor_stats_layer, + confidence_threshold = 0.25, + cutoff_merge_ratio = 0.25) { annotated <- apply(cor_stats_layer, 1, @@ -86,10 +87,11 @@ annotate_registered_clusters <- } annotate_registered_cluster <- - function(remaining, - label = "", - current = NULL, - cutoff_merge_ratio = 0.25) { + function( + remaining, + label = "", + current = NULL, + cutoff_merge_ratio = 0.25) { ## Filter negative correlations remaining <- remaining[remaining > 0] diff --git a/R/check_sce.R b/R/check_sce.R index 0d17423b..1d625342 100644 --- a/R/check_sce.R +++ b/R/check_sce.R @@ -24,40 +24,41 @@ #' ## Check the object #' check_sce(sce_example) #' } -check_sce <- function(sce, - variables = c( - "GraphBased", - "ManualAnnotation", - "Maynard", - "Martinowich", - paste0("SNN_k50_k", 4:28), - "spatialLIBD", - "cell_count", - "sum_umi", - "sum_gene", - "expr_chrM", - "expr_chrM_ratio", - "SpatialDE_PCA", - "SpatialDE_pool_PCA", - "HVG_PCA", - "pseudobulk_PCA", - "markers_PCA", - "SpatialDE_UMAP", - "SpatialDE_pool_UMAP", - "HVG_UMAP", - "pseudobulk_UMAP", - "markers_UMAP", - "SpatialDE_PCA_spatial", - "SpatialDE_pool_PCA_spatial", - "HVG_PCA_spatial", - "pseudobulk_PCA_spatial", - "markers_PCA_spatial", - "SpatialDE_UMAP_spatial", - "SpatialDE_pool_UMAP_spatial", - "HVG_UMAP_spatial", - "pseudobulk_UMAP_spatial", - "markers_UMAP_spatial" - )) { +check_sce <- function( + sce, + variables = c( + "GraphBased", + "ManualAnnotation", + "Maynard", + "Martinowich", + paste0("SNN_k50_k", 4:28), + "spatialLIBD", + "cell_count", + "sum_umi", + "sum_gene", + "expr_chrM", + "expr_chrM_ratio", + "SpatialDE_PCA", + "SpatialDE_pool_PCA", + "HVG_PCA", + "pseudobulk_PCA", + "markers_PCA", + "SpatialDE_UMAP", + "SpatialDE_pool_UMAP", + "HVG_UMAP", + "pseudobulk_UMAP", + "markers_UMAP", + "SpatialDE_PCA_spatial", + "SpatialDE_pool_PCA_spatial", + "HVG_PCA_spatial", + "pseudobulk_PCA_spatial", + "markers_PCA_spatial", + "SpatialDE_UMAP_spatial", + "SpatialDE_pool_UMAP_spatial", + "HVG_UMAP_spatial", + "pseudobulk_UMAP_spatial", + "markers_UMAP_spatial" + )) { ## Should be a SingleCellExperiment object stopifnot(is(sce, "SingleCellExperiment")) diff --git a/R/check_spe.R b/R/check_spe.R index 47de3c0a..d0344daa 100644 --- a/R/check_spe.R +++ b/R/check_spe.R @@ -25,13 +25,14 @@ #' ## Check the object #' check_spe(spe) #' } -check_spe <- function(spe, - variables = c( - "sum_umi", - "sum_gene", - "expr_chrM", - "expr_chrM_ratio" - )) { +check_spe <- function( + spe, + variables = c( + "sum_umi", + "sum_gene", + "expr_chrM", + "expr_chrM_ratio" + )) { ## Should be a SpatialExperiment object stopifnot(is(spe, "SpatialExperiment")) diff --git a/R/fetch_data.R b/R/fetch_data.R index cc715e4a..3426ae6d 100644 --- a/R/fetch_data.R +++ b/R/fetch_data.R @@ -84,27 +84,26 @@ #' #> 172.28 MB #' } fetch_data <- - function( - type = c( - "sce", - "sce_layer", - "modeling_results", - "sce_example", - "spe", - "spatialDLPFC_Visium", - "spatialDLPFC_Visium_example_subset", - "spatialDLPFC_Visium_pseudobulk", - "spatialDLPFC_Visium_modeling_results", - "spatialDLPFC_Visium_SPG", - "spatialDLPFC_snRNAseq", - "Visium_SPG_AD_Visium_wholegenome_spe", - "Visium_SPG_AD_Visium_targeted_spe", - "Visium_SPG_AD_Visium_wholegenome_pseudobulk_spe", - "Visium_SPG_AD_Visium_wholegenome_modeling_results" - ), - destdir = tempdir(), - eh = ExperimentHub::ExperimentHub(), - bfc = BiocFileCache::BiocFileCache()) { + function(type = c( + "sce", + "sce_layer", + "modeling_results", + "sce_example", + "spe", + "spatialDLPFC_Visium", + "spatialDLPFC_Visium_example_subset", + "spatialDLPFC_Visium_pseudobulk", + "spatialDLPFC_Visium_modeling_results", + "spatialDLPFC_Visium_SPG", + "spatialDLPFC_snRNAseq", + "Visium_SPG_AD_Visium_wholegenome_spe", + "Visium_SPG_AD_Visium_targeted_spe", + "Visium_SPG_AD_Visium_wholegenome_pseudobulk_spe", + "Visium_SPG_AD_Visium_wholegenome_modeling_results" + ), + destdir = tempdir(), + eh = ExperimentHub::ExperimentHub(), + bfc = BiocFileCache::BiocFileCache()) { ## Some variables sce <- sce_layer <- modeling_results <- sce_sub <- spe <- NULL diff --git a/R/frame_limits.R b/R/frame_limits.R index b22b5c8a..320cc643 100644 --- a/R/frame_limits.R +++ b/R/frame_limits.R @@ -37,16 +37,17 @@ #' } #' frame_limits <- - function(spe, - sampleid, - image_id = "lowres", - visium_grid = list( - row_min = 0, - row_max = 77, - col_min = 0, - col_max = 127, - fiducial_vs_capture_edge = (8 - 6.5) * 1000 / 2 / 100 - )) { + function( + spe, + sampleid, + image_id = "lowres", + visium_grid = list( + row_min = 0, + row_max = 77, + col_min = 0, + col_max = 127, + fiducial_vs_capture_edge = (8 - 6.5) * 1000 / 2 / 100 + )) { ## Subset the info we need for the particular sample d <- as.data.frame(cbind(colData(spe), SpatialExperiment::spatialCoords(spe))[spe$sample_id == sampleid, ], diff --git a/R/gene_set_enrichment.R b/R/gene_set_enrichment.R index 1accea28..e6b6a63d 100644 --- a/R/gene_set_enrichment.R +++ b/R/gene_set_enrichment.R @@ -58,11 +58,12 @@ #' ## Explore the results #' asd_sfari_enrichment gene_set_enrichment <- - function(gene_list, - fdr_cut = 0.1, - modeling_results = fetch_data(type = "modeling_results"), - model_type = names(modeling_results)[1], - reverse = FALSE) { + function( + gene_list, + fdr_cut = 0.1, + modeling_results = fetch_data(type = "modeling_results"), + model_type = names(modeling_results)[1], + reverse = FALSE) { model_results <- modeling_results[[model_type]] ## Keep only the genes present diff --git a/R/gene_set_enrichment_plot.R b/R/gene_set_enrichment_plot.R index 4ccbfcbc..c155e672 100644 --- a/R/gene_set_enrichment_plot.R +++ b/R/gene_set_enrichment_plot.R @@ -84,17 +84,18 @@ #' layerHeights = c(0, 40, 55, 75, 85, 110, 120, 135), #' ) gene_set_enrichment_plot <- - function(enrichment, - xlabs = unique(enrichment$ID), - PThresh = 12, - ORcut = 3, - enrichOnly = FALSE, - layerHeights = c(0, seq_len(length(unique(enrichment$test)))) * 15, - mypal = c( - "white", - grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) - ), - cex = 1.2) { + function( + enrichment, + xlabs = unique(enrichment$ID), + PThresh = 12, + ORcut = 3, + enrichOnly = FALSE, + layerHeights = c(0, seq_len(length(unique(enrichment$test)))) * 15, + mypal = c( + "white", + grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) + ), + cex = 1.2) { ## Re-order and shorten names if they match our data if (all(unique(enrichment$test) %in% c("WM", paste0("Layer", seq_len(6))))) { enrichment$test <- diff --git a/R/geom_spatial.R b/R/geom_spatial.R index 64f00cc3..965db758 100644 --- a/R/geom_spatial.R +++ b/R/geom_spatial.R @@ -58,14 +58,15 @@ #' ## Clean up #' rm(spe_sub) #' } -geom_spatial <- function(mapping = NULL, - data = NULL, - stat = "identity", - position = "identity", - na.rm = FALSE, - show.legend = NA, - inherit.aes = FALSE, - ...) { +geom_spatial <- function( + mapping = NULL, + data = NULL, + stat = "identity", + position = "identity", + na.rm = FALSE, + show.legend = NA, + inherit.aes = FALSE, + ...) { ## To avoid a NOTE on R CMD check ggname <- function(prefix, grob) { grob$name <- grid::grobName(grob, prefix) diff --git a/R/img_edit.R b/R/img_edit.R index ec6fae90..93aceee3 100644 --- a/R/img_edit.R +++ b/R/img_edit.R @@ -58,24 +58,25 @@ #' plot(x) #' } img_edit <- - function(spe, - sampleid, - image_id = "lowres", - channel = NA, - brightness = 100, - saturation = 100, - hue = 100, - enhance = FALSE, - contrast_sharpen = NA, - quantize_max = NA, - quantize_dither = TRUE, - equalize = FALSE, - normalize = FALSE, - transparent_color = NA, - transparent_fuzz = 0, - background_color = NA, - median_radius = NA, - negate = FALSE) { + function( + spe, + sampleid, + image_id = "lowres", + channel = NA, + brightness = 100, + saturation = 100, + hue = 100, + enhance = FALSE, + contrast_sharpen = NA, + quantize_max = NA, + quantize_dither = TRUE, + equalize = FALSE, + normalize = FALSE, + transparent_color = NA, + transparent_fuzz = 0, + background_color = NA, + median_radius = NA, + negate = FALSE) { img <- magick::image_read(SpatialExperiment::imgRaster(spe, sample_id = sampleid, image_id = image_id)) diff --git a/R/img_update.R b/R/img_update.R index db6dfcb1..fdfe5b83 100644 --- a/R/img_update.R +++ b/R/img_update.R @@ -41,12 +41,13 @@ #' imgData(img_update(spe, sampleid = "151507", brightness = 25)) #' } img_update <- - function(spe, - sampleid, - image_id = "lowres", - new_image_id = paste0("edited_", image_id), - overwrite = FALSE, - ...) { + function( + spe, + sampleid, + image_id = "lowres", + new_image_id = paste0("edited_", image_id), + overwrite = FALSE, + ...) { img_data <- SpatialExperiment::imgData(spe) ## Skip this sample if there's no existing image to update diff --git a/R/img_update_all.R b/R/img_update_all.R index 31c368c9..314b9b0d 100644 --- a/R/img_update_all.R +++ b/R/img_update_all.R @@ -22,11 +22,12 @@ #' imgData(img_update_all(spe, brightness = 25)) #' } img_update_all <- - function(spe, - image_id = "lowres", - new_image_id = paste0("edited_", image_id), - overwrite = FALSE, - ...) { + function( + spe, + image_id = "lowres", + new_image_id = paste0("edited_", image_id), + overwrite = FALSE, + ...) { for (sampleid in unique(spe$sample_id)) { spe <- img_update( diff --git a/R/layer_boxplot.R b/R/layer_boxplot.R index 345d5499..6a671a5e 100644 --- a/R/layer_boxplot.R +++ b/R/layer_boxplot.R @@ -114,19 +114,20 @@ #' col_high_point = "firebrick4", #' cex = 3 #' ) -layer_boxplot <- function(i = 1, - sig_genes = sig_genes_extract(), - short_title = TRUE, - sce_layer = fetch_data(type = "sce_layer"), - col_bkg_box = "grey80", - col_bkg_point = "grey40", - col_low_box = "violet", - col_low_point = "darkviolet", - col_high_box = "skyblue", - col_high_point = "dodgerblue4", - cex = 2, - group_var = "layer_guess_reordered_short", - assayname = "logcounts") { +layer_boxplot <- function( + i = 1, + sig_genes = sig_genes_extract(), + short_title = TRUE, + sce_layer = fetch_data(type = "sce_layer"), + col_bkg_box = "grey80", + col_bkg_point = "grey40", + col_low_box = "violet", + col_low_point = "darkviolet", + col_high_box = "skyblue", + col_high_point = "dodgerblue4", + cex = 2, + group_var = "layer_guess_reordered_short", + assayname = "logcounts") { ## Extract the logcounts (default) mat <- assay(sce_layer, assayname) diff --git a/R/layer_matrix_plot.R b/R/layer_matrix_plot.R index f1530fb1..4a44fd18 100644 --- a/R/layer_matrix_plot.R +++ b/R/layer_matrix_plot.R @@ -55,19 +55,20 @@ #' cex = 2 #' ) layer_matrix_plot <- - function(matrix_values, - matrix_labels = NULL, - xlabs = NULL, - layerHeights = NULL, - mypal = c( - "white", - grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) - ), - breaks = NULL, - axis.args = NULL, - srt = 45, - mar = c(8, 4 + (max(nchar(rownames(matrix_values))) %/% 3) * 0.5, 4, 2) + 0.1, - cex = 1.2) { + function( + matrix_values, + matrix_labels = NULL, + xlabs = NULL, + layerHeights = NULL, + mypal = c( + "white", + grDevices::colorRampPalette(RColorBrewer::brewer.pal(9, "YlOrRd"))(50) + ), + breaks = NULL, + axis.args = NULL, + srt = 45, + mar = c(8, 4 + (max(nchar(rownames(matrix_values))) %/% 3) * 0.5, 4, 2) + 0.1, + cex = 1.2) { ## Create some default values in case the user didn't specify them if (is.null(xlabs)) { if (is.null(colnames(matrix_values))) { diff --git a/R/layer_stat_cor.R b/R/layer_stat_cor.R index 0ccf0bf2..f484c912 100644 --- a/R/layer_stat_cor.R +++ b/R/layer_stat_cor.R @@ -49,11 +49,12 @@ #' top_n = 10 #' )) layer_stat_cor <- - function(stats, - modeling_results = fetch_data(type = "modeling_results"), - model_type = names(modeling_results)[1], - reverse = FALSE, - top_n = NULL) { + function( + stats, + modeling_results = fetch_data(type = "modeling_results"), + model_type = names(modeling_results)[1], + reverse = FALSE, + top_n = NULL) { model_results <- modeling_results[[model_type]] tstats <- diff --git a/R/layer_stat_cor_plot.R b/R/layer_stat_cor_plot.R index c0f4e924..0d2653b8 100644 --- a/R/layer_stat_cor_plot.R +++ b/R/layer_stat_cor_plot.R @@ -72,11 +72,12 @@ #' top_n = 10 #' ), max = 0.25) layer_stat_cor_plot <- - function(cor_stats_layer, - max = 0.81, - min = -max, - layerHeights = NULL, - cex = 1.2) { + function( + cor_stats_layer, + max = 0.81, + min = -max, + layerHeights = NULL, + cex = 1.2) { ## From https://github.com/LieberInstitute/HumanPilot/blob/master/Analysis/Layer_Guesses/dlpfc_snRNAseq_annotation.R theSeq <- seq(min, max, by = 0.01) my.col <- grDevices::colorRampPalette(RColorBrewer::brewer.pal(7, "PRGn"))(length(theSeq)) diff --git a/R/read10xVisiumAnalysis.R b/R/read10xVisiumAnalysis.R index ef76f1d0..70bc49ac 100644 --- a/R/read10xVisiumAnalysis.R +++ b/R/read10xVisiumAnalysis.R @@ -24,9 +24,8 @@ #' #' ## Note that ?SpatialExperiment::read10xVisium doesn't include all the files #' ## we need to illustrate read10xVisiumWrapper(). -read10xVisiumAnalysis <- function( - samples = "", - sample_id = paste0("sample", sprintf("%02d", seq_along(samples)))) { +read10xVisiumAnalysis <- function(samples = "", + sample_id = paste0("sample", sprintf("%02d", seq_along(samples)))) { # check sample identifiers if (is.null(sids <- names(samples))) { if (is.null(sids <- sample_id)) { diff --git a/R/read10xVisiumWrapper.R b/R/read10xVisiumWrapper.R index 501a744d..d9f31fc2 100644 --- a/R/read10xVisiumWrapper.R +++ b/R/read10xVisiumWrapper.R @@ -44,16 +44,17 @@ #' #' ## Note that ?SpatialExperiment::read10xVisium doesn't include all the files #' ## we need to illustrate read10xVisiumWrapper(). -read10xVisiumWrapper <- function(samples = "", - sample_id = paste0("sample", sprintf("%02d", seq_along(samples))), - type = c("HDF5", "sparse"), - data = c("filtered", "raw"), - images = c("lowres", "hires", "detected", "aligned"), - load = TRUE, - reference_gtf = NULL, - chrM = "chrM", - gtf_cols = c("source", "type", "gene_id", "gene_version", "gene_name", "gene_type"), - verbose = TRUE) { +read10xVisiumWrapper <- function( + samples = "", + sample_id = paste0("sample", sprintf("%02d", seq_along(samples))), + type = c("HDF5", "sparse"), + data = c("filtered", "raw"), + images = c("lowres", "hires", "detected", "aligned"), + load = TRUE, + reference_gtf = NULL, + chrM = "chrM", + gtf_cols = c("source", "type", "gene_id", "gene_version", "gene_name", "gene_type"), + verbose = TRUE) { stopifnot(all(c("gene_name", "gene_id") %in% gtf_cols)) if (missing(reference_gtf)) { diff --git a/R/registration_model.R b/R/registration_model.R index 3f36260c..6921dbb9 100644 --- a/R/registration_model.R +++ b/R/registration_model.R @@ -24,9 +24,10 @@ #' head(registration_mod) #' registration_model <- - function(sce_pseudo, - covars = NULL, - var_registration = "registration_variable") { + function( + sce_pseudo, + covars = NULL, + var_registration = "registration_variable") { ## Specify a formula without an intercept if (is.null(covars)) { mat_formula <- diff --git a/R/registration_pseudobulk.R b/R/registration_pseudobulk.R index 5f3c5dd2..2d859e4e 100644 --- a/R/registration_pseudobulk.R +++ b/R/registration_pseudobulk.R @@ -51,13 +51,12 @@ #' sce_pseudo <- registration_pseudobulk(sce, "Cell_Cycle", "sample_id", c("age"), min_ncells = NULL) #' colData(sce_pseudo) registration_pseudobulk <- - function( - sce, - var_registration, - var_sample_id, - covars = NULL, - min_ncells = 10, - pseudobulk_rds_file = NULL) { + function(sce, + var_registration, + var_sample_id, + covars = NULL, + min_ncells = 10, + pseudobulk_rds_file = NULL) { ## Check that inputs are correct stopifnot(is(sce, "SingleCellExperiment")) stopifnot(var_registration %in% colnames(colData(sce))) diff --git a/R/registration_stats_anova.R b/R/registration_stats_anova.R index c899459d..d1d0b135 100644 --- a/R/registration_stats_anova.R +++ b/R/registration_stats_anova.R @@ -50,14 +50,15 @@ #' results_anova_merged <- merge(results_anova, results_anova_nocovar) #' head(results_anova_merged) registration_stats_anova <- - function(sce_pseudo, - block_cor, - covars = NULL, - var_registration = "registration_variable", - var_sample_id = "registration_sample_id", - gene_ensembl = NULL, - gene_name = NULL, - suffix = "") { + function( + sce_pseudo, + block_cor, + covars = NULL, + var_registration = "registration_variable", + var_sample_id = "registration_sample_id", + gene_ensembl = NULL, + gene_name = NULL, + suffix = "") { if (is.null(covars)) { mat_formula <- eval(str2expression(paste("~", var_registration))) } else { diff --git a/R/registration_stats_enrichment.R b/R/registration_stats_enrichment.R index d186547e..cd3ee182 100644 --- a/R/registration_stats_enrichment.R +++ b/R/registration_stats_enrichment.R @@ -34,14 +34,13 @@ #' ) #' head(results_enrichment_nan) registration_stats_enrichment <- - function( - sce_pseudo, - block_cor, - covars = NULL, - var_registration = "registration_variable", - var_sample_id = "registration_sample_id", - gene_ensembl = NULL, - gene_name = NULL) { + function(sce_pseudo, + block_cor, + covars = NULL, + var_registration = "registration_variable", + var_sample_id = "registration_sample_id", + gene_ensembl = NULL, + gene_name = NULL) { ## For each cluster, test it against the rest cluster_idx <- split(seq(along = sce_pseudo[[var_registration]]), sce_pseudo[[var_registration]]) diff --git a/R/registration_stats_pairwise.R b/R/registration_stats_pairwise.R index afb9771a..09bb3ff9 100644 --- a/R/registration_stats_pairwise.R +++ b/R/registration_stats_pairwise.R @@ -32,14 +32,13 @@ #' ) #' head(results_pairwise_nan) registration_stats_pairwise <- - function( - sce_pseudo, - registration_model, - block_cor, - var_registration = "registration_variable", - var_sample_id = "registration_sample_id", - gene_ensembl = NULL, - gene_name = NULL) { + function(sce_pseudo, + registration_model, + block_cor, + var_registration = "registration_variable", + var_sample_id = "registration_sample_id", + gene_ensembl = NULL, + gene_name = NULL) { ## Identify which are the pairwise columns of interest (aka, don't use ## the sample-level covariates we are adjusting for) and then ## shorten the names diff --git a/R/registration_wrapper.R b/R/registration_wrapper.R index 49896d78..38a1c297 100644 --- a/R/registration_wrapper.R +++ b/R/registration_wrapper.R @@ -50,16 +50,15 @@ #' "Cell_Cycle", "sample_id", c("age"), "ensembl", "gene_name", "wrapper" #' ) registration_wrapper <- - function( - sce, - var_registration, - var_sample_id, - covars = NULL, - gene_ensembl = NULL, - gene_name = NULL, - suffix = "", - min_ncells = 10, - pseudobulk_rds_file = NULL) { + function(sce, + var_registration, + var_sample_id, + covars = NULL, + gene_ensembl = NULL, + gene_name = NULL, + suffix = "", + min_ncells = 10, + pseudobulk_rds_file = NULL) { ## Change the rownames to ENSEMBL IDs rownames(sce) <- rowData(sce)[, gene_ensembl] diff --git a/R/run_app.R b/R/run_app.R index b7beae48..93701444 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -186,54 +186,55 @@ #' ## * https://github.com/LieberInstitute/spatialDLPFC/tree/main/code/deploy_app_k16 #' ## * https://github.com/LieberInstitute/spatialDLPFC/tree/main/code/analysis_IF/03_spatialLIBD_app #' } -run_app <- function(spe = fetch_data(type = "spe"), - sce_layer = fetch_data(type = "sce_layer"), - modeling_results = fetch_data(type = "modeling_results"), - sig_genes = sig_genes_extract_all( - n = nrow(sce_layer), - modeling_results = modeling_results, - sce_layer = sce_layer - ), - docs_path = system.file("app", "www", package = "spatialLIBD"), - title = "spatialLIBD", - spe_discrete_vars = c( - "spatialLIBD", - "GraphBased", - "ManualAnnotation", - "Maynard", - "Martinowich", - paste0("SNN_k50_k", 4:28), - "SpatialDE_PCA", - "SpatialDE_pool_PCA", - "HVG_PCA", - "pseudobulk_PCA", - "markers_PCA", - "SpatialDE_UMAP", - "SpatialDE_pool_UMAP", - "HVG_UMAP", - "pseudobulk_UMAP", - "markers_UMAP", - "SpatialDE_PCA_spatial", - "SpatialDE_pool_PCA_spatial", - "HVG_PCA_spatial", - "pseudobulk_PCA_spatial", - "markers_PCA_spatial", - "SpatialDE_UMAP_spatial", - "SpatialDE_pool_UMAP_spatial", - "HVG_UMAP_spatial", - "pseudobulk_UMAP_spatial", - "markers_UMAP_spatial" - ), - spe_continuous_vars = c( - "cell_count", - "sum_umi", - "sum_gene", - "expr_chrM", - "expr_chrM_ratio" - ), - default_cluster = "spatialLIBD", - auto_crop_default = TRUE, - ...) { +run_app <- function( + spe = fetch_data(type = "spe"), + sce_layer = fetch_data(type = "sce_layer"), + modeling_results = fetch_data(type = "modeling_results"), + sig_genes = sig_genes_extract_all( + n = nrow(sce_layer), + modeling_results = modeling_results, + sce_layer = sce_layer + ), + docs_path = system.file("app", "www", package = "spatialLIBD"), + title = "spatialLIBD", + spe_discrete_vars = c( + "spatialLIBD", + "GraphBased", + "ManualAnnotation", + "Maynard", + "Martinowich", + paste0("SNN_k50_k", 4:28), + "SpatialDE_PCA", + "SpatialDE_pool_PCA", + "HVG_PCA", + "pseudobulk_PCA", + "markers_PCA", + "SpatialDE_UMAP", + "SpatialDE_pool_UMAP", + "HVG_UMAP", + "pseudobulk_UMAP", + "markers_UMAP", + "SpatialDE_PCA_spatial", + "SpatialDE_pool_PCA_spatial", + "HVG_PCA_spatial", + "pseudobulk_PCA_spatial", + "markers_PCA_spatial", + "SpatialDE_UMAP_spatial", + "SpatialDE_pool_UMAP_spatial", + "HVG_UMAP_spatial", + "pseudobulk_UMAP_spatial", + "markers_UMAP_spatial" + ), + spe_continuous_vars = c( + "cell_count", + "sum_umi", + "sum_gene", + "expr_chrM", + "expr_chrM_ratio" + ), + default_cluster = "spatialLIBD", + auto_crop_default = TRUE, + ...) { ## Run the checks in the relevant order stopifnot(length(default_cluster) == 1) stopifnot(default_cluster %in% spe_discrete_vars) diff --git a/R/sig_genes_extract.R b/R/sig_genes_extract.R index b21902c1..fac5f65b 100644 --- a/R/sig_genes_extract.R +++ b/R/sig_genes_extract.R @@ -59,12 +59,11 @@ #' sce_layer = sce_layer, #' n = nrow(sce_layer) #' ) -sig_genes_extract <- function( - n = 10, - modeling_results = fetch_data(type = "modeling_results"), - model_type = names(modeling_results)[1], - reverse = FALSE, - sce_layer = fetch_data(type = "sce_layer")) { +sig_genes_extract <- function(n = 10, + modeling_results = fetch_data(type = "modeling_results"), + model_type = names(modeling_results)[1], + reverse = FALSE, + sce_layer = fetch_data(type = "sce_layer")) { model_results <- modeling_results[[model_type]] tstats <- diff --git a/R/sig_genes_extract_all.R b/R/sig_genes_extract_all.R index d2c3c01f..0d68b880 100644 --- a/R/sig_genes_extract_all.R +++ b/R/sig_genes_extract_all.R @@ -27,10 +27,9 @@ #' modeling_results = modeling_results, #' sce_layer = sce_layer #' ) -sig_genes_extract_all <- function( - n = 10, - modeling_results = fetch_data(type = "modeling_results"), - sce_layer = fetch_data(type = "sce_layer")) { +sig_genes_extract_all <- function(n = 10, + modeling_results = fetch_data(type = "modeling_results"), + sce_layer = fetch_data(type = "sce_layer")) { ## Run checks since this function is run by default by run_app() ## before the checks have been run elsewhere sce_layer <- check_sce_layer(sce_layer) diff --git a/R/vis_clus.R b/R/vis_clus.R index fb95c390..5e1cfc1a 100644 --- a/R/vis_clus.R +++ b/R/vis_clus.R @@ -93,31 +93,30 @@ #' ) #' print(p4) #' } -vis_clus <- function( - spe, - sampleid = unique(spe$sample_id)[1], - clustervar, - colors = c( - "#b2df8a", - "#e41a1c", - "#377eb8", - "#4daf4a", - "#ff7f00", - "gold", - "#a65628", - "#999999", - "black", - "grey", - "white", - "purple" - ), - spatial = TRUE, - image_id = "lowres", - alpha = NA, - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - ...) { +vis_clus <- function(spe, + sampleid = unique(spe$sample_id)[1], + clustervar, + colors = c( + "#b2df8a", + "#e41a1c", + "#377eb8", + "#4daf4a", + "#ff7f00", + "gold", + "#a65628", + "#999999", + "black", + "grey", + "white", + "purple" + ), + spatial = TRUE, + image_id = "lowres", + alpha = NA, + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + ...) { # Verify existence and legitimacy of 'sampleid' if ( !("sample_id" %in% colnames(colData(spe))) || diff --git a/R/vis_clus_p.R b/R/vis_clus_p.R index a91ce369..d2b37cec 100644 --- a/R/vis_clus_p.R +++ b/R/vis_clus_p.R @@ -42,18 +42,19 @@ #' rm(spe_sub) #' } vis_clus_p <- - function(spe, - d, - clustervar, - sampleid = unique(spe$sample_id)[1], - colors, - spatial, - title, - image_id = "lowres", - alpha = NA, - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40") { + function( + spe, + d, + clustervar, + sampleid = unique(spe$sample_id)[1], + colors, + spatial, + title, + image_id = "lowres", + alpha = NA, + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40") { ## Some variables pxl_row_in_fullres <- pxl_col_in_fullres <- key <- NULL # stopifnot(all(c("pxl_col_in_fullres", "pxl_row_in_fullres", "key") %in% colnames(d))) diff --git a/R/vis_gene.R b/R/vis_gene.R index 01119da4..594940af 100644 --- a/R/vis_gene.R +++ b/R/vis_gene.R @@ -158,22 +158,21 @@ #' print(p8) #' } vis_gene <- - function( - spe, - sampleid = unique(spe$sample_id)[1], - geneid = rowData(spe)$gene_search[1], - spatial = TRUE, - assayname = "logcounts", - minCount = 0, - viridis = TRUE, - image_id = "lowres", - alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - multi_gene_method = c("z_score", "pca", "sparsity"), - ...) { + function(spe, + sampleid = unique(spe$sample_id)[1], + geneid = rowData(spe)$gene_search[1], + spatial = TRUE, + assayname = "logcounts", + minCount = 0, + viridis = TRUE, + image_id = "lowres", + alpha = NA, + cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + multi_gene_method = c("z_score", "pca", "sparsity"), + ...) { multi_gene_method <- rlang::arg_match(multi_gene_method) # Verify existence and legitimacy of 'sampleid' if ( @@ -209,7 +208,7 @@ vis_gene <- } # Grab any continuous colData columns and verify they're all numeric - cont_cols = colData(spe_sub)[ + cont_cols <- colData(spe_sub)[ , geneid[geneid %in% colnames(colData(spe_sub))], drop = FALSE ] diff --git a/R/vis_gene_p.R b/R/vis_gene_p.R index e659d477..9bc3dc0a 100644 --- a/R/vis_gene_p.R +++ b/R/vis_gene_p.R @@ -48,23 +48,24 @@ #' rm(spe_sub) #' } vis_gene_p <- - function(spe, - d, - sampleid = unique(spe$sample_id)[1], - spatial, - title, - viridis = TRUE, - image_id = "lowres", - alpha = NA, - cont_colors = if (viridis) { - viridisLite::viridis(21) - } else { - c("aquamarine4", "springgreen", "goldenrod", "red") - }, - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - legend_title = "") { + function( + spe, + d, + sampleid = unique(spe$sample_id)[1], + spatial, + title, + viridis = TRUE, + image_id = "lowres", + alpha = NA, + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + c("aquamarine4", "springgreen", "goldenrod", "red") + }, + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + legend_title = "") { ## Some variables pxl_row_in_fullres <- pxl_col_in_fullres <- key <- COUNT <- NULL diff --git a/R/vis_grid_clus.R b/R/vis_grid_clus.R index 40ead6b3..8c81ace6 100644 --- a/R/vis_grid_clus.R +++ b/R/vis_grid_clus.R @@ -47,22 +47,23 @@ #' cowplot::plot_grid(plotlist = p_list, ncol = 2) #' } vis_grid_clus <- - function(spe, - clustervar, - pdf_file, - sort_clust = TRUE, - colors = NULL, - return_plots = FALSE, - spatial = TRUE, - height = 24, - width = 36, - image_id = "lowres", - alpha = NA, - sample_order = unique(spe$sample_id), - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - ...) { + function( + spe, + clustervar, + pdf_file, + sort_clust = TRUE, + colors = NULL, + return_plots = FALSE, + spatial = TRUE, + height = 24, + width = 36, + image_id = "lowres", + alpha = NA, + sample_order = unique(spe$sample_id), + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + ...) { stopifnot(all(sample_order %in% unique(spe$sample_id))) if (sort_clust) { diff --git a/R/vis_grid_gene.R b/R/vis_grid_gene.R index e21b5bf1..2504cce5 100644 --- a/R/vis_grid_gene.R +++ b/R/vis_grid_gene.R @@ -35,24 +35,25 @@ #' cowplot::plot_grid(plotlist = p_list, ncol = 2) #' } vis_grid_gene <- - function(spe, - geneid = rowData(spe)$gene_search[1], - pdf_file, - assayname = "logcounts", - minCount = 0, - return_plots = FALSE, - spatial = TRUE, - viridis = TRUE, - height = 24, - width = 36, - image_id = "lowres", - alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - sample_order = unique(spe$sample_id), - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - ...) { + function( + spe, + geneid = rowData(spe)$gene_search[1], + pdf_file, + assayname = "logcounts", + minCount = 0, + return_plots = FALSE, + spatial = TRUE, + viridis = TRUE, + height = 24, + width = 36, + image_id = "lowres", + alpha = NA, + cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), + sample_order = unique(spe$sample_id), + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + ...) { stopifnot(all(sample_order %in% unique(spe$sample_id))) plots <- lapply(sample_order, function(sampleid) { diff --git a/tests/testthat/test-vis_gene.R b/tests/testthat/test-vis_gene.R index 12960771..27a8dfdd 100644 --- a/tests/testthat/test-vis_gene.R +++ b/tests/testthat/test-vis_gene.R @@ -6,8 +6,9 @@ test_that( # Non-numeric column to plot expect_error( { - p = vis_gene( - spe, geneid = c('sum_umi', rownames(spe)[1], 'layer_guess') + p <- vis_gene( + spe, + geneid = c("sum_umi", rownames(spe)[1], "layer_guess") ) }, "'geneid' can not contain non-numeric colData columns\\." @@ -16,8 +17,9 @@ test_that( # Bad sample ID expect_error( { - p = vis_gene( - spe, geneid = c('sum_umi', rownames(spe)[1]), + p <- vis_gene( + spe, + geneid = c("sum_umi", rownames(spe)[1]), sampleid = "aaa" ) }, @@ -27,8 +29,9 @@ test_that( # Bad assayname expect_error( { - p = vis_gene( - spe, geneid = c('sum_umi', rownames(spe)[1]), + p <- vis_gene( + spe, + geneid = c("sum_umi", rownames(spe)[1]), assayname = "aaa" ) }, @@ -37,13 +40,15 @@ test_that( # Bad geneid expect_error( - { p = vis_gene(spe, geneid = 'aaa') }, + { + p <- vis_gene(spe, geneid = "aaa") + }, "Could not find the 'geneid'\\(s\\) aaa" ) # Trivially check success with legitimate input expect_equal( - class(vis_gene(spe, geneid = c('sum_umi', rownames(spe)[1]))), + class(vis_gene(spe, geneid = c("sum_umi", rownames(spe)[1]))), c("gg", "ggplot") ) }