From a778a4d3ab12b2b63e653ce4c913cc811cdc82c3 Mon Sep 17 00:00:00 2001 From: josschavezf Date: Fri, 15 Nov 2024 22:11:40 -0500 Subject: [PATCH 1/2] add biocstyle --- R/ONTraC_wrapper.R | 278 ++++----- R/auxiliary_giotto.R | 101 ++-- R/cell_segmentation.R | 117 ++-- R/clustering.R | 914 +++++++++++++++-------------- R/convenience_cosmx.R | 790 +++++++++++++------------ R/convenience_general.R | 335 ++++++----- R/convenience_visiumHD.R | 677 +++++++++++----------- R/convenience_xenium.R | 439 +++++++------- R/cross_section.R | 274 ++++----- R/dd.R | 34 +- R/differential_expression.R | 244 ++++---- R/dimension_reduction.R | 643 +++++++++++---------- R/feature_set_enrichment.R | 41 +- R/filter.R | 105 ++-- R/general_help.R | 263 +++++---- R/giotto_viewer.R | 115 ++-- R/gstop.R | 17 +- R/image_registration.R | 414 +++++++------ R/interactivity.R | 103 ++-- R/kriging.R | 46 +- R/normalize.R | 114 ++-- R/poly_influence.R | 50 +- R/python_hmrf.R | 268 ++++----- R/python_scrublet.R | 23 +- R/spatial_clusters.R | 55 +- R/spatial_enrichment.R | 457 ++++++++------- R/spatial_enrichment_visuals.R | 53 +- R/spatial_genes.R | 995 +++++++++++++++++--------------- R/spatial_interaction.R | 506 ++++++++-------- R/spatial_interaction_spot.R | 444 +++++++------- R/spatial_interaction_visuals.R | 852 ++++++++++++++------------- R/spdep.R | 17 +- R/variable_genes.R | 103 ++-- R/wnn.R | 44 +- 34 files changed, 5128 insertions(+), 4803 deletions(-) diff --git a/R/ONTraC_wrapper.R b/R/ONTraC_wrapper.R index a06c6a778..8666271f5 100644 --- a/R/ONTraC_wrapper.R +++ b/R/ONTraC_wrapper.R @@ -27,16 +27,15 @@ #' installGiottoONTraCEnvironment() #' #' @export -installGiottoONTraCEnvironment <- function( - python_version = "3.11.9", - ontrac_version = "latest", - mini_install_path = NULL, - confirm = TRUE, - envname = "giotto_ontrac_env", - conda = "auto", - force_miniconda = FALSE, - force_environment = FALSE, - verbose = NULL) { +installGiottoONTraCEnvironment <- function(python_version = "3.11.9", + ontrac_version = "latest", + mini_install_path = NULL, + confirm = TRUE, + envname = "giotto_ontrac_env", + conda = "auto", + force_miniconda = FALSE, + force_environment = FALSE, + verbose = NULL) { # handle ontrac version if (ontrac_version == "latest") { ontrac <- "ONTraC" @@ -93,12 +92,13 @@ installGiottoONTraCEnvironment <- function( #' cell_type = "custom_leiden" #' ) #' @export -getONTraCv1Input <- function(gobject, - cell_type, - output_path = getwd(), - spat_unit = NULL, - feat_type = NULL, - verbose = TRUE) { +getONTraCv1Input <- function( + gobject, + cell_type, + output_path = getwd(), + spat_unit = NULL, + feat_type = NULL, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -198,30 +198,29 @@ getONTraCv1Input <- function(gobject, #' envname = "giotto_ontrac_env" #' ) #' @export -runONTraCV1 <- function( - ONTraC_input, - dataset, - preprocessing_dir, - GNN_dir, - NTScore_dir, - n_cpu = 4L, - n_neighbors = 50L, - n_local = 20L, - device = c("cpu", "cuda"), - epochs = 1000L, - patience = 100L, - min_delta = 0.001, - min_epochs = 50L, - batch_size = 0L, - seed = 42L, - lr = 0.03, - hidden_feats = 4L, - k = 6L, - modularity_loss_weight = 0.3, - purity_loss_weight = 300.0, - regularization_loss_weight = 0.1, - beta = 0.03, - python_path = "giotto_ontrac_env") { +runONTraCV1 <- function(ONTraC_input, + dataset, + preprocessing_dir, + GNN_dir, + NTScore_dir, + n_cpu = 4L, + n_neighbors = 50L, + n_local = 20L, + device = c("cpu", "cuda"), + epochs = 1000L, + patience = 100L, + min_delta = 0.001, + min_epochs = 50L, + batch_size = 0L, + seed = 42L, + lr = 0.03, + hidden_feats = 4L, + k = 6L, + modularity_loss_weight = 0.3, + purity_loss_weight = 300.0, + regularization_loss_weight = 0.1, + beta = 0.03, + python_path = "giotto_ontrac_env") { # parameters check device <- match.arg(device) @@ -279,13 +278,14 @@ runONTraCV1 <- function( #' @param NTScore_reverse whether to reverse the NTScore. Default is FALSE #' @returns gobject with cell-level NT score #' @details This function loads the ONTraC outputed cell-level NT score -load_cell_NT_score <- function(gobject, - ontrac_results_dir = getwd(), - NTScore_dir = file.path( - ontrac_results_dir, - "NTScore_dir" - ), - NTScore_reverse = FALSE) { +load_cell_NT_score <- function( + gobject, + ontrac_results_dir = getwd(), + NTScore_dir = file.path( + ontrac_results_dir, + "NTScore_dir" + ), + NTScore_reverse = FALSE) { NT_score_df <- read.csv(file = file.path( NTScore_dir, "NTScore.csv.gz" ))[c("Cell_ID", "Cell_NTScore")] @@ -316,15 +316,16 @@ load_cell_NT_score <- function(gobject, #' @returns gobject with cell-niche cluster probability matrix #' @details This function loads the ONTraC outputed cell-niche cluster #' probability as an exprObj into the giotto object. -load_cell_niche_cluster_prob <- function(gobject, - ontrac_results_dir = getwd(), - GNN_dir = file.path( - ontrac_results_dir, - "GNN_dir" - ), - spat_unit = "cell", - feat_type = "niche cluster", - name = "prob") { +load_cell_niche_cluster_prob <- function( + gobject, + ontrac_results_dir = getwd(), + GNN_dir = file.path( + ontrac_results_dir, + "GNN_dir" + ), + spat_unit = "cell", + feat_type = "niche cluster", + name = "prob") { niche_cluster_prob_df <- read.csv(file = file.path( GNN_dir, "cell_level_niche_cluster.csv.gz" )) @@ -359,15 +360,16 @@ load_cell_niche_cluster_prob <- function(gobject, #' @returns gobject with niche cluster connectivity matrix #' @details This function loads the ONTraC outputed niche cluster connectivity #' matrix as an exprObj into the giotto object. -load_nc_connectivity <- function(gobject, - ontrac_results_dir = getwd(), - GNN_dir = file.path( - ontrac_results_dir, - "GNN_dir" - ), - spat_unit = "niche cluster", - feat_type = "connectivity", - name = "normalized") { +load_nc_connectivity <- function( + gobject, + ontrac_results_dir = getwd(), + GNN_dir = file.path( + ontrac_results_dir, + "GNN_dir" + ), + spat_unit = "niche cluster", + feat_type = "connectivity", + name = "normalized") { connectivity_df <- read.csv(file = file.path( GNN_dir, "consolidate_out_adj.csv.gz" ), header = FALSE) @@ -408,13 +410,14 @@ load_nc_connectivity <- function(gobject, #' @returns gobject with niche cluster NT score #' @details This function loads the ONTraC outputed niche cluster NT score #' into the giotto object. -load_niche_cluster_nt_score <- function(gobject, - ontrac_results_dir = getwd(), - NTScore_dir = file.path( - ontrac_results_dir, - "NTScore_dir" - ), - NTScore_reverse = FALSE) { +load_niche_cluster_nt_score <- function( + gobject, + ontrac_results_dir = getwd(), + NTScore_dir = file.path( + ontrac_results_dir, + "NTScore_dir" + ), + NTScore_reverse = FALSE) { niche_cluster_df <- read.csv(file = file.path( NTScore_dir, "niche_cluster_score.csv.gz" ), header = FALSE) @@ -452,10 +455,9 @@ load_niche_cluster_nt_score <- function(gobject, #' @inheritParams data_access_params #' @inheritParams read_data_params #' @returns gobject with binarized cell-level niche cluster assignment -cal_cell_niche_cluster_bin <- function( - gobject, - spat_unit = "cell", - feat_type = "niche cluster") { +cal_cell_niche_cluster_bin <- function(gobject, + spat_unit = "cell", + feat_type = "niche cluster") { # calculate the binarized cell-level niche cluster assignment expr_values <- getExpression( gobject = gobject, @@ -512,21 +514,22 @@ cal_cell_niche_cluster_bin <- function( #' @returns gobject with ONTraC results #' @details This function loads the ONTraC results into the giotto object. #' @export -loadOntraCResults <- function(gobject, - ontrac_results_dir = getwd(), - preprocessing_dir = file.path( - ontrac_results_dir, - "preprocessing_dir" - ), - GNN_dir = file.path( - ontrac_results_dir, - "GNN_dir" - ), - NTScore_dir = file.path( - ontrac_results_dir, - "NTScore_dir" - ), - NTScore_reverse = FALSE) { +loadOntraCResults <- function( + gobject, + ontrac_results_dir = getwd(), + preprocessing_dir = file.path( + ontrac_results_dir, + "preprocessing_dir" + ), + GNN_dir = file.path( + ontrac_results_dir, + "GNN_dir" + ), + NTScore_dir = file.path( + ontrac_results_dir, + "NTScore_dir" + ), + NTScore_reverse = FALSE) { gobject <- load_cell_NT_score( gobject = gobject, ontrac_results_dir = ontrac_results_dir, @@ -579,13 +582,12 @@ loadOntraCResults <- function(gobject, #' @details This function plots the spatial niche cluster probability #' @returns ggplot #' @export -plotSpatNicheClusterProb <- function( - gobject, - spat_unit = "cell", - feat_type = "niche cluster", - expression_values = "prob", - ..., - default_save_name = "spatNicheClusterProb") { +plotSpatNicheClusterProb <- function(gobject, + spat_unit = "cell", + feat_type = "niche cluster", + expression_values = "prob", + ..., + default_save_name = "spatNicheClusterProb") { nc_meta_df <- fDataDT( gobject = gobject, spat_unit = spat_unit, @@ -616,12 +618,11 @@ plotSpatNicheClusterProb <- function( #' @details This function plots the spatial niche cluster binarized #' @returns ggplot #' @export -plotSpatNicheClusterBin <- function( - gobject, - spat_unit = "cell", - feat_type = "niche cluster", - ..., - default_save_name = "spatNicheClusterBin") { +plotSpatNicheClusterBin <- function(gobject, + spat_unit = "cell", + feat_type = "niche cluster", + ..., + default_save_name = "spatNicheClusterBin") { # determine the color code nc_meta_df <- fDataDT( gobject = gobject, @@ -658,16 +659,15 @@ plotSpatNicheClusterBin <- function( #' @details This function plots the niche cluster connectivity matrix #' @returns ggplot #' @export -plotNicheClusterConnectivity <- function( - gobject, - spat_unit = "niche cluster", - feat_type = "connectivity", - values = "normalized", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "NicheClusterConnectivity") { +plotNicheClusterConnectivity <- function(gobject, + spat_unit = "niche cluster", + feat_type = "connectivity", + values = "normalized", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "NicheClusterConnectivity") { # load `guide_edge_colourbar` function in ggraph, # otherwise it will raise an error when using `scale_edge_colour_gradientn` library(ggraph) @@ -804,18 +804,17 @@ plotNicheClusterConnectivity <- function( #' cluster #' @returns ggplot #' @export -plotCTCompositionInNicheCluster <- function( - gobject, - cell_type, - values = "prob", - spat_unit = "cell", - feat_type = "niche cluster", - normalization = c("by_niche_cluster", "by_cell_type", NULL), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "CellTypeCompositionInNicheCluster") { +plotCTCompositionInNicheCluster <- function(gobject, + cell_type, + values = "prob", + spat_unit = "cell", + feat_type = "niche cluster", + normalization = c("by_niche_cluster", "by_cell_type", NULL), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "CellTypeCompositionInNicheCluster") { normalization <- match.arg(normalization) # Get the cell type composition within each niche cluster @@ -897,8 +896,8 @@ plotCTCompositionInNicheCluster <- function( ) avg_scores <- data_df %>% dplyr::group_by(!!rlang::sym(cell_type)) %>% - dplyr::summarise(Avg_NTScore = mean(NTScore)) - # nolint: object_usage_linter. + dplyr::summarise(Avg_NTScore = mean(NTScore)) + # nolint: object_usage_linter. df_long[[cell_type]] <- factor(df_long[[cell_type]], levels = avg_scores[[cell_type]][order(avg_scores$Avg_NTScore)] ) @@ -913,7 +912,7 @@ plotCTCompositionInNicheCluster <- function( viridis::scale_fill_viridis(option = "inferno", limits = c(0, 1)) + theme_minimal() + labs( - title = "Normalized cell type compositions within each niche + title = "Normalized cell type compositions within each niche cluster", x = "Cell_Type", y = "Cluster" @@ -942,16 +941,17 @@ plotCTCompositionInNicheCluster <- function( #' @inheritParams plot_output_params #' @returns ggplot #' @export -plotCellTypeNTScore <- function(gobject, - cell_type, - values = "NTScore", - spat_unit = "cell", - feat_type = "niche cluster", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "CellTypeNTScore") { +plotCellTypeNTScore <- function( + gobject, + cell_type, + values = "NTScore", + spat_unit = "cell", + feat_type = "niche cluster", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "CellTypeNTScore") { # Get the cell type composition within each niche cluster data_df <- pDataDT( gobject = gobject, diff --git a/R/auxiliary_giotto.R b/R/auxiliary_giotto.R index 84700ca94..cba88dd3d 100644 --- a/R/auxiliary_giotto.R +++ b/R/auxiliary_giotto.R @@ -26,15 +26,14 @@ #' #' adjustGiottoMatrix(g, covariate_columns = "leiden_clus") #' @export -adjustGiottoMatrix <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - batch_columns = NULL, - covariate_columns = NULL, - return_gobject = TRUE, - update_slot = c("custom")) { +adjustGiottoMatrix <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + batch_columns = NULL, + covariate_columns = NULL, + return_gobject = TRUE, + update_slot = c("custom")) { # Catch for both batch and covariate being null if (is.null(batch_columns) & is.null(covariate_columns)) { stop("Metadata for either different batches or covariates must be @@ -189,13 +188,12 @@ adjustGiottoMatrix <- function( #' adjust_params = list(covariate_columns = "leiden_clus") #' ) #' @export -processGiotto <- function( - gobject, - filter_params = list(), - norm_params = list(), - stat_params = list(), - adjust_params = list(), - verbose = TRUE) { +processGiotto <- function(gobject, + filter_params = list(), + norm_params = list(), + stat_params = list(), + adjust_params = list(), + verbose = TRUE) { # filter Giotto vmsg(.v = verbose, "1. start filter step") if (!inherits(filter_params, "list")) { @@ -281,14 +279,13 @@ processGiotto <- function( #' #' addFeatStatistics(g) #' @export -addFeatStatistics <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - detection_threshold = 0, - return_gobject = TRUE, - verbose = TRUE) { +addFeatStatistics <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + detection_threshold = 0, + return_gobject = TRUE, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -453,14 +450,13 @@ addFeatStatistics <- function( #' #' addCellStatistics(g) #' @export -addCellStatistics <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - detection_threshold = 0, - return_gobject = TRUE, - verbose = TRUE) { +addCellStatistics <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + detection_threshold = 0, + return_gobject = TRUE, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -601,14 +597,13 @@ addCellStatistics <- function( #' #' addStatistics(g) #' @export -addStatistics <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - detection_threshold = 0, - return_gobject = TRUE, - verbose = TRUE) { +addStatistics <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + detection_threshold = 0, + return_gobject = TRUE, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -675,14 +670,13 @@ addStatistics <- function( #' #' addFeatsPerc(g, feats = c("Gm19935", "9630013A20Rik", "2900040C04Rik")) #' @export -addFeatsPerc <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats = NULL, - vector_name = "feat_perc", - return_gobject = TRUE) { +addFeatsPerc <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats = NULL, + vector_name = "feat_perc", + return_gobject = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -772,12 +766,11 @@ addFeatsPerc <- function( #' source_cell_ids = c("AACTCGATGGCGCAGT-1", "GGCTGGCTAGCTTAAA-1") #' ) #' @export -findNetworkNeighbors <- function( - gobject, - spat_unit = NULL, - spatial_network_name = NULL, - source_cell_ids = NULL, - name = "nb_cells") { +findNetworkNeighbors <- function(gobject, + spat_unit = NULL, + spatial_network_name = NULL, + source_cell_ids = NULL, + name = "nb_cells") { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit diff --git a/R/cell_segmentation.R b/R/cell_segmentation.R index b9b9b1b4c..d7c7560c5 100644 --- a/R/cell_segmentation.R +++ b/R/cell_segmentation.R @@ -16,11 +16,12 @@ #' of the tile: sx (start x), ex (end x), sy, and ey. #' #' @export -doCellSegmentation <- function(raster_img, - folder_path, - reduce_resolution = 4, - overlapping_pixels = 50, - python_path = NULL) { +doCellSegmentation <- function( + raster_img, + folder_path, + reduce_resolution = 4, + overlapping_pixels = 50, + python_path = NULL) { package_check("deepcell", repository = "pip") package_check("PIL", repository = "pip") @@ -92,22 +93,22 @@ doCellSegmentation <- function(raster_img, #' @title perform cellpose segmentation #' @description #' -#' perform the Giotto Wrapper of cellpose segmentation. This is for a model -#' inference to generate segmentation mask file from input image. +#' perform the Giotto Wrapper of cellpose segmentation. This is for a model +#' inference to generate segmentation mask file from input image. #' main parameters needed #' @name doCellposeSegmentation -#' @param image_dir character, required. Provide a path to a gray scale or a +#' @param image_dir character, required. Provide a path to a gray scale or a #' three channel image. -#' @param python_path python environment with cellpose installed. +#' @param python_path python environment with cellpose installed. #' default = "giotto_cellpose". #' @param mask_output required. Provide a path to the output mask file. #' @param channel_1 channel number for cytoplasm, default to 0(gray scale) #' @param channel_2 channel number for Nuclei, default to 0(gray scale) -#' @param model_name Name of the model to run inference. Default to 'cyto3', -#' if you want to run cutomized trained model, place your model file in +#' @param model_name Name of the model to run inference. Default to 'cyto3', +#' if you want to run cutomized trained model, place your model file in #' ~/.cellpose/models and specify your model name. -#' @param batch_size Cellpose Parameter, Number of 224x224 patches to run -#' simultaneously on the GPU. Can make smaller or bigger depending on GPU +#' @param batch_size Cellpose Parameter, Number of 224x224 patches to run +#' simultaneously on the GPU. Can make smaller or bigger depending on GPU #' memory usage. Defaults to 8. #' @param resample Cellpose Parameter #' @param channel_axis Cellpose Parameter @@ -130,46 +131,50 @@ doCellSegmentation <- function(raster_img, #' @param interp Cellpose Parameter #' @param compute_masks Cellpose Parameter #' @param progress Cellpose Parameter -#' @returns No return variable, as this will write directly to output path +#' @returns No return variable, as this will write directly to output path #' provided. #' @examples #' # example code -#' doCellposeSegmentation(image_dir = input_image, -#' mask_output = output, channel_1 = 2, -#' channel_2 = 1, model_name = "cyto3", batch_size = 4) +#' doCellposeSegmentation( +#' image_dir = input_image, +#' mask_output = output, channel_1 = 2, +#' channel_2 = 1, model_name = "cyto3", batch_size = 4 +#' ) #' @export -doCellposeSegmentation <- function(python_env = "giotto_cellpose", - image_dir, - mask_output, - channel_1 = 0, - channel_2 = 0, - model_name = "cyto3", - batch_size = 8, - resample = TRUE, - channel_axis = NULL, - z_axis = NULL, - normalize = TRUE, - invert = FALSE, - rescale = NULL, - diameter = NULL, - flow_threshold = 0.4, - cellprob_threshold = 0.0, - do_3D = FALSE, - anisotropy = NULL, - stitch_threshold = 0.0, - min_size = 15, - niter = NULL, - augment = FALSE, - tile = TRUE, - tile_overlap = 0.1, - bsize = 224, - interp = TRUE, - compute_masks = TRUE, - progress = NULL, - verbose = TRUE, ...) { +doCellposeSegmentation <- function( + python_env = "giotto_cellpose", + image_dir, + mask_output, + channel_1 = 0, + channel_2 = 0, + model_name = "cyto3", + batch_size = 8, + resample = TRUE, + channel_axis = NULL, + z_axis = NULL, + normalize = TRUE, + invert = FALSE, + rescale = NULL, + diameter = NULL, + flow_threshold = 0.4, + cellprob_threshold = 0.0, + do_3D = FALSE, + anisotropy = NULL, + stitch_threshold = 0.0, + min_size = 15, + niter = NULL, + augment = FALSE, + tile = TRUE, + tile_overlap = 0.1, + bsize = 224, + interp = TRUE, + compute_masks = TRUE, + progress = NULL, + verbose = TRUE, ...) { # Check Input arguments model_name <- match.arg( - model_name, unique(c("cyto3", "cyto2", "cyto", "nuclei", model_name))) + model_name, unique(c("cyto3", "cyto2", "cyto", "nuclei", model_name)) + ) ## Load required python libraries GiottoClass::set_giotto_python_path(python_env) GiottoUtils::package_check("cellpose", repository = "pip") @@ -184,14 +189,18 @@ doCellposeSegmentation <- function(python_env = "giotto_cellpose", warning("GPU is not available for this session, inference may be slow.") } - GiottoUtils::vmsg(.v = verbose, .is_debug = FALSE, "Loading Image from ", - image_dir) + GiottoUtils::vmsg( + .v = verbose, .is_debug = FALSE, "Loading Image from ", + image_dir + ) img <- cellpose$io$imread(image_dir) GiottoUtils::vmsg(.v = verbose, .is_debug = FALSE, "Loading Model...") - model_to_seg <- cellpose$models$Cellpose(model_type = model_name, - gpu = torch$cuda$is_available()) + model_to_seg <- cellpose$models$Cellpose( + model_type = model_name, + gpu = torch$cuda$is_available() + ) channel_to_seg <- as.integer(c(channel_1, channel_2)) GiottoUtils::vmsg(.v = verbose, .is_debug = FALSE, "Segmenting Image...") @@ -223,8 +232,10 @@ doCellposeSegmentation <- function(python_env = "giotto_cellpose", progress = progress ) masks <- result[[1]] - GiottoUtils::vmsg(.v = verbose, .is_debug = FALSE, - "Segmentation finished... Saving mask file...") + GiottoUtils::vmsg( + .v = verbose, .is_debug = FALSE, + "Segmentation finished... Saving mask file..." + ) GiottoUtils::package_check("terra") rast <- terra::rast(masks) terra::writeRaster(rast, mask_output, overwrite = TRUE) diff --git a/R/clustering.R b/R/clustering.R index 7b11dcfa9..7cc71d97c 100644 --- a/R/clustering.R +++ b/R/clustering.R @@ -47,24 +47,25 @@ #' #' doLeidenCluster(g) #' @export -doLeidenCluster <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - name = "leiden_clus", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - python_path = NULL, - resolution = 1, - weight_col = "weight", - partition_type = c( - "RBConfigurationVertexPartition", - "ModularityVertexPartition" - ), - init_membership = NULL, - n_iterations = 1000, - return_gobject = TRUE, - set_seed = TRUE, - seed_number = 1234) { +doLeidenCluster <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + name = "leiden_clus", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + python_path = NULL, + resolution = 1, + weight_col = "weight", + partition_type = c( + "RBConfigurationVertexPartition", + "ModularityVertexPartition" + ), + init_membership = NULL, + n_iterations = 1000, + return_gobject = TRUE, + set_seed = TRUE, + seed_number = 1234) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -204,7 +205,9 @@ doLeidenCluster <- function(gobject, spat_unit = spat_unit, feat_type = feat_type, new_metadata = ident_clusters_DT[ - , c("cell_ID", name), with = FALSE], + , c("cell_ID", name), + with = FALSE + ], by_column = TRUE, column_cell_ID = "cell_ID" ) @@ -264,23 +267,24 @@ doLeidenCluster <- function(gobject, #' #' doLeidenClusterIgraph(g) #' @export -doLeidenClusterIgraph <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - name = "leiden_clus", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - objective_function = c("modularity", "CPM"), - weights = NULL, - resolution = 1, - resolution_parameter = deprecated(), - beta = 0.01, - initial_membership = NULL, - n_iterations = 1000, - return_gobject = TRUE, - set_seed = TRUE, - seed_number = 1234, - ...) { +doLeidenClusterIgraph <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + name = "leiden_clus", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + objective_function = c("modularity", "CPM"), + weights = NULL, + resolution = 1, + resolution_parameter = deprecated(), + beta = 0.01, + initial_membership = NULL, + n_iterations = 1000, + return_gobject = TRUE, + set_seed = TRUE, + seed_number = 1234, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -291,9 +295,9 @@ doLeidenClusterIgraph <- function(gobject, spat_unit = spat_unit, feat_type = feat_type ) - + resolution <- deprecate_param( - x = resolution_parameter, + x = resolution_parameter, y = resolution, fun = "doLeidenClusterIgraph", when = "4.1.4" @@ -380,7 +384,9 @@ doLeidenClusterIgraph <- function(gobject, spat_unit = spat_unit, feat_type = feat_type, new_metadata = ident_clusters_DT[ - , c("cell_ID", name), with = FALSE], + , c("cell_ID", name), + with = FALSE + ], by_column = TRUE, column_cell_ID = "cell_ID" ) @@ -437,17 +443,18 @@ doLeidenClusterIgraph <- function(gobject, #' show_plot = FALSE, save_plot = FALSE #' ) #' @export -doGiottoClustree <- function(gobject, - res_vector = NULL, - res_seq = NULL, - return_gobject = FALSE, - show_plot = NULL, - save_plot = NULL, - return_plot = NULL, - save_param = list(), - default_save_name = "clustree", - verbose = TRUE, - ...) { +doGiottoClustree <- function( + gobject, + res_vector = NULL, + res_seq = NULL, + return_gobject = FALSE, + show_plot = NULL, + save_plot = NULL, + return_plot = NULL, + save_param = list(), + default_save_name = "clustree", + verbose = TRUE, + ...) { package_check(pkg_name = "clustree", repository = "CRAN") ## setting resolutions to use if (is.null(res_vector)) { @@ -520,20 +527,21 @@ doGiottoClustree <- function(gobject, #' Set \emph{weight_col = NULL} to give equal weight (=1) to each edge. #' @md #' @keywords internal -.doLouvainCluster_community <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - name = "louvain_clus", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - python_path = NULL, - resolution = 1, - weight_col = NULL, - louv_random = FALSE, - return_gobject = TRUE, - set_seed = FALSE, - seed_number = 1234, - ...) { +.doLouvainCluster_community <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + name = "louvain_clus", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + python_path = NULL, + resolution = 1, + weight_col = NULL, + louv_random = FALSE, + return_gobject = TRUE, + set_seed = FALSE, + seed_number = 1234, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -666,7 +674,9 @@ doGiottoClustree <- function(gobject, spat_unit = spat_unit, feat_type = feat_type, new_metadata = ident_clusters_DT[ - , c("cell_ID", name), with = FALSE], + , c("cell_ID", name), + with = FALSE + ], by_column = TRUE, column_cell_ID = "cell_ID" ) @@ -723,17 +733,18 @@ doGiottoClustree <- function(gobject, #' in R for more information. #' #' @keywords internal -.doLouvainCluster_multinet <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - name = "louvain_clus", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - gamma = 1, - omega = 1, - return_gobject = TRUE, - set_seed = FALSE, - seed_number = 1234) { +.doLouvainCluster_multinet <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + name = "louvain_clus", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + gamma = 1, + omega = 1, + return_gobject = TRUE, + set_seed = FALSE, + seed_number = 1234) { if ("multinet" %in% rownames(installed.packages()) == FALSE) { stop( "package 'multinet' is not yet installed \n", @@ -833,7 +844,9 @@ doGiottoClustree <- function(gobject, spat_unit = spat_unit, feat_type = feat_type, new_metadata = ident_clusters_DT[ - , c("cell_ID", name), with = FALSE], + , c("cell_ID", name), + with = FALSE + ], by_column = TRUE, column_cell_ID = "cell_ID" ) @@ -903,23 +916,24 @@ doGiottoClustree <- function(gobject, #' #' doLouvainCluster(g) #' @export -doLouvainCluster <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - version = c("community", "multinet"), - name = "louvain_clus", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - python_path = NULL, - resolution = 1, - weight_col = NULL, - gamma = 1, - omega = 1, - louv_random = FALSE, - return_gobject = TRUE, - set_seed = FALSE, - seed_number = 1234, - ...) { +doLouvainCluster <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + version = c("community", "multinet"), + name = "louvain_clus", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + python_path = NULL, + resolution = 1, + weight_col = NULL, + gamma = 1, + omega = 1, + louv_random = FALSE, + return_gobject = TRUE, + set_seed = FALSE, + seed_number = 1234, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1002,16 +1016,17 @@ doLouvainCluster <- function(gobject, #' g <- doRandomWalkCluster(g) #' pDataDT(g) #' @export -doRandomWalkCluster <- function(gobject, - name = "random_walk_clus", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - walk_steps = 4, - walk_clusters = 10, - walk_weights = NA, - return_gobject = TRUE, - set_seed = FALSE, - seed_number = 1234) { +doRandomWalkCluster <- function( + gobject, + name = "random_walk_clus", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + walk_steps = 4, + walk_clusters = 10, + walk_weights = NA, + return_gobject = TRUE, + set_seed = FALSE, + seed_number = 1234) { ## get cell IDs ## cell_ID_vec <- gobject@cell_ID @@ -1098,17 +1113,18 @@ doRandomWalkCluster <- function(gobject, #' #' doSNNCluster(g) #' @export -doSNNCluster <- function(gobject, - name = "sNN_clus", - nn_network_to_use = "kNN", - network_name = "kNN.pca", - k = 20, - eps = 4, - minPts = 16, - borderPoints = TRUE, - return_gobject = TRUE, - set_seed = FALSE, - seed_number = 1234) { +doSNNCluster <- function( + gobject, + name = "sNN_clus", + nn_network_to_use = "kNN", + network_name = "kNN.pca", + k = 20, + eps = 4, + minPts = 16, + borderPoints = TRUE, + return_gobject = TRUE, + set_seed = FALSE, + seed_number = 1234) { ## get cell IDs ## cell_ID_vec <- gobject@cell_ID @@ -1242,28 +1258,28 @@ doSNNCluster <- function(gobject, #' #' doKmeans(g) #' @export -doKmeans <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats_to_use = NULL, - dim_reduction_to_use = c("cells", "pca", "umap", "tsne"), - dim_reduction_name = "pca", - dimensions_to_use = 1:10, - distance_method = c( - "original", "pearson", "spearman", - "euclidean", "maximum", "manhattan", - "canberra", "binary", "minkowski" - ), - centers = 10, - iter_max = 100, - nstart = 1000, - algorithm = "Hartigan-Wong", - name = "kmeans", - return_gobject = TRUE, - set_seed = TRUE, - seed_number = 1234) { - +doKmeans <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats_to_use = NULL, + dim_reduction_to_use = c("cells", "pca", "umap", "tsne"), + dim_reduction_name = "pca", + dimensions_to_use = 1:10, + distance_method = c( + "original", "pearson", "spearman", + "euclidean", "maximum", "manhattan", + "canberra", "binary", "minkowski" + ), + centers = 10, + iter_max = 100, + nstart = 1000, + algorithm = "Hartigan-Wong", + name = "kmeans", + return_gobject = TRUE, + set_seed = TRUE, + seed_number = 1234) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1397,7 +1413,9 @@ doKmeans <- function(gobject, spat_unit = spat_unit, feat_type = feat_type, new_metadata = ident_clusters_DT[ - , c("cell_ID", name), with = FALSE], + , c("cell_ID", name), + with = FALSE + ], by_column = TRUE, column_cell_ID = "cell_ID" ) @@ -1443,30 +1461,31 @@ doKmeans <- function(gobject, #' #' doHclust(g) #' @export -doHclust <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats_to_use = NULL, - dim_reduction_to_use = c("cells", "pca", "umap", "tsne"), - dim_reduction_name = "pca", - dimensions_to_use = 1:10, - distance_method = c( - "pearson", "spearman", "original", - "euclidean", "maximum", "manhattan", - "canberra", "binary", "minkowski" - ), - agglomeration_method = c( - "ward.D2", "ward.D", "single", - "complete", "average", "mcquitty", - "median", "centroid" - ), - k = 10, - h = NULL, - name = "hclust", - return_gobject = TRUE, - set_seed = TRUE, - seed_number = 1234) { +doHclust <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats_to_use = NULL, + dim_reduction_to_use = c("cells", "pca", "umap", "tsne"), + dim_reduction_name = "pca", + dimensions_to_use = 1:10, + distance_method = c( + "pearson", "spearman", "original", + "euclidean", "maximum", "manhattan", + "canberra", "binary", "minkowski" + ), + agglomeration_method = c( + "ward.D2", "ward.D", "single", + "complete", "average", "mcquitty", + "median", "centroid" + ), + k = 10, + h = NULL, + name = "hclust", + return_gobject = TRUE, + set_seed = TRUE, + seed_number = 1234) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1503,7 +1522,6 @@ doHclust <- function(gobject, ## using dimension reduction ## if (dim_reduction_to_use != "cells" && !is.null(dim_reduction_to_use)) { - # use only available dimensions if dimensions < dimensions_to_use dim_coord <- getDimReduction( gobject = gobject, @@ -1611,7 +1629,9 @@ doHclust <- function(gobject, feat_type = feat_type, spat_unit = spat_unit, new_metadata = ident_clusters_DT[ - , c("cell_ID", name), with = FALSE], + , c("cell_ID", name), + with = FALSE + ], by_column = TRUE, column_cell_ID = "cell_ID" ) @@ -1687,61 +1707,62 @@ doHclust <- function(gobject, #' #' clusterCells(g) #' @export -clusterCells <- function(gobject, - cluster_method = c( - "leiden", - "louvain_community", "louvain_multinet", - "randomwalk", "sNNclust", - "kmeans", "hierarchical" - ), - name = "cluster_name", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - pyth_leid_resolution = 1, - pyth_leid_weight_col = "weight", - pyth_leid_part_type = c( - "RBConfigurationVertexPartition", - "ModularityVertexPartition" - ), - pyth_leid_init_memb = NULL, - pyth_leid_iterations = 1000, - pyth_louv_resolution = 1, - pyth_louv_weight_col = NULL, - python_louv_random = FALSE, - python_path = NULL, - louvain_gamma = 1, - louvain_omega = 1, - walk_steps = 4, - walk_clusters = 10, - walk_weights = NA, - sNNclust_k = 20, - sNNclust_eps = 4, - sNNclust_minPts = 16, - borderPoints = TRUE, - expression_values = c("normalized", "scaled", "custom"), - feats_to_use = NULL, - dim_reduction_to_use = c("cells", "pca", "umap", "tsne"), - dim_reduction_name = "pca", - dimensions_to_use = 1:10, - distance_method = c( - "original", "pearson", "spearman", - "euclidean", "maximum", "manhattan", - "canberra", "binary", "minkowski" - ), - km_centers = 10, - km_iter_max = 100, - km_nstart = 1000, - km_algorithm = "Hartigan-Wong", - hc_agglomeration_method = c( - "ward.D2", "ward.D", "single", - "complete", "average", "mcquitty", - "median", "centroid" - ), - hc_k = 10, - hc_h = NULL, - return_gobject = TRUE, - set_seed = TRUE, - seed_number = 1234) { +clusterCells <- function( + gobject, + cluster_method = c( + "leiden", + "louvain_community", "louvain_multinet", + "randomwalk", "sNNclust", + "kmeans", "hierarchical" + ), + name = "cluster_name", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + pyth_leid_resolution = 1, + pyth_leid_weight_col = "weight", + pyth_leid_part_type = c( + "RBConfigurationVertexPartition", + "ModularityVertexPartition" + ), + pyth_leid_init_memb = NULL, + pyth_leid_iterations = 1000, + pyth_louv_resolution = 1, + pyth_louv_weight_col = NULL, + python_louv_random = FALSE, + python_path = NULL, + louvain_gamma = 1, + louvain_omega = 1, + walk_steps = 4, + walk_clusters = 10, + walk_weights = NA, + sNNclust_k = 20, + sNNclust_eps = 4, + sNNclust_minPts = 16, + borderPoints = TRUE, + expression_values = c("normalized", "scaled", "custom"), + feats_to_use = NULL, + dim_reduction_to_use = c("cells", "pca", "umap", "tsne"), + dim_reduction_name = "pca", + dimensions_to_use = 1:10, + distance_method = c( + "original", "pearson", "spearman", + "euclidean", "maximum", "manhattan", + "canberra", "binary", "minkowski" + ), + km_centers = 10, + km_iter_max = 100, + km_nstart = 1000, + km_algorithm = "Hartigan-Wong", + hc_agglomeration_method = c( + "ward.D2", "ward.D", "single", + "complete", "average", "mcquitty", + "median", "centroid" + ), + hc_k = 10, + hc_h = NULL, + return_gobject = TRUE, + set_seed = TRUE, + seed_number = 1234) { ## select cluster method cluster_method <- match.arg( arg = cluster_method, @@ -1947,41 +1968,40 @@ NULL #' @rdname subClusterCells #' @export -subClusterCells <- function( - gobject, - name = "sub_clus", - cluster_method = c( - "leiden", - "louvain_community", - "louvain_multinet" - ), - cluster_column = NULL, - selected_clusters = NULL, - hvg_param = deprecated(), - hvf_param = list( - reverse_log_scale = TRUE, difference_in_cov = 1, - expression_values = "normalized" - ), - hvg_min_perc_cells = deprecated(), - hvf_min_perc_cells = 5, - hvg_mean_expr_det = deprecated(), - hvf_mean_expr_det = 1, - use_all_genes_as_hvg = deprecated(), - use_all_feats_as_hvf = FALSE, - min_nr_of_hvg = deprecated(), - min_nr_of_hvf = 5, - pca_param = list(expression_values = "normalized", scale_unit = TRUE), - nn_param = list(dimensions_to_use = 1:20), - k_neighbors = 10, - resolution = 1, - n_iterations = 1000, - gamma = 1, - omega = 1, - python_path = NULL, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - return_gobject = TRUE, - verbose = TRUE) { +subClusterCells <- function(gobject, + name = "sub_clus", + cluster_method = c( + "leiden", + "louvain_community", + "louvain_multinet" + ), + cluster_column = NULL, + selected_clusters = NULL, + hvg_param = deprecated(), + hvf_param = list( + reverse_log_scale = TRUE, difference_in_cov = 1, + expression_values = "normalized" + ), + hvg_min_perc_cells = deprecated(), + hvf_min_perc_cells = 5, + hvg_mean_expr_det = deprecated(), + hvf_mean_expr_det = 1, + use_all_genes_as_hvg = deprecated(), + use_all_feats_as_hvf = FALSE, + min_nr_of_hvg = deprecated(), + min_nr_of_hvf = 5, + pca_param = list(expression_values = "normalized", scale_unit = TRUE), + nn_param = list(dimensions_to_use = 1:20), + k_neighbors = 10, + resolution = 1, + n_iterations = 1000, + gamma = 1, + omega = 1, + python_path = NULL, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + return_gobject = TRUE, + verbose = TRUE) { ## select cluster method cluster_method <- match.arg(arg = cluster_method, choices = c( "leiden", @@ -2000,8 +2020,10 @@ subClusterCells <- function( hvf_param <- .dep_param(hvg_param, hvf_param) hvf_min_perc_cells <- .dep_param(hvg_min_perc_cells, hvf_min_perc_cells) hvf_mean_expr_det <- .dep_param(hvg_mean_expr_det, hvf_mean_expr_det) - use_all_feats_as_hvf <- .dep_param(use_all_genes_as_hvg, - use_all_feats_as_hvf) + use_all_feats_as_hvf <- .dep_param( + use_all_genes_as_hvg, + use_all_feats_as_hvf + ) min_nr_of_hvf <- .dep_param(min_nr_of_hvg, min_nr_of_hvf) # gather common args @@ -2068,35 +2090,36 @@ subClusterCells <- function( #' @param toplevel do not use #' @param feat_type feature type #' @export -doLeidenSubCluster <- function(gobject, - feat_type = NULL, - name = "sub_leiden_clus", - cluster_column = NULL, - selected_clusters = NULL, - hvf_param = list( - reverse_log_scale = TRUE, difference_in_cov = 1, - expression_values = "normalized" - ), - hvg_param = deprecated(), - hvf_min_perc_cells = 5, - hvg_min_perc_cells = deprecated(), - hvf_mean_expr_det = 1, - hvg_mean_expr_det = deprecated(), - use_all_feats_as_hvf = FALSE, - use_all_genes_as_hvg = deprecated(), - min_nr_of_hvf = 5, - min_nr_of_hvg = deprecated(), - pca_param = list(expression_values = "normalized", scale_unit = TRUE), - nn_param = list(dimensions_to_use = 1:20), - k_neighbors = 10, - resolution = 0.5, - n_iterations = 500, - python_path = NULL, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - return_gobject = TRUE, - toplevel = 2, - verbose = TRUE) { +doLeidenSubCluster <- function( + gobject, + feat_type = NULL, + name = "sub_leiden_clus", + cluster_column = NULL, + selected_clusters = NULL, + hvf_param = list( + reverse_log_scale = TRUE, difference_in_cov = 1, + expression_values = "normalized" + ), + hvg_param = deprecated(), + hvf_min_perc_cells = 5, + hvg_min_perc_cells = deprecated(), + hvf_mean_expr_det = 1, + hvg_mean_expr_det = deprecated(), + use_all_feats_as_hvf = FALSE, + use_all_genes_as_hvg = deprecated(), + min_nr_of_hvf = 5, + min_nr_of_hvg = deprecated(), + pca_param = list(expression_values = "normalized", scale_unit = TRUE), + nn_param = list(dimensions_to_use = 1:20), + k_neighbors = 10, + resolution = 0.5, + n_iterations = 500, + python_path = NULL, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + return_gobject = TRUE, + toplevel = 2, + verbose = TRUE) { # specify feat_type if (is.null(feat_type)) { feat_type <- gobject@expression_feat[[1]] @@ -2113,8 +2136,10 @@ doLeidenSubCluster <- function(gobject, hvf_param <- .dep_param(hvg_param, hvf_param) hvf_min_perc_cells <- .dep_param(hvg_min_perc_cells, hvf_min_perc_cells) hvf_mean_expr_det <- .dep_param(hvg_mean_expr_det, hvf_mean_expr_det) - use_all_feats_as_hvf <- .dep_param(use_all_genes_as_hvg, - use_all_feats_as_hvf) + use_all_feats_as_hvf <- .dep_param( + use_all_genes_as_hvg, + use_all_feats_as_hvf + ) min_nr_of_hvf <- .dep_param(min_nr_of_hvg, min_nr_of_hvf) @@ -2270,28 +2295,29 @@ doLeidenSubCluster <- function(gobject, # subcluster cells using a NN-network and the Louvain community # detection algorithm -.doLouvainSubCluster_community <- function(gobject, - name = "sub_louvain_comm_clus", - cluster_column = NULL, - selected_clusters = NULL, - hvf_param = list( - reverse_log_scale = TRUE, - difference_in_cov = 1, - expression_values = "normalized" - ), - hvf_min_perc_cells = 5, - hvf_mean_expr_det = 1, - use_all_feats_as_hvf = FALSE, - min_nr_of_hvf = 5, - pca_param = list(expression_values = "normalized", scale_unit = TRUE), - nn_param = list(dimensions_to_use = 1:20), - k_neighbors = 10, - resolution = 0.5, - python_path = NULL, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - return_gobject = TRUE, - verbose = TRUE) { +.doLouvainSubCluster_community <- function( + gobject, + name = "sub_louvain_comm_clus", + cluster_column = NULL, + selected_clusters = NULL, + hvf_param = list( + reverse_log_scale = TRUE, + difference_in_cov = 1, + expression_values = "normalized" + ), + hvf_min_perc_cells = 5, + hvf_mean_expr_det = 1, + use_all_feats_as_hvf = FALSE, + min_nr_of_hvf = 5, + pca_param = list(expression_values = "normalized", scale_unit = TRUE), + nn_param = list(dimensions_to_use = 1:20), + k_neighbors = 10, + resolution = 0.5, + python_path = NULL, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + return_gobject = TRUE, + verbose = TRUE) { iter_list <- list() cell_metadata <- pDataDT(gobject) @@ -2454,27 +2480,28 @@ doLeidenSubCluster <- function(gobject, # subcluster cells using a NN-network and the Louvain multinet # detection algorithm -.doLouvainSubCluster_multinet <- function(gobject, - name = "sub_louvain_mult_clus", - cluster_column = NULL, - selected_clusters = NULL, - hvf_param = list( - reverse_log_scale = TRUE, difference_in_cov = 1, - expression_values = "normalized" - ), - hvf_min_perc_cells = 5, - hvf_mean_expr_det = 1, - use_all_feats_as_hvf = FALSE, - min_nr_of_hvf = 5, - pca_param = list(expression_values = "normalized", scale_unit = TRUE), - nn_param = list(dimensions_to_use = 1:20), - k_neighbors = 10, - gamma = 1, - omega = 1, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - return_gobject = TRUE, - verbose = TRUE) { +.doLouvainSubCluster_multinet <- function( + gobject, + name = "sub_louvain_mult_clus", + cluster_column = NULL, + selected_clusters = NULL, + hvf_param = list( + reverse_log_scale = TRUE, difference_in_cov = 1, + expression_values = "normalized" + ), + hvf_min_perc_cells = 5, + hvf_mean_expr_det = 1, + use_all_feats_as_hvf = FALSE, + min_nr_of_hvf = 5, + pca_param = list(expression_values = "normalized", scale_unit = TRUE), + nn_param = list(dimensions_to_use = 1:20), + k_neighbors = 10, + gamma = 1, + omega = 1, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + return_gobject = TRUE, + verbose = TRUE) { if ("multinet" %in% rownames(installed.packages()) == FALSE) { stop( "package 'multinet' is not yet installed \n", @@ -2645,35 +2672,36 @@ doLeidenSubCluster <- function(gobject, #' @param version version of Louvain algorithm to use. One of "community" or #' "multinet", with the default being "community" #' @export -doLouvainSubCluster <- function(gobject, - name = "sub_louvain_clus", - version = c("community", "multinet"), - cluster_column = NULL, - selected_clusters = NULL, - hvg_param = deprecated(), - hvf_param = list( - reverse_log_scale = TRUE, difference_in_cov = 1, - expression_values = "normalized" - ), - hvg_min_perc_cells = deprecated(), - hvf_min_perc_cells = 5, - hvg_mean_expr_det = deprecated(), - hvf_mean_expr_det = 1, - use_all_genes_as_hvg = deprecated(), - use_all_feats_as_hvf = FALSE, - min_nr_of_hvg = deprecated(), - min_nr_of_hvf = 5, - pca_param = list(expression_values = "normalized", scale_unit = TRUE), - nn_param = list(dimensions_to_use = 1:20), - k_neighbors = 10, - resolution = 0.5, - gamma = 1, - omega = 1, - python_path = NULL, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - return_gobject = TRUE, - verbose = TRUE) { +doLouvainSubCluster <- function( + gobject, + name = "sub_louvain_clus", + version = c("community", "multinet"), + cluster_column = NULL, + selected_clusters = NULL, + hvg_param = deprecated(), + hvf_param = list( + reverse_log_scale = TRUE, difference_in_cov = 1, + expression_values = "normalized" + ), + hvg_min_perc_cells = deprecated(), + hvf_min_perc_cells = 5, + hvg_mean_expr_det = deprecated(), + hvf_mean_expr_det = 1, + use_all_genes_as_hvg = deprecated(), + use_all_feats_as_hvf = FALSE, + min_nr_of_hvg = deprecated(), + min_nr_of_hvf = 5, + pca_param = list(expression_values = "normalized", scale_unit = TRUE), + nn_param = list(dimensions_to_use = 1:20), + k_neighbors = 10, + resolution = 0.5, + gamma = 1, + omega = 1, + python_path = NULL, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + return_gobject = TRUE, + verbose = TRUE) { ## louvain clustering version to use version <- match.arg(version, c("community", "multinet")) @@ -2688,8 +2716,10 @@ doLouvainSubCluster <- function(gobject, hvf_param <- .dep_param(hvg_param, hvf_param) hvf_min_perc_cells <- .dep_param(hvg_min_perc_cells, hvf_min_perc_cells) hvf_mean_expr_det <- .dep_param(hvg_mean_expr_det, hvf_mean_expr_det) - use_all_feats_as_hvf <- .dep_param(use_all_genes_as_hvg, - use_all_feats_as_hvf) + use_all_feats_as_hvf <- .dep_param( + use_all_genes_as_hvg, + use_all_feats_as_hvf + ) min_nr_of_hvf <- .dep_param(min_nr_of_hvg, min_nr_of_hvf) # get common args @@ -2766,12 +2796,13 @@ doLouvainSubCluster <- function(gobject, #' #' getClusterSimilarity(g, cluster_column = "leiden_clus") #' @export -getClusterSimilarity <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - cor = c("pearson", "spearman")) { +getClusterSimilarity <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + cor = c("pearson", "spearman")) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2890,19 +2921,20 @@ getClusterSimilarity <- function(gobject, #' #' mergeClusters(g, cluster_column = "leiden_clus") #' @export -mergeClusters <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - cor = c("pearson", "spearman"), - new_cluster_name = "merged_cluster", - min_cor_score = 0.8, - max_group_size = 20, - force_min_group_size = 10, - max_sim_clusters = 10, - return_gobject = TRUE, - verbose = TRUE) { +mergeClusters <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + cor = c("pearson", "spearman"), + new_cluster_name = "merged_cluster", + min_cor_score = 0.8, + max_group_size = 20, + force_min_group_size = 10, + max_sim_clusters = 10, + return_gobject = TRUE, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -3180,17 +3212,18 @@ mergeClusters <- function(gobject, #' #' getDendrogramSplits(g, cluster_column = "leiden_clus") #' @export -getDendrogramSplits <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - cor = c("pearson", "spearman"), - distance = "ward.D", - h = NULL, - h_color = "red", - show_dend = TRUE, - verbose = TRUE) { +getDendrogramSplits <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + cor = c("pearson", "spearman"), + distance = "ward.D", + h = NULL, + h_color = "red", + show_dend = TRUE, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -3326,24 +3359,27 @@ getDendrogramSplits <- function(gobject, #' @md NULL -setGeneric("labelTransfer", - function(x, y, ...) standardGeneric("labelTransfer")) +setGeneric( + "labelTransfer", + function(x, y, ...) standardGeneric("labelTransfer") +) #' @rdname labelTransfer #' @export -setMethod("labelTransfer", signature(x = "giotto", y = "giotto"), function(x, y, - spat_unit = NULL, - feat_type = NULL, - labels, - k = 10, - name = paste0("trnsfr_", labels), - prob = TRUE, - reduction = "cells", - reduction_method = "pca", - reduction_name = "pca", - dimensions_to_use = 1:10, - return_gobject = TRUE, - ...) { +setMethod("labelTransfer", signature(x = "giotto", y = "giotto"), function( + x, y, + spat_unit = NULL, + feat_type = NULL, + labels, + k = 10, + name = paste0("trnsfr_", labels), + prob = TRUE, + reduction = "cells", + reduction_method = "pca", + reduction_name = "pca", + dimensions_to_use = 1:10, + return_gobject = TRUE, + ...) { # NSE vars temp_name <- cell_ID <- temp_name_prob <- NULL @@ -3457,21 +3493,22 @@ setMethod("labelTransfer", signature(x = "giotto", y = "giotto"), function(x, y, #' @rdname labelTransfer #' @export -setMethod("labelTransfer", signature(x = "giotto", y = "missing"), function(x, - spat_unit = NULL, - feat_type = NULL, - source_cell_ids, - target_cell_ids, - labels, - k = 10, - name = paste0("trnsfr_", labels), - prob = TRUE, - reduction = "cells", - reduction_method = "pca", - reduction_name = "pca", - dimensions_to_use = 1:10, - return_gobject = TRUE, - ...) { +setMethod("labelTransfer", signature(x = "giotto", y = "missing"), function( + x, + spat_unit = NULL, + feat_type = NULL, + source_cell_ids, + target_cell_ids, + labels, + k = 10, + name = paste0("trnsfr_", labels), + prob = TRUE, + reduction = "cells", + reduction_method = "pca", + reduction_name = "pca", + dimensions_to_use = 1:10, + return_gobject = TRUE, + ...) { # NSE vars temp_name <- cell_ID <- temp_name_prob <- NULL @@ -3634,23 +3671,24 @@ setMethod("labelTransfer", signature(x = "giotto", y = "missing"), function(x, #' source_cluster_labels = "leiden_clus" #' ) #' @export -doClusterProjection <- function(target_gobject, - target_cluster_label_name = "knn_labels", - spat_unit = NULL, - feat_type = NULL, - source_gobject, - source_cluster_labels = NULL, - reduction = "cells", - reduction_method = "pca", - reduction_name = "pca", - dimensions_to_use = 1:10, - knn_k = 10, - prob = FALSE, - algorithm = c( - "kd_tree", - "cover_tree", "brute" - ), - return_gobject = TRUE) { +doClusterProjection <- function( + target_gobject, + target_cluster_label_name = "knn_labels", + spat_unit = NULL, + feat_type = NULL, + source_gobject, + source_cluster_labels = NULL, + reduction = "cells", + reduction_method = "pca", + reduction_name = "pca", + dimensions_to_use = 1:10, + knn_k = 10, + prob = FALSE, + algorithm = c( + "kd_tree", + "cover_tree", "brute" + ), + return_gobject = TRUE) { deprecate_warn( when = "4.1.2", what = "doClusterProjection()", diff --git a/R/convenience_cosmx.R b/R/convenience_cosmx.R index de4c8be65..01f0dd22c 100644 --- a/R/convenience_cosmx.R +++ b/R/convenience_cosmx.R @@ -133,8 +133,8 @@ setMethod( #' force(g) #' } #' @export -importCosMx <- function(cosmx_dir = NULL, slide = 1, fovs = NULL, - micron = FALSE, px2mm = 0.12028) { +importCosMx <- function(cosmx_dir = NULL, slide = 1, fovs = NULL, + micron = FALSE, px2mm = 0.12028) { # get params a <- list(Class = "CosmxReader") if (!is.null(cosmx_dir)) { @@ -151,310 +151,318 @@ importCosMx <- function(cosmx_dir = NULL, slide = 1, fovs = NULL, } # * init #### -setMethod("initialize", signature("CosmxReader"), - function(.Object, cosmx_dir, slide, fovs, micron, px2mm) { - # provided params (if any) - if (!missing(cosmx_dir)) { - checkmate::assert_directory_exists(cosmx_dir) - .Object@cosmx_dir <- cosmx_dir - } - if (!missing(slide)) { - .Object@slide <- slide - } - if (!missing(fovs)) { - .Object@fovs <- fovs - } - if (!missing(micron)) { - .Object@micron <- micron - } - if (!missing(px2mm)) { - .Object@px2mm <- px2mm - } +setMethod( + "initialize", signature("CosmxReader"), + function(.Object, cosmx_dir, slide, fovs, micron, px2mm) { + # provided params (if any) + if (!missing(cosmx_dir)) { + checkmate::assert_directory_exists(cosmx_dir) + .Object@cosmx_dir <- cosmx_dir + } + if (!missing(slide)) { + .Object@slide <- slide + } + if (!missing(fovs)) { + .Object@fovs <- fovs + } + if (!missing(micron)) { + .Object@micron <- micron + } + if (!missing(px2mm)) { + .Object@px2mm <- px2mm + } - # NULL case - if (length(.Object@cosmx_dir) == 0) { - return(.Object) # return early if no path given - } + # NULL case + if (length(.Object@cosmx_dir) == 0) { + return(.Object) # return early if no path given + } - # detect paths and subdirs - p <- .Object@cosmx_dir - .cosmx_detect <- function(pattern) { - .detect_in_dir(pattern = pattern, path = p, platform = "CosMx") - } + # detect paths and subdirs + p <- .Object@cosmx_dir + .cosmx_detect <- function(pattern) { + .detect_in_dir(pattern = pattern, path = p, platform = "CosMx") + } - shifts_path <- .cosmx_detect("fov_positions_file") - meta_path <- .cosmx_detect("metadata_file") - tx_path <- .cosmx_detect("tx_file") - mask_dir <- .cosmx_detect("CellLabels") - expr_path <- .cosmx_detect("exprMat_file") - composite_img_dir <- .cosmx_detect("CellComposite") - overlay_img_dir <- .cosmx_detect("CellOverlay") - compart_img_dir <- .cosmx_detect("CompartmentLabels") - - - # load fov offsets through one of several methods - if (is.null(.Object@offsets)) { # only run if not already existing - pos <- NULL - - if (!is.null(shifts_path)) { - fov_shifts <- data.table::fread(shifts_path) - if (!"X_mm" %in% colnames(fov_shifts)) { - # older version has fov, x, y (all numeric) in px shifts - data.table::setnames(fov_shifts, new = c("fov", "x", "y")) - pos <- fov_shifts + shifts_path <- .cosmx_detect("fov_positions_file") + meta_path <- .cosmx_detect("metadata_file") + tx_path <- .cosmx_detect("tx_file") + mask_dir <- .cosmx_detect("CellLabels") + expr_path <- .cosmx_detect("exprMat_file") + composite_img_dir <- .cosmx_detect("CellComposite") + overlay_img_dir <- .cosmx_detect("CellOverlay") + compart_img_dir <- .cosmx_detect("CompartmentLabels") + + + # load fov offsets through one of several methods + if (is.null(.Object@offsets)) { # only run if not already existing + pos <- NULL + + if (!is.null(shifts_path)) { + fov_shifts <- data.table::fread(shifts_path) + if (!"X_mm" %in% colnames(fov_shifts)) { + # older version has fov, x, y (all numeric) in px shifts + data.table::setnames(fov_shifts, new = c("fov", "x", "y")) + pos <- fov_shifts + } } - } - # proceed with other possible methods of inferring shifts if present - if (!is.null(meta_path) && is.null(pos)) { - pos <- .cosmx_infer_fov_shifts( - meta_dt = data.table::fread(meta_path), - flip_loc_y = TRUE - ) - } else if (!is.null(tx_path) && is.null(pos)) { - warning(wrap_txt( - "metadata_file not found: + # proceed with other possible methods of inferring shifts if present + if (!is.null(meta_path) && is.null(pos)) { + pos <- .cosmx_infer_fov_shifts( + meta_dt = data.table::fread(meta_path), + flip_loc_y = TRUE + ) + } else if (!is.null(tx_path) && is.null(pos)) { + warning(wrap_txt( + "metadata_file not found: Detecting fov shifts from tx_file. (This is slower)" - ), call. = FALSE) - pos <- .cosmx_infer_fov_shifts( - tx_dt = data.table::fread(tx_path), - flip_loc_y = TRUE - ) - } else { - pos <- data.table::data.table() - warning(wrap_txt( - "NO FOV SHIFTS. - fov_positions_file, tx_file, + ), call. = FALSE) + pos <- .cosmx_infer_fov_shifts( + tx_dt = data.table::fread(tx_path), + flip_loc_y = TRUE + ) + } else { + pos <- data.table::data.table() + warning(wrap_txt( + "NO FOV SHIFTS. + fov_positions_file, tx_file, and metadata_file not auto detected. One of these must be provided to infer FOV shifts.\n Alternatively, directly supply a data.table with: fov(int), x(numeric), y(numeric) in px scaling to `$offsets`" - ), call. = FALSE) - } - - .Object@offsets <- pos - } - - - - # transcripts load call - tx_fun <- function(path = tx_path, - feat_type = c("rna", "negprobes"), - split_keyword = list("NegPrb"), - dropcols = c( - "x_local_px", - "y_local_px", - "cell_ID", - "cell" - ), - verbose = NULL) { - .cosmx_transcript( - path = path, - fovs = .Object@fovs %none% NULL, - feat_type = feat_type, - split_keyword = split_keyword, - dropcols = dropcols, - micron = .Object@micron, - px2mm = .Object@px2mm, - cores = determine_cores(), - verbose = verbose - ) - } - .Object@calls$load_transcripts <- tx_fun - - - - # mask load call - mask_fun <- function(path = mask_dir, - # VERTICAL FLIP + NO VERTICAL SHIFT - flip_vertical = TRUE, - flip_horizontal = FALSE, - shift_vertical_step = FALSE, - shift_horizontal_step = FALSE, - remove_background_polygon = TRUE, - verbose = NULL) { - .cosmx_poly( - path = path, - fovs = .Object@fovs %none% NULL, - flip_vertical = flip_vertical, - flip_horizontal = flip_horizontal, - shift_vertical_step = shift_vertical_step, - shift_horizontal_step = shift_horizontal_step, - remove_background_polygon = remove_background_polygon, - micron = .Object@micron, - px2mm = .Object@px2mm, - offsets = .Object@offsets, - verbose = verbose - ) - } - .Object@calls$load_polys <- mask_fun - - - # expression load call - expr_fun <- function(path = expr_path, - feat_type = c("rna", "negprobes"), - split_keyword = list("NegPrb")) { - .cosmx_expression( - path = path, - fovs = .Object@fovs %none% NULL, - feat_type = feat_type, - split_keyword = split_keyword - ) - } - .Object@calls$load_expression <- expr_fun - - - # images load call - img_fun <- function(path = composite_img_dir, - img_type = "composite", - img_name_fmt = paste0(img_type, "_fov%03d"), - negative_y = TRUE, - flip_vertical = FALSE, - flip_horizontal = FALSE, - verbose = NULL) { - .cosmx_image( - path = path, - fovs = .Object@fovs %none% NULL, - img_type = img_type, - img_name_fmt = img_name_fmt, - negative_y = negative_y, - flip_vertical = flip_vertical, - flip_horizontal = flip_horizontal, - micron = .Object@micron, - px2mm = .Object@px2mm, - offsets = .Object@offsets, - verbose = verbose - ) - } - .Object@calls$load_images <- img_fun + ), call. = FALSE) + } + .Object@offsets <- pos + } - # meta load call - meta_fun <- function(path = meta_path, - dropcols = c( - "CenterX_local_px", - "CenterY_local_px", - "CenterX_global_px", - "CenterY_global_px", - "cell_id" - ), - verbose = NULL) { - .cosmx_cellmeta( - path = path, - fovs = .Object@fovs %none% NULL, - dropcols = dropcols, - cores = determine_cores(), - verbose = verbose - ) - } - .Object@calls$load_cellmeta <- meta_fun - # build gobject call - gobject_fun <- function(transcript_path = tx_path, - cell_labels_dir = mask_dir, - expression_path = expr_path, - metadata_path = meta_path, - feat_type = c("rna", "negprobes"), - split_keyword = list( - "NegPrb" - ), - load_images = list( - composite = "composite", - overlay = "overlay" - ), - load_expression = FALSE, - load_cellmeta = FALSE, - instructions = NULL) { - load_expression <- as.logical(load_expression) - load_cellmeta <- as.logical(load_cellmeta) - - if (!is.null(load_images)) { - checkmate::assert_list(load_images) - if (is.null(names(load_images))) { - stop("Images directories provided to - 'load_images' must be named") - } + # transcripts load call + tx_fun <- function( + path = tx_path, + feat_type = c("rna", "negprobes"), + split_keyword = list("NegPrb"), + dropcols = c( + "x_local_px", + "y_local_px", + "cell_ID", + "cell" + ), + verbose = NULL) { + .cosmx_transcript( + path = path, + fovs = .Object@fovs %none% NULL, + feat_type = feat_type, + split_keyword = split_keyword, + dropcols = dropcols, + micron = .Object@micron, + px2mm = .Object@px2mm, + cores = determine_cores(), + verbose = verbose + ) } + .Object@calls$load_transcripts <- tx_fun + + + + # mask load call + mask_fun <- function( + path = mask_dir, + # VERTICAL FLIP + NO VERTICAL SHIFT + flip_vertical = TRUE, + flip_horizontal = FALSE, + shift_vertical_step = FALSE, + shift_horizontal_step = FALSE, + remove_background_polygon = TRUE, + verbose = NULL) { + .cosmx_poly( + path = path, + fovs = .Object@fovs %none% NULL, + flip_vertical = flip_vertical, + flip_horizontal = flip_horizontal, + shift_vertical_step = shift_vertical_step, + shift_horizontal_step = shift_horizontal_step, + remove_background_polygon = remove_background_polygon, + micron = .Object@micron, + px2mm = .Object@px2mm, + offsets = .Object@offsets, + verbose = verbose + ) + } + .Object@calls$load_polys <- mask_fun - funs <- .Object@calls - # init gobject - g <- giotto() - if (!is.null(instructions)) { - instructions(g) <- instructions + # expression load call + expr_fun <- function( + path = expr_path, + feat_type = c("rna", "negprobes"), + split_keyword = list("NegPrb")) { + .cosmx_expression( + path = path, + fovs = .Object@fovs %none% NULL, + feat_type = feat_type, + split_keyword = split_keyword + ) } - - # transcripts - tx_list <- funs$load_transcripts( - path = transcript_path, - feat_type = feat_type, - split_keyword = split_keyword - ) - for (tx in tx_list) { - g <- setGiotto(g, tx) + .Object@calls$load_expression <- expr_fun + + + # images load call + img_fun <- function( + path = composite_img_dir, + img_type = "composite", + img_name_fmt = paste0(img_type, "_fov%03d"), + negative_y = TRUE, + flip_vertical = FALSE, + flip_horizontal = FALSE, + verbose = NULL) { + .cosmx_image( + path = path, + fovs = .Object@fovs %none% NULL, + img_type = img_type, + img_name_fmt = img_name_fmt, + negative_y = negative_y, + flip_vertical = flip_vertical, + flip_horizontal = flip_horizontal, + micron = .Object@micron, + px2mm = .Object@px2mm, + offsets = .Object@offsets, + verbose = verbose + ) } - - # polys - polys <- funs$load_polys( - path = cell_labels_dir, - verbose = FALSE - ) - g <- setGiotto(g, polys) - - # images - if (!is.null(load_images)) { - # replace convenient shortnames - load_images[load_images == "composite"] <- composite_img_dir - load_images[load_images == "overlay"] <- overlay_img_dir - - imglist <- list() - dirnames <- names(load_images) - for (imdir_i in seq_along(load_images)) { - dir_imgs <- funs$load_images( - path = load_images[[imdir_i]], - img_type = dirnames[[imdir_i]], - ) - imglist <- c(imglist, dir_imgs) - } - g <- addGiottoLargeImage(g, largeImages = imglist) + .Object@calls$load_images <- img_fun + + + # meta load call + meta_fun <- function( + path = meta_path, + dropcols = c( + "CenterX_local_px", + "CenterY_local_px", + "CenterX_global_px", + "CenterY_global_px", + "cell_id" + ), + verbose = NULL) { + .cosmx_cellmeta( + path = path, + fovs = .Object@fovs %none% NULL, + dropcols = dropcols, + cores = determine_cores(), + verbose = verbose + ) } + .Object@calls$load_cellmeta <- meta_fun + + + # build gobject call + gobject_fun <- function( + transcript_path = tx_path, + cell_labels_dir = mask_dir, + expression_path = expr_path, + metadata_path = meta_path, + feat_type = c("rna", "negprobes"), + split_keyword = list( + "NegPrb" + ), + load_images = list( + composite = "composite", + overlay = "overlay" + ), + load_expression = FALSE, + load_cellmeta = FALSE, + instructions = NULL) { + load_expression <- as.logical(load_expression) + load_cellmeta <- as.logical(load_cellmeta) + + if (!is.null(load_images)) { + checkmate::assert_list(load_images) + if (is.null(names(load_images))) { + stop("Images directories provided to + 'load_images' must be named") + } + } + + funs <- .Object@calls - # expression & meta - # Need to check that names agree for poly/expr/meta - allowed_ids <- spatIDs(polys) + # init gobject + g <- giotto() + if (!is.null(instructions)) { + instructions(g) <- instructions + } - if (load_expression) { - exlist <- funs$load_expression( - path = expression_path, + # transcripts + tx_list <- funs$load_transcripts( + path = transcript_path, feat_type = feat_type, split_keyword = split_keyword ) - - # only keep allowed cells and set into gobject - for (ex in exlist) { - bool <- colnames(ex[]) %in% allowed_ids - ex[] <- ex[][, bool] - g <- setGiotto(g, ex) + for (tx in tx_list) { + g <- setGiotto(g, tx) } - } - if (load_cellmeta) { - cx <- funs$load_cellmeta( - path = metadata_path + # polys + polys <- funs$load_polys( + path = cell_labels_dir, + verbose = FALSE ) + g <- setGiotto(g, polys) + + # images + if (!is.null(load_images)) { + # replace convenient shortnames + load_images[load_images == "composite"] <- composite_img_dir + load_images[load_images == "overlay"] <- overlay_img_dir + + imglist <- list() + dirnames <- names(load_images) + for (imdir_i in seq_along(load_images)) { + dir_imgs <- funs$load_images( + path = load_images[[imdir_i]], + img_type = dirnames[[imdir_i]], + ) + imglist <- c(imglist, dir_imgs) + } + g <- addGiottoLargeImage(g, largeImages = imglist) + } + + # expression & meta + # Need to check that names agree for poly/expr/meta + allowed_ids <- spatIDs(polys) - cx[] <- cx[][cell_ID %in% allowed_ids, ] - g <- setGiotto(g, cx) + if (load_expression) { + exlist <- funs$load_expression( + path = expression_path, + feat_type = feat_type, + split_keyword = split_keyword + ) + + # only keep allowed cells and set into gobject + for (ex in exlist) { + bool <- colnames(ex[]) %in% allowed_ids + ex[] <- ex[][, bool] + g <- setGiotto(g, ex) + } + } + + if (load_cellmeta) { + cx <- funs$load_cellmeta( + path = metadata_path + ) + + cx[] <- cx[][cell_ID %in% allowed_ids, ] + g <- setGiotto(g, cx) + } + + return(g) } + .Object@calls$create_gobject <- gobject_fun - return(g) + return(.Object) } - .Object@calls$create_gobject <- gobject_fun - - return(.Object) -}) +) @@ -506,20 +514,21 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { # MODULAR #### -.cosmx_transcript <- function(path, - fovs = NULL, - feat_type = c("rna", "negprobes"), - split_keyword = list("NegPrb"), - dropcols = c( - "x_local_px", - "y_local_px", - "cell_ID", - "cell" - ), - micron = FALSE, - px2mm = 0.12028, - cores = determine_cores(), - verbose = NULL) { +.cosmx_transcript <- function( + path, + fovs = NULL, + feat_type = c("rna", "negprobes"), + split_keyword = list("NegPrb"), + dropcols = c( + "x_local_px", + "y_local_px", + "cell_ID", + "cell" + ), + micron = FALSE, + px2mm = 0.12028, + cores = determine_cores(), + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to tx file provided or auto-detected" @@ -592,8 +601,8 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { #' When the variance is higher than 0.001, the function is re-run with the #' opposite `flip_loc_y` value. #' @keywords internal -.cosmx_infer_fov_shifts <- function(tx_dt, meta_dt, - flip_loc_y = TRUE, navg = 100L) { +.cosmx_infer_fov_shifts <- function(tx_dt, meta_dt, + flip_loc_y = TRUE, navg = 100L) { fov <- NULL # NSE vars if (!missing(tx_dt)) { tx_head <- tx_dt[, head(.SD, navg), by = fov] @@ -622,7 +631,9 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { # Usual yshift variance / fov expected when correct is 0 to 1e-22 # if var is too high for any fov, swap `flip_loc_y` value y <- meta_head[ - , var(CenterY_global_px + CenterY_local_px), by = fov] + , var(CenterY_global_px + CenterY_local_px), + by = fov + ] if (y[, any(V1 > 0.001)]) { return(.cosmx_infer_fov_shifts( meta_dt = meta_dt, flip_loc_y = FALSE, navg = navg @@ -660,20 +671,21 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { return(fovs) } -.cosmx_poly <- function(path, - slide = 1, - fovs = NULL, - name = "cell", - # VERTICAL FLIP + NO SHIFTS - flip_vertical = TRUE, - flip_horizontal = FALSE, - shift_vertical_step = FALSE, - shift_horizontal_step = FALSE, - remove_background_polygon = TRUE, - micron = FALSE, - px2mm = 0.12028, - offsets, - verbose = NULL) { +.cosmx_poly <- function( + path, + slide = 1, + fovs = NULL, + name = "cell", + # VERTICAL FLIP + NO SHIFTS + flip_vertical = TRUE, + flip_horizontal = FALSE, + shift_vertical_step = FALSE, + shift_horizontal_step = FALSE, + remove_background_polygon = TRUE, + micron = FALSE, + px2mm = 0.12028, + offsets, + verbose = NULL) { # NSE params f <- x <- y <- NULL @@ -749,18 +761,19 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { return(gpolys) } -.cosmx_cellmeta <- function(path, - slide = 1, - fovs = NULL, - dropcols = c( - "CenterX_local_px", - "CenterY_local_px", - "CenterX_global_px", - "CenterY_global_px", - "cell_id" - ), - cores = determine_cores(), - verbose = NULL) { +.cosmx_cellmeta <- function( + path, + slide = 1, + fovs = NULL, + dropcols = c( + "CenterX_local_px", + "CenterY_local_px", + "CenterX_global_px", + "CenterY_global_px", + "cell_id" + ), + cores = determine_cores(), + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to metadata file provided or auto-detected" @@ -808,13 +821,14 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { return(cx) } -.cosmx_expression <- function(path, - slide = 1, - fovs = NULL, - feat_type = c("rna", "negprobes"), - split_keyword = list("NegPrb"), - cores = determine_cores(), - verbose = NULL) { +.cosmx_expression <- function( + path, + slide = 1, + fovs = NULL, + feat_type = c("rna", "negprobes"), + split_keyword = list("NegPrb"), + cores = determine_cores(), + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to exprMat file provided or auto-detected" @@ -879,17 +893,18 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { return(expr_list) } -.cosmx_image <- function(path, - fovs = NULL, - img_type = "composite", - img_name_fmt = paste(img_type, "_fov%03d"), - negative_y = TRUE, - flip_vertical = FALSE, - flip_horizontal = FALSE, - micron = FALSE, - px2mm = 0.12028, - offsets, - verbose = NULL) { +.cosmx_image <- function( + path, + fovs = NULL, + img_type = "composite", + img_name_fmt = paste(img_type, "_fov%03d"), + negative_y = TRUE, + flip_vertical = FALSE, + flip_horizontal = FALSE, + micron = FALSE, + px2mm = 0.12028, + offsets, + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to image subdirectory to load provided or auto-detected" @@ -951,10 +966,11 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { #' @inheritParams createGiottoCosMxObject #' @returns list #' @keywords internal -.load_cosmx_folder_subcellular <- function(dir_items, - FOVs = NULL, - cores, - verbose = TRUE) { +.load_cosmx_folder_subcellular <- function( + dir_items, + FOVs = NULL, + cores, + verbose = TRUE) { vmsg(.v = verbose, "Loading subcellular information...") # subcellular checks @@ -997,9 +1013,10 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { #' @inheritParams createGiottoCosMxObject #' @returns list #' @keywords internal -.load_cosmx_folder_aggregate <- function(dir_items, - cores, - verbose = TRUE) { +.load_cosmx_folder_aggregate <- function( + dir_items, + cores, + verbose = TRUE) { # data.table vars fov <- cell_ID <- fov_cell_ID <- CenterX_global_px <- CenterY_global_px <- CenterX_local_px <- @@ -1057,7 +1074,9 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { spatloc_oldnames_fov <- c("CenterX_local_px", "CenterY_local_px", "cell_ID") spatloc_newnames <- c("sdimx", "sdimy", "cell_ID") data.table::setnames( - spatlocs, old = spatloc_oldnames, new = spatloc_newnames) + spatlocs, + old = spatloc_oldnames, new = spatloc_newnames + ) data.table::setnames( spatlocs_fov, old = spatloc_oldnames_fov, new = spatloc_newnames @@ -1077,7 +1096,7 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { # convert protein metadata to expr mat - # take all mean intensity protein information except for + # take all mean intensity protein information except for # MembraneStain and DAPI protein_meta_cols <- colnames(metadata) protein_meta_cols <- protein_meta_cols[ @@ -1167,7 +1186,7 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { #' \item{experimentname_\strong{tx_file}.csv (file)} #' } #' -#' [\strong{Workflows}] Workflow to use is accessed through the data_to_use +#' [\strong{Workflows}] Workflow to use is accessed through the data_to_use #' param #' \itemize{ #' \item{'all' - loads and requires subcellular information from tx_file and @@ -1191,15 +1210,16 @@ setMethod("$<-", signature("CosmxReader"), function(x, name, value) { #' these image objects more responsive when accessing them from a server. #' \code{\link{showGiottoImageNames}} can be used to see the available images. #' @export -createGiottoCosMxObject <- function(cosmx_dir = NULL, - data_to_use = c("all", "subcellular", "aggregate"), - remove_background_polygon = TRUE, - background_algo = c("range"), - remove_unvalid_polygons = TRUE, - FOVs = NULL, - instructions = NULL, - cores = determine_cores(), - verbose = TRUE) { +createGiottoCosMxObject <- function( + cosmx_dir = NULL, + data_to_use = c("all", "subcellular", "aggregate"), + remove_background_polygon = TRUE, + background_algo = c("range"), + remove_unvalid_polygons = TRUE, + FOVs = NULL, + instructions = NULL, + cores = determine_cores(), + verbose = TRUE) { # 0. setup cosmx_dir <- path.expand(cosmx_dir) @@ -1275,14 +1295,15 @@ createGiottoCosMxObject <- function(cosmx_dir = NULL, #' @inheritParams createGiottoCosMxObject #' @returns giotto object #' @keywords internal -.createGiottoCosMxObject_subcellular <- function(dir_items, - FOVs = NULL, - remove_background_polygon = TRUE, - background_algo = c("range"), - remove_unvalid_polygons = TRUE, - cores, - verbose = TRUE, - instructions = NULL) { +.createGiottoCosMxObject_subcellular <- function( + dir_items, + FOVs = NULL, + remove_background_polygon = TRUE, + background_algo = c("range"), + remove_unvalid_polygons = TRUE, + cores, + verbose = TRUE, + instructions = NULL) { target <- fov <- NULL # load tx detections and FOV offsets ------------------------------------- # @@ -1504,10 +1525,11 @@ createGiottoCosMxObject <- function(cosmx_dir = NULL, #' @inheritParams createGiottoCosMxObject #' @returns giotto object #' @keywords internal -.createGiottoCosMxObject_aggregate <- function(dir_items, - cores, - verbose = TRUE, - instructions = NULL) { +.createGiottoCosMxObject_aggregate <- function( + dir_items, + cores, + verbose = TRUE, + instructions = NULL) { data_to_use <- fov <- NULL data_list <- .load_cosmx_folder_aggregate( @@ -1577,17 +1599,19 @@ createGiottoCosMxObject <- function(cosmx_dir = NULL, if (length(compartmentLabel_dir) > 0) { compartmentLabel_imgList <- lapply( compartmentLabel_dir, function(x) { - createGiottoLargeImage(x, - name = "composite", - negative_y = TRUE) + createGiottoLargeImage(x, + name = "composite", + negative_y = TRUE + ) } ) } if (length(overlay_dir) > 0) { overlay_imgList <- lapply(overlay_dir, function(x) { - createGiottoLargeImage(x, - name = "composite", - negative_y = TRUE) + createGiottoLargeImage(x, + name = "composite", + negative_y = TRUE + ) }) } } @@ -1611,15 +1635,16 @@ createGiottoCosMxObject <- function(cosmx_dir = NULL, #' @seealso createGiottoCosMxObject .createGiottoCosMxObject_aggregate #' .createGiottoCosMxObject_subcellular #' @keywords internal -.createGiottoCosMxObject_all <- function(dir_items, - FOVs, - remove_background_polygon = TRUE, - background_algo = "range", - remove_unvalid_polygons = TRUE, - cores, - verbose = TRUE, - instructions = NULL, - ...) { +.createGiottoCosMxObject_all <- function( + dir_items, + FOVs, + remove_background_polygon = TRUE, + background_algo = "range", + remove_unvalid_polygons = TRUE, + cores, + verbose = TRUE, + instructions = NULL, + ...) { # 1. create subcellular giotto as spat_unit 'cell' cosmx_gobject <- .createGiottoCosMxObject_subcellular( dir_items = dir_items, @@ -1738,8 +1763,9 @@ createGiottoCosMxObject <- function(cosmx_dir = NULL, #' @returns path_list a list of cosmx files discovered and their filepaths. NULL #' values denote missing items #' @keywords internal -.read_cosmx_folder <- function(cosmx_dir, - verbose = TRUE) { +.read_cosmx_folder <- function( + cosmx_dir, + verbose = TRUE) { ch <- box_chars() if (is.null(cosmx_dir) | !dir.exists(cosmx_dir)) { diff --git a/R/convenience_general.R b/R/convenience_general.R index ba0cacd58..1bbe1d513 100644 --- a/R/convenience_general.R +++ b/R/convenience_general.R @@ -30,8 +30,8 @@ #' \itemize{ #' \item{1. detection of items within \code{data_dir} by looking for keywords #' assigned through \code{dir_items}} -#' \item{2. check of detected items to see if everything needed has been -#' found. Dictionary of necessary vs optional items for each +#' \item{2. check of detected items to see if everything needed has been +#' found. Dictionary of necessary vs optional items for each #' \code{data_to_use} *workflow* is provided through \code{require_data_DT}} #' \item{3. if multiple filepaths are found to be matching then select the #' first one. This function is only intended to find the first level @@ -82,16 +82,15 @@ NULL #' @describeIn read_data_folder Should not be used directly #' @keywords internal -.read_data_folder <- function( - spat_method = NULL, - data_dir = NULL, - dir_items, - data_to_use, - load_format = NULL, - require_data_DT, - cores = NA, - verbose = NULL, - toplevel = 2L) { +.read_data_folder <- function(spat_method = NULL, + data_dir = NULL, + dir_items, + data_to_use, + load_format = NULL, + require_data_DT, + cores = NA, + verbose = NULL, + toplevel = 2L) { ch <- box_chars() # 0. check params @@ -227,10 +226,12 @@ abbrev_path <- function(path, head = 15, tail = 35L) { # pattern - list.files pattern to use to search for specific files/dirs # warn - whether to warn when a pattern does not find any files # first - whether to only return the first match -.detect_in_dir <- function(path, pattern, recursive = FALSE, - platform, warn = TRUE, first = TRUE) { - f <- list.files(path, pattern = pattern, recursive = recursive, - full.names = TRUE) +.detect_in_dir <- function(path, pattern, recursive = FALSE, + platform, warn = TRUE, first = TRUE) { + f <- list.files(path, + pattern = pattern, recursive = recursive, + full.names = TRUE + ) lenf <- length(f) if (lenf == 1L) { return(f) @@ -301,48 +302,47 @@ abbrev_path <- function(path, head = 15, tail = 35L) { #' @details #' If starting from a Visium 10X directory: #' \itemize{ -#' \item{expr_data: raw will take expression data from +#' \item{expr_data: raw will take expression data from #' raw_feature_bc_matrix and filter from filtered_feature_bc_matrix} -#' \item{gene_column_index: which gene identifiers (names) to use if there +#' \item{gene_column_index: which gene identifiers (names) to use if there #' are multiple columns (e.g. ensemble and gene symbol)} -#' \item{png_name: by default the first png will be selected, provide the png +#' \item{png_name: by default the first png will be selected, provide the png #' name to override this (e.g. myimage.png)} -#' \item{the file scalefactors_json.json will be detected automatically and +#' \item{the file scalefactors_json.json will be detected automatically and #' used to attempt to align the data} #' } #' #' If starting from a Visium 10X .h5 file #' \itemize{ #' \item{h5_visium_path: full path to .h5 file: /your/path/to/visium_file.h5} -#' \item{h5_tissue_positions_path: full path to spatial locations file: +#' \item{h5_tissue_positions_path: full path to spatial locations file: #' /you/path/to/tissue_positions_list.csv} -#' \item{h5_image_png_path: full path to png: +#' \item{h5_image_png_path: full path to png: #' /your/path/to/images/tissue_lowres_image.png} -#' \item{h5_json_scalefactors_path: full path to .json file: +#' \item{h5_json_scalefactors_path: full path to .json file: #' /your/path/to/scalefactors_json.json} #' } #' #' @export -createGiottoVisiumObject <- function( - visium_dir = NULL, - expr_data = c("raw", "filter"), - gene_column_index = 1, - h5_visium_path = NULL, - h5_gene_ids = c("symbols", "ensembl"), - h5_tissue_positions_path = NULL, - h5_image_png_path = NULL, - h5_json_scalefactors_path = NULL, - png_name = NULL, - do_manual_adj = FALSE, # deprecated - xmax_adj = 0, # deprecated - xmin_adj = 0, # deprecated - ymax_adj = 0, # deprecated - ymin_adj = 0, # deprecated - instructions = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray"), - h5_file = NULL, - cores = NA, - verbose = NULL) { +createGiottoVisiumObject <- function(visium_dir = NULL, + expr_data = c("raw", "filter"), + gene_column_index = 1, + h5_visium_path = NULL, + h5_gene_ids = c("symbols", "ensembl"), + h5_tissue_positions_path = NULL, + h5_image_png_path = NULL, + h5_json_scalefactors_path = NULL, + png_name = NULL, + do_manual_adj = FALSE, # deprecated + xmax_adj = 0, # deprecated + xmin_adj = 0, # deprecated + ymax_adj = 0, # deprecated + ymin_adj = 0, # deprecated + instructions = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray"), + h5_file = NULL, + cores = NA, + verbose = NULL) { # NSE vars barcode <- row_pxl <- col_pxl <- in_tissue <- array_row <- array_col <- NULL @@ -401,17 +401,18 @@ createGiottoVisiumObject <- function( -.visium_create <- function(expr_counts_path, - h5_gene_ids = NULL, # h5 - gene_column_index = NULL, # folder - tissue_positions_path, - image_path = NULL, - scale_json_path = NULL, - png_name = NULL, - instructions = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray"), - h5_file = NULL, - verbose = NULL) { +.visium_create <- function( + expr_counts_path, + h5_gene_ids = NULL, # h5 + gene_column_index = NULL, # folder + tissue_positions_path, + image_path = NULL, + scale_json_path = NULL, + png_name = NULL, + instructions = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray"), + h5_file = NULL, + verbose = NULL) { # NSE vars barcode <- cell_ID <- row_pxl <- col_pxl <- in_tissue <- array_row <- array_col <- NULL @@ -511,7 +512,7 @@ createGiottoVisiumObject <- function( verbose = FALSE, initialize = TRUE ) - + ms <- 65 / json_info$spot_diameter_fullres instructions(giotto_object, "micron_scale") <- ms } @@ -522,11 +523,12 @@ createGiottoVisiumObject <- function( # Find and check the filepaths within a structured visium directory -.visium_read_folder <- function(visium_dir = NULL, - expr_data = c("raw", "filter"), - gene_column_index = 1, - png_name = NULL, - verbose = NULL) { +.visium_read_folder <- function( + visium_dir = NULL, + expr_data = c("raw", "filter"), + gene_column_index = 1, + png_name = NULL, + verbose = NULL) { vmsg(.v = verbose, "A structured visium directory will be used") ## check arguments @@ -582,12 +584,13 @@ createGiottoVisiumObject <- function( -.visium_read_h5 <- function(h5_visium_path = h5_visium_path, # expression matrix - h5_gene_ids = h5_gene_ids, - h5_tissue_positions_path = h5_tissue_positions_path, - h5_image_png_path = h5_image_png_path, - h5_json_scalefactors_path = h5_json_scalefactors_path, - verbose = NULL) { +.visium_read_h5 <- function( + h5_visium_path = h5_visium_path, # expression matrix + h5_gene_ids = h5_gene_ids, + h5_tissue_positions_path = h5_tissue_positions_path, + h5_image_png_path = h5_image_png_path, + h5_json_scalefactors_path = h5_json_scalefactors_path, + verbose = NULL) { # 1. filepaths vmsg( .v = verbose, @@ -655,9 +658,8 @@ createGiottoVisiumObject <- function( #' Adds circular giottoPolygons to the spatial_info slot of a Giotto Object #' for the "cell" spatial unit. #' @export -addVisiumPolygons <- function( - gobject, - scalefactor_path = NULL) { +addVisiumPolygons <- function(gobject, + scalefactor_path = NULL) { assert_giotto(gobject) visium_spat_locs <- getSpatialLocations( @@ -779,13 +781,12 @@ addVisiumPolygons <- function( #' Visium spots. #' @keywords internal #' @md -.visium_spot_poly <- function( - spatlocs = NULL, - json_scalefactors) { +.visium_spot_poly <- function(spatlocs = NULL, + json_scalefactors) { if (inherits(spatlocs, "spatLocsObj")) { spatlocs <- spatlocs[] } - + spot_adj <- 55 / 65 vis_spot_poly <- GiottoClass::circleVertices( @@ -812,10 +813,11 @@ addVisiumPolygons <- function( # json_info expects the list read output from .visium_read_scalefactors # image_path should be expected to be full filepath # should only be used when do_manual_adj (deprecated) is FALSE -.visium_image <- function(image_path, - json_info = NULL, - micron_scale = FALSE, - verbose = NULL) { +.visium_image <- function( + image_path, + json_info = NULL, + micron_scale = FALSE, + verbose = NULL) { # assume image already checked vmsg(.v = verbose, .initial = " - ", "found image") @@ -905,10 +907,9 @@ addVisiumPolygons <- function( #' if image_file is a list. #' @returns giottoLargeImage #' @export -createMerscopeLargeImage <- function( - image_file, - transforms_file, - name = "image") { +createMerscopeLargeImage <- function(image_file, + transforms_file, + name = "image") { checkmate::assert_character(transforms_file) tfsDT <- data.table::fread(transforms_file) if (inherits(image_file, "character")) { @@ -970,29 +971,28 @@ createMerscopeLargeImage <- function( #' function matches against: #' \itemize{ #' \item{\strong{cell_boundaries} (folder .hdf5 files)} -#' \item{\strong{images} (folder of .tif images and a +#' \item{\strong{images} (folder of .tif images and a #' scalefactor/transfrom table)} #' \item{\strong{cell_by_gene}.csv (file)} #' \item{cell_metadata\strong{fov_positions_file}.csv (file)} #' \item{detected_transcripts\strong{metadata_file}.csv (file)} #' } #' @export -createGiottoMerscopeObject <- function( - merscope_dir, - data_to_use = c("subcellular", "aggregate"), - FOVs = NULL, - poly_z_indices = seq(from = 1, to = 7), - calculate_overlap = TRUE, - overlap_to_matrix = TRUE, - aggregate_stack = TRUE, - aggregate_stack_param = list( - summarize_expression = "sum", - summarize_locations = "mean", - new_spat_unit = "cell" - ), - instructions = NULL, - cores = NA, - verbose = TRUE) { +createGiottoMerscopeObject <- function(merscope_dir, + data_to_use = c("subcellular", "aggregate"), + FOVs = NULL, + poly_z_indices = seq(from = 1, to = 7), + calculate_overlap = TRUE, + overlap_to_matrix = TRUE, + aggregate_stack = TRUE, + aggregate_stack_param = list( + summarize_expression = "sum", + summarize_locations = "mean", + new_spat_unit = "cell" + ), + instructions = NULL, + cores = NA, + verbose = TRUE) { fovs <- NULL # 0. setup @@ -1001,7 +1001,7 @@ createGiottoMerscopeObject <- function( poly_z_indices <- as.integer(poly_z_indices) if (any(poly_z_indices < 1)) { stop(wrap_txt( - "poly_z_indices is a vector of one or more integers starting + "poly_z_indices is a vector of one or more integers starting from 1.", errWidth = TRUE )) @@ -1064,18 +1064,17 @@ createGiottoMerscopeObject <- function( #' 'subcellular' workflow #' @param data_list list of loaded data from \code{\link{load_merscope_folder}} #' @keywords internal -.createGiottoMerscopeObject_subcellular <- function( - data_list, - calculate_overlap = TRUE, - overlap_to_matrix = TRUE, - aggregate_stack = TRUE, - aggregate_stack_param = list( - summarize_expression = "sum", - summarize_locations = "mean", - new_spat_unit = "cell" - ), - cores = NA, - verbose = TRUE) { +.createGiottoMerscopeObject_subcellular <- function(data_list, + calculate_overlap = TRUE, + overlap_to_matrix = TRUE, + aggregate_stack = TRUE, + aggregate_stack_param = list( + summarize_expression = "sum", + summarize_locations = "mean", + new_spat_unit = "cell" + ), + cores = NA, + verbose = TRUE) { feat_coord <- neg_coord <- cellLabel_dir <- instructions <- NULL # unpack data_list @@ -1137,10 +1136,9 @@ createGiottoMerscopeObject <- function( #' workflow #' @param data_list list of loaded data from \code{\link{load_merscope_folder}} #' @keywords internal -.createGiottoMerscopeObject_aggregate <- function( - data_list, - cores = NA, - verbose = TRUE) { +.createGiottoMerscopeObject_aggregate <- function(data_list, + cores = NA, + verbose = TRUE) { # unpack data_list micronToPixelScale <- data_list$micronToPixelScale expr_dt <- data_list$expr_dt @@ -1166,9 +1164,8 @@ createGiottoMerscopeObject <- function( #' @description Given the path to a Spatial Genomics data directory, creates a #' Giotto object. #' @export -createSpatialGenomicsObject <- function( - sg_dir = NULL, - instructions = NULL) { +createSpatialGenomicsObject <- function(sg_dir = NULL, + instructions = NULL) { # Find files in Spatial Genomics directory dapi <- list.files(sg_dir, full.names = TRUE, pattern = "DAPI") mask <- list.files(sg_dir, full.names = TRUE, pattern = "mask") @@ -1216,11 +1213,10 @@ createSpatialGenomicsObject <- function( #' @describeIn read_data_folder Read a structured MERSCOPE folder #' @keywords internal -.read_merscope_folder <- function( - merscope_dir, - data_to_use, - cores = NA, - verbose = NULL) { +.read_merscope_folder <- function(merscope_dir, + data_to_use, + cores = NA, + verbose = NULL) { # prepare dir_items list dir_items <- list( `boundary info` = "*cell_boundaries*", @@ -1295,13 +1291,12 @@ NULL #' @rdname load_merscope_folder #' @keywords internal -.load_merscope_folder <- function( - dir_items, - data_to_use, - fovs = NULL, - poly_z_indices = seq(from = 1, to = 7), - cores = NA, - verbose = TRUE) { +.load_merscope_folder <- function(dir_items, + data_to_use, + fovs = NULL, + poly_z_indices = seq(from = 1, to = 7), + cores = NA, + verbose = TRUE) { # 1. load data_to_use-specific if (data_to_use == "subcellular") { data_list <- .load_merscope_folder_subcellular( @@ -1372,13 +1367,12 @@ NULL #' @describeIn load_merscope_folder Load items for 'subcellular' workflow #' @keywords internal -.load_merscope_folder_subcellular <- function( - dir_items, - data_to_use, - cores = NA, - poly_z_indices = 1L:7L, - verbose = TRUE, - fovs = NULL) { +.load_merscope_folder_subcellular <- function(dir_items, + data_to_use, + cores = NA, + poly_z_indices = 1L:7L, + verbose = TRUE, + fovs = NULL) { if (isTRUE(verbose)) message("Loading transcript level info...") if (is.null(fovs)) { tx_dt <- data.table::fread( @@ -1422,11 +1416,10 @@ NULL #' @describeIn load_merscope_folder Load items for 'aggregate' workflow #' @keywords internal -.load_merscope_folder_aggregate <- function( - dir_items, - data_to_use, - cores = NA, - verbose = TRUE) { +.load_merscope_folder_aggregate <- function(dir_items, + data_to_use, + cores = NA, + verbose = TRUE) { # metadata is polygon-related measurements vmsg("Loading cell metadata...", .v = verbose) cell_metadata_file <- data.table::fread( @@ -1476,7 +1469,7 @@ NULL #' These files can be in one of the following formats: (i) scATAC tabix files, #' (ii) fragment files, or (iii) bam files. #' @param genome A string indicating the default genome to be used for all ArchR -#' functions. Currently supported values include "hg19","hg38","mm9", and +#' functions. Currently supported values include "hg19","hg38","mm9", and #' "mm10". #' This value is stored as a global environment variable, not part of the #' ArchRProject. @@ -1496,28 +1489,27 @@ NULL #' @returns An ArchR project with GeneScoreMatrix, TileMatrix, and #' TileMatrix-based LSI #' @export -createArchRProj <- function( - fragmentsPath, - genome = c("hg19", "hg38", "mm9", "mm10"), - createArrowFiles_params = list( - sampleNames = "sample1", - minTSS = 0, - minFrags = 0, - maxFrags = 1e+07, - minFragSize = 10, - maxFragSize = 2000, - offsetPlus = 0, - offsetMinus = 0, - TileMatParams = list(tileSize = 5000) - ), - ArchRProject_params = list( - outputDirectory = getwd(), - copyArrows = FALSE - ), - addIterativeLSI_params = list(), - threads = ArchR::getArchRThreads(), - force = FALSE, - verbose = TRUE) { +createArchRProj <- function(fragmentsPath, + genome = c("hg19", "hg38", "mm9", "mm10"), + createArrowFiles_params = list( + sampleNames = "sample1", + minTSS = 0, + minFrags = 0, + maxFrags = 1e+07, + minFragSize = 10, + maxFragSize = 2000, + offsetPlus = 0, + offsetMinus = 0, + TileMatParams = list(tileSize = 5000) + ), + ArchRProject_params = list( + outputDirectory = getwd(), + copyArrows = FALSE + ), + addIterativeLSI_params = list(), + threads = ArchR::getArchRThreads(), + force = FALSE, + verbose = TRUE) { if (!requireNamespace("ArchR")) { message('ArchR is needed. Install the package using remotes::install_github("GreenleafLab/ArchR")') @@ -1578,13 +1570,12 @@ createArchRProj <- function( #' @returns A Giotto object with at least an atac or epigenetic modality #' #' @export -createGiottoObjectfromArchR <- function( - archRproj, - expression = NULL, - expression_feat = "atac", - spatial_locs = NULL, - sampleNames = "sample1", - ...) { +createGiottoObjectfromArchR <- function(archRproj, + expression = NULL, + expression_feat = "atac", + spatial_locs = NULL, + sampleNames = "sample1", + ...) { # extract GeneScoreMatrix GeneScoreMatrix_summarizedExperiment <- ArchR::getMatrixFromProject( archRproj diff --git a/R/convenience_visiumHD.R b/R/convenience_visiumHD.R index 5c8bbc3b2..fca2fd695 100644 --- a/R/convenience_visiumHD.R +++ b/R/convenience_visiumHD.R @@ -32,10 +32,12 @@ setClass( # * show #### setMethod("show", signature("VisiumHDReader"), function(object) { cat(sprintf("Giotto <%s>\n", "VisiumHDReader")) - print_slots <- c("dir", "expression_source", "gene_column_index", - "barcodes", "array_subset_row", "array_subset_col", - "pxl_subset_row", "pxl_subset_col", - "funs") + print_slots <- c( + "dir", "expression_source", "gene_column_index", + "barcodes", "array_subset_row", "array_subset_col", + "pxl_subset_row", "pxl_subset_col", + "funs" + ) pre <- sprintf("%s :", format(print_slots)) names(pre) <- print_slots @@ -62,13 +64,15 @@ setMethod("show", signature("VisiumHDReader"), function(object) { cat(pre["barcodes"], barcodes, "\n") # array_subset_row - array_subset_row <- ifelse(!is.null(object@array_subset_row), - "found", "none") + array_subset_row <- ifelse(!is.null(object@array_subset_row), + "found", "none" + ) cat(pre["array_subset_row"], array_subset_row, "\n") # array_subset_col - array_subset_col <- ifelse(!is.null(object@array_subset_col), - "found", "none") + array_subset_col <- ifelse(!is.null(object@array_subset_col), + "found", "none" + ) cat(pre["array_subset_col"], array_subset_col, "\n") # pxl_subset_row @@ -92,36 +96,36 @@ setMethod("print", signature("VisiumHDReader"), function(x, ...) show(x)) #' @name importVisiumHD #' @description #' Giotto import functionalities for Visium HD datasets. This function generates -#' a `VisiumHDReader` instance that has convenient reader functions for -#' converting individual pieces of Visium HD data into Giotto-compatible +#' a `VisiumHDReader` instance that has convenient reader functions for +#' converting individual pieces of Visium HD data into Giotto-compatible #' representations when the param `visiumHD_dir` is provided. #' A function that creates the full `giotto` object is also available. #' These functions should have all param values provided as defaults, but #' can be flexibly modified to do things such as look in alternative #' directories or paths. #' @param visiumHD_dir Visium HD output directory (e.g. square_016um) -#' @param expression_source character. Raw or filter expression data. Defaults +#' @param expression_source character. Raw or filter expression data. Defaults #' to "raw" #' @param gene_column_index numeric. Expression column to use for gene names #' 1 = Ensembl and 2 = gene symbols #' @param barcodes character vector. (optional) Use if you only want to load #' a subset of the pixel barcodes -#' @param array_subset_row numeric vector. (optional) Vector with min and max +#' @param array_subset_row numeric vector. (optional) Vector with min and max #' values to subset based on array rows -#' @param array_subset_col numeric vector. (optional) Vector with min and max +#' @param array_subset_col numeric vector. (optional) Vector with min and max #' values to subset based on array columns -#' @param pxl_subset_row numeric vector. (optional) Vector with min and max +#' @param pxl_subset_row numeric vector. (optional) Vector with min and max #' values to subset based on row pixels -#' @param pxl_subset_col numeric vector. (optional) Vector with min and max +#' @param pxl_subset_col numeric vector. (optional) Vector with min and max #' values to subset based on column pixels #' @details #' Loading functions are generated after the `visiumHD_dir` is added. #' @returns VisiumHDReader object #' @examples +#' \dontrun{ #' # Create a `VisiumHDReader` object #' reader <- importVisiumHD() #' -#' \dontrun{ #' # Set the visiumHD_dir #' reader$visiumHD_dir <- "path to visium HD dir" #' readerHD$visiumHD_dir <- visiumHD_dir @@ -130,31 +134,31 @@ setMethod("print", signature("VisiumHDReader"), function(x, ...) show(x)) #' tissue_pos <- readerHD$load_tissue_position() #' metadata <- readerHD$load_metadata() #' -#' Load matrix or create expression object +#' # Load matrix or create expression object #' matrix <- readerHD$load_matrix() #' expression_obj <- readerHD$load_expression() #' -#' Load transcript data (cell metadata, expression object, and transcripts per -#' pixel) -#' my_transcripts <- readerHD$load_transcripts(array_subset_row = c(500, 1000), -#' array_subset_col = c(500, 1000)) +#' # Load transcript data (cell metadata, expression object, and transcripts +#' # per pixel) +#' my_transcripts <- readerHD$load_transcripts( +#' array_subset_row = c(500, 1000), +#' array_subset_col = c(500, 1000) +#' ) #' #' # Create a `giotto` object and add the loaded data #' # TODO #' } #' @export -importVisiumHD <- function( - visiumHD_dir = NULL, - expression_source = "raw", - gene_column_index = 2, - barcodes = NULL, - array_subset_row = NULL, - array_subset_col = NULL, - pxl_subset_row = NULL, - pxl_subset_col = NULL, - shape = "hexagon", - shape_size = 400) { - +importVisiumHD <- function(visiumHD_dir = NULL, + expression_source = "raw", + gene_column_index = 2, + barcodes = NULL, + array_subset_row = NULL, + array_subset_col = NULL, + pxl_subset_row = NULL, + pxl_subset_col = NULL, + shape = "hexagon", + shape_size = 400) { # get params a <- list(Class = "VisiumHDReader") @@ -190,17 +194,14 @@ importVisiumHD <- function( # * init #### -setMethod("initialize", signature("VisiumHDReader"), function( - .Object, visiumHD_dir, - expression_source, - gene_column_index, - barcodes, - array_subset_row, - array_subset_col, - pxl_subset_row, - pxl_subset_col -) { - +setMethod("initialize", signature("VisiumHDReader"), function(.Object, visiumHD_dir, + expression_source, + gene_column_index, + barcodes, + array_subset_row, + array_subset_col, + pxl_subset_row, + pxl_subset_col) { # provided params (if any) if (!missing(visiumHD_dir)) { checkmate::assert_directory_exists(visiumHD_dir) @@ -246,20 +247,26 @@ setMethod("initialize", signature("VisiumHDReader"), function( .visiumHD_detect <- function(pattern, path = p, recursive = FALSE) { - .detect_in_dir(pattern = pattern, path = path, - recursive = recursive, platform = "visiumHD") + .detect_in_dir( + pattern = pattern, path = path, + recursive = recursive, platform = "visiumHD" + ) } - filter_expr_dir <- .visiumHD_detect(pattern = "filtered_feature_bc_matrix", - path = p) - raw_expr_dir <- .visiumHD_detect(pattern = "raw_feature_bc_matrix", - path = p) + filter_expr_dir <- .visiumHD_detect( + pattern = "filtered_feature_bc_matrix", + path = p + ) + raw_expr_dir <- .visiumHD_detect( + pattern = "raw_feature_bc_matrix", + path = p + ) s <- .Object@expression_source - if(s == "raw") { + if (s == "raw") { expr_dir <- raw_expr_dir - } else if(s == "filter") { + } else if (s == "filter") { expr_dir <- filter_expr_dir } else { stop("expression source for visiumHD can only be raw or filter") @@ -269,35 +276,31 @@ setMethod("initialize", signature("VisiumHDReader"), function( c_index <- .Object@gene_column_index - if(!c_index %in% c(1, 2)) { + if (!c_index %in% c(1, 2)) { stop("gene column index can only be 1 (Ensembl) or 2 (gene symbols)") } - read_folder_fun <- function( - path = spatial_dir, - gene_column_index = c_index, - remove_zero_rows = TRUE, - split_by_type = TRUE, - verbose = NULL - ) - { + read_folder_fun <- function(path = spatial_dir, + gene_column_index = c_index, + remove_zero_rows = TRUE, + split_by_type = TRUE, + verbose = NULL) { .visiumHD_read_folder( path = path, expr_data = c("raw", "filter"), gene_column_index = 1, png_name = NULL, - verbose = verbose) + verbose = verbose + ) } .Object@calls$read_folder <- read_folder_fun ## matrix load call - matrix_fun <- function( - path = expr_dir, - gene_column_index = c_index, - remove_zero_rows = TRUE, - split_by_type = TRUE, - verbose = NULL - ) { + matrix_fun <- function(path = expr_dir, + gene_column_index = c_index, + remove_zero_rows = TRUE, + split_by_type = TRUE, + verbose = NULL) { .visiumHD_matrix( path = path, gene_column_index = gene_column_index, @@ -311,14 +314,11 @@ setMethod("initialize", signature("VisiumHDReader"), function( ## expression load call - expression_fun <- function( - path = expr_dir, - gene_column_index = c_index, - remove_zero_rows = TRUE, - split_by_type = TRUE, - verbose = NULL - ) { - + expression_fun <- function(path = expr_dir, + gene_column_index = c_index, + remove_zero_rows = TRUE, + split_by_type = TRUE, + verbose = NULL) { .visiumHD_expression( path = path, gene_column_index = gene_column_index, @@ -332,10 +332,8 @@ setMethod("initialize", signature("VisiumHDReader"), function( ## tissue position load call - tissue_position_fun <- function( - path = spatial_dir, - verbose = NULL - ) { + tissue_position_fun <- function(path = spatial_dir, + verbose = NULL) { .visiumHD_tissue_positions( path = path, verbose = verbose @@ -344,10 +342,8 @@ setMethod("initialize", signature("VisiumHDReader"), function( .Object@calls$load_tissue_position <- tissue_position_fun ## scale factor load call - read_scalefactors <- function( - path = spatial_dir, - verbose = NULL - ) { + read_scalefactors <- function(path = spatial_dir, + verbose = NULL) { .visiumHD_read_scalefactors( path = path, verbose = verbose @@ -355,41 +351,37 @@ setMethod("initialize", signature("VisiumHDReader"), function( } .Object@calls$load_scalefactor <- read_scalefactors - load_image_fun <- function( - path = spatial_dir, - image_name = c("hires", "lowres"), - scale_factor_name = c("tissue_hires_scalef", "tissue_lowres_scalef"), - verbose = NULL - ) { + load_image_fun <- function(path = spatial_dir, + image_name = c("hires", "lowres"), + scale_factor_name = c("tissue_hires_scalef", "tissue_lowres_scalef"), + verbose = NULL) { .visiumHD_image( image_path = path, json_info = json_info, micron_scale = micron_scale, - verbose = verbose) + verbose = verbose + ) } .Object@calls$load_image <- load_image_fun - load_poly_fun <- function( - path = expr_dir, - shape = "hexagon", - shape_size = 400, - name = "hex400", - verbose = NULL - ) { + load_poly_fun <- function(path = expr_dir, + shape = "hexagon", + shape_size = 400, + name = "hex400", + verbose = NULL) { .visiumHD_poly( path = path, shape = shape, shape_size = shape_size, name = name, - verbose = verbose) + verbose = verbose + ) } .Object@calls$load_polygon <- load_poly_fun ## metadata load call - meta_fun <- function( - path = spatial_dir, - verbose = NULL) { - + meta_fun <- function(path = spatial_dir, + verbose = NULL) { .visiumHD_meta( path = path, verbose = verbose @@ -401,40 +393,38 @@ setMethod("initialize", signature("VisiumHDReader"), function( ## transcript load call transcript_fun <- function(expr_path = expr_dir, - tissue_positions_path = spatial_dir, - barcodes = .Object@barcodes, - array_subset_row = .Object@array_subset_row, - array_subset_col = .Object@array_subset_col, - pxl_subset_row = .Object@pxl_subset_row, - pxl_subset_col = .Object@pxl_subset_col) { - - .visiumHD_transcript(expr_path = expr_path, - tissue_positions_path = tissue_positions_path, - barcodes = barcodes, - array_subset_row = array_subset_row, - array_subset_col = array_subset_col, - pxl_subset_row = pxl_subset_row, - pxl_subset_col = pxl_subset_col, - verbose = TRUE) - + tissue_positions_path = spatial_dir, + barcodes = .Object@barcodes, + array_subset_row = .Object@array_subset_row, + array_subset_col = .Object@array_subset_col, + pxl_subset_row = .Object@pxl_subset_row, + pxl_subset_col = .Object@pxl_subset_col) { + .visiumHD_transcript( + expr_path = expr_path, + tissue_positions_path = tissue_positions_path, + barcodes = barcodes, + array_subset_row = array_subset_row, + array_subset_col = array_subset_col, + pxl_subset_row = pxl_subset_row, + pxl_subset_col = pxl_subset_col, + verbose = TRUE + ) } .Object@calls$load_transcripts <- transcript_fun - giotto_object_fun <- function( - visiumHD_dir = visiumHD_dir, - expr_data = c("raw", "filter"), - gene_column_index = 2, - tissue_positions_path = spatial_dir, - expression_path = expr_path, - metadata_path = spatial_dir, - shape = "hexagon", - shape_size = 400, - load_expression = TRUE, - load_metadata = TRUE, - instructions = NULL, - png_name = NULL, - verbose = NULL - ) { + giotto_object_fun <- function(visiumHD_dir = visiumHD_dir, + expr_data = c("raw", "filter"), + gene_column_index = 2, + tissue_positions_path = spatial_dir, + expression_path = expr_path, + metadata_path = spatial_dir, + shape = "hexagon", + shape_size = 400, + load_expression = TRUE, + load_metadata = TRUE, + instructions = NULL, + png_name = NULL, + verbose = NULL) { load_expression <- as.logical(load_expression) load_metadata <- as.logical(load_metadata) @@ -457,7 +447,7 @@ setMethod("initialize", signature("VisiumHDReader"), function( pxl_subset_col = .Object@pxl_subset_col ) - g <- setGiotto(g,tx_list$gpoints[["rna"]]) + g <- setGiotto(g, tx_list$gpoints[["rna"]]) polys <- funs$load_polygon( path = expr_dir, @@ -467,15 +457,19 @@ setMethod("initialize", signature("VisiumHDReader"), function( verbose = NULL ) g <- setGiotto(g, polys) - g <- addSpatialCentroidLocations(gobject = g, - poly_info = paste0(shape, shape_size)) + g <- addSpatialCentroidLocations( + gobject = g, + poly_info = paste0(shape, shape_size) + ) g <- calculateOverlap(g, - spatial_info = paste0(shape, shape_size), - feat_info = "rna") + spatial_info = paste0(shape, shape_size), + feat_info = "rna" + ) g <- overlapToMatrix(g, - poly_info = paste0(shape, shape_size), - feat_info = "rna", - name = "raw") + poly_info = paste0(shape, shape_size), + feat_info = "rna", + name = "raw" + ) # images images <- funs$load_image( @@ -498,14 +492,14 @@ setMethod("initialize", signature("VisiumHDReader"), function( remove_zero_rows = TRUE, split_by_type = TRUE ) - #have to run this for loop its one expression matrice rn + # have to run this for loop its one expression matrice rn # only keep allowed cells and set into gobject # for (ex in exlist) { # bool <- colnames(ex[]) %in% allowed_ids # ex[] <- ex[][, bool] # g <- setGiotto(g, ex) - #} + # } g <- setGiotto(g, exlist[[1]]) } @@ -513,13 +507,12 @@ setMethod("initialize", signature("VisiumHDReader"), function( cx <- funs$load_metadata( path = metadata_path ) - #check this later causing to appear empty cellmetadata - #cx[] <- cx[][cell_ID %in% allowed_ids,] + # check this later causing to appear empty cellmetadata + # cx[] <- cx[][cell_ID %in% allowed_ids,] g <- setGiotto(g, cx) } return(g) - } .Object@calls$create_gobject <- giotto_object_fun @@ -531,33 +524,43 @@ setMethod("initialize", signature("VisiumHDReader"), function( #' @export setMethod("$", signature("VisiumHDReader"), function(x, name) { - basic_info <- c("visiumHD_dir", "expression_source", "gene_column_index", - "barcodes", "array_subset_row", "array_subset_col", - "pxl_subset_row", "pxl_subset_col") - if (name %in% basic_info) return(methods::slot(x, name)) + basic_info <- c( + "visiumHD_dir", "expression_source", "gene_column_index", + "barcodes", "array_subset_row", "array_subset_col", + "pxl_subset_row", "pxl_subset_col" + ) + if (name %in% basic_info) { + return(methods::slot(x, name)) + } return(x@calls[[name]]) }) #' @export setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { - basic_info <- c("visiumHD_dir", "expression_source", "gene_column_index", - "barcodes", "array_subset_row", "array_subset_col", - "pxl_subset_row", "pxl_subset_col") + basic_info <- c( + "visiumHD_dir", "expression_source", "gene_column_index", + "barcodes", "array_subset_row", "array_subset_col", + "pxl_subset_row", "pxl_subset_col" + ) if (name %in% basic_info) { methods::slot(x, name) <- value return(initialize(x)) } - stop(sprintf("Only items in '%s' can be set", - paste0(basic_info, collapse = "', '"))) + stop(sprintf( + "Only items in '%s' can be set", + paste0(basic_info, collapse = "', '") + )) }) #' @export `.DollarNames.VisiumHDReader` <- function(x, pattern) { - dn <- c("visiumHD_dir", "expression_source", "gene_column_index", - "barcodes", "array_subset_row", "array_subset_col", - "pxl_subset_row", "pxl_subset_col") + dn <- c( + "visiumHD_dir", "expression_source", "gene_column_index", + "barcodes", "array_subset_row", "array_subset_col", + "pxl_subset_row", "pxl_subset_col" + ) if (length(methods::slot(x, "calls")) > 0) { dn <- c(dn, paste0(names(methods::slot(x, "calls")), "()")) } @@ -566,47 +569,50 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { -.visiumHD_read_folder <- function( - path, - expr_data = c("raw", "filter"), - gene_column_index = 1, - png_name = NULL, - verbose = NULL) { +.visiumHD_read_folder <- function(path, + expr_data = c("raw", "filter"), + gene_column_index = 1, + png_name = NULL, + verbose = NULL) { vmsg(.v = verbose, "A structured visium directory will be used") - if (is.null(path)) + if (is.null(path)) { .gstop("path needs to be a path to a visium directory") + } path <- path.expand(path) path <- dirname(path) if (!dir.exists(path)) .gstop(path, " does not exist!") expr_data <- match.arg(expr_data, choices = c("raw", "filter")) ## 1. check expression - expr_counts_path <- switch( - expr_data, + expr_counts_path <- switch(expr_data, "raw" = paste0(path, "/", "raw_feature_bc_matrix/"), "filter" = paste0(path, "/", "filtered_feature_bc_matrix/") ) - if (!file.exists(expr_counts_path)) + if (!file.exists(expr_counts_path)) { .gstop(expr_counts_path, "does not exist!") + } ## 2. check spatial locations spatial_dir <- paste0(path, "/", "spatial") - tissue_positions_path <- Sys.glob(paths = file.path(spatial_dir, - "tissue_positions*")) + tissue_positions_path <- Sys.glob(paths = file.path( + spatial_dir, + "tissue_positions*" + )) ## 3. check spatial image - if(is.null(png_name)) { + if (is.null(png_name)) { png_list <- list.files(spatial_dir, pattern = "*.png") png_name <- png_list[1] } - png_path <- paste0(spatial_dir,"/",png_name) - if(!file.exists(png_path)) .gstop(png_path, " does not exist!") + png_path <- paste0(spatial_dir, "/", png_name) + if (!file.exists(png_path)) .gstop(png_path, " does not exist!") ## 4. check scalefactors scalefactors_path <- paste0(spatial_dir, "/", "scalefactors_json.json") - if (!file.exists(scalefactors_path)) + if (!file.exists(scalefactors_path)) { .gstop(scalefactors_path, "does not exist!") + } list( @@ -619,11 +625,10 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { } .visiumHD_matrix <- function(path = path, - gene_column_index = 2, - remove_zero_rows = TRUE, - split_by_type = TRUE, - verbose = TRUE) { - + gene_column_index = 2, + remove_zero_rows = TRUE, + split_by_type = TRUE, + verbose = TRUE) { # check if path is provided if (missing(path)) { stop(wrap_txt( @@ -638,13 +643,14 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { vmsg(.v = verbose, .is_debug = TRUE, path) # load expression results with the 10X default matrix function - matrix_results <- get10Xmatrix(path_to_data = path, - gene_column_index = gene_column_index, - remove_zero_rows = remove_zero_rows, - split_by_type = split_by_type) + matrix_results <- get10Xmatrix( + path_to_data = path, + gene_column_index = gene_column_index, + remove_zero_rows = remove_zero_rows, + split_by_type = split_by_type + ) return(matrix_results) - } @@ -652,11 +658,10 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { .visiumHD_expression <- function(path, - gene_column_index = 2, - remove_zero_rows = TRUE, - split_by_type = TRUE, - verbose = TRUE) { - + gene_column_index = 2, + remove_zero_rows = TRUE, + split_by_type = TRUE, + verbose = TRUE) { # check if path is provided if (missing(path)) { stop(wrap_txt( @@ -671,26 +676,27 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { vmsg(.v = verbose, .is_debug = TRUE, path) # load expression results with the 10X default matrix function - matrix_results <- get10Xmatrix(path_to_data = path, - gene_column_index = gene_column_index, - remove_zero_rows = remove_zero_rows, - split_by_type = split_by_type) + matrix_results <- get10Xmatrix( + path_to_data = path, + gene_column_index = gene_column_index, + remove_zero_rows = remove_zero_rows, + split_by_type = split_by_type + ) - exprObj <- createExprObj(expression_data = matrix_results, - spat_unit = "pixel", - feat_type = "rna", - name = "raw", - provenance = "pixel") + exprObj <- createExprObj( + expression_data = matrix_results, + spat_unit = "pixel", + feat_type = "rna", + name = "raw", + provenance = "pixel" + ) return(list("rna" = exprObj)) - - } .visiumHD_tissue_positions <- function(path, - verbose = TRUE) { - + verbose = TRUE) { # check if path is provided if (missing(path)) { stop(wrap_txt( @@ -714,7 +720,6 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { tissue_positions <- arrow::read_parquet(tissue_positions_path) return(tissue_positions) - } .check_new_format <- function(json_scalefactors) { @@ -743,7 +748,6 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { } .visiumHD_read_scalefactors <- function(path, verbose = TRUE) { - # check if path is provided if (missing(path)) { stop(wrap_txt( @@ -770,8 +774,10 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { "tissue_lowres_scalef" ) new_format_2023 <- .check_new_format(json_scalefactors) - expected_json_names <- .adjust_expected_names(new_format_2023, - expected_json_names) + expected_json_names <- .adjust_expected_names( + new_format_2023, + expected_json_names + ) .validate_json_names(json_scalefactors, expected_json_names) return(json_scalefactors) @@ -799,13 +805,13 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { return(img_type) } } - stop("image_path filename did not match either 'lowres' or 'hires'. + stop("image_path filename did not match either 'lowres' or 'hires'. Ensure the image is named accordingly.") } .get_scale_factor <- function(visiumHD_img_type, json_info) { if (is.null(json_info)) { - warning("No scalefactors json info provided. VisiumHD image + warning("No scalefactors json info provided. VisiumHD image scale_factor defaulting to 1.") return(1) } @@ -813,13 +819,16 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { checkmate::assert_list(json_info) scale_factor <- switch(visiumHD_img_type, - "lowres" = json_info[["tissue_lowres_scalef"]], - "hires" = json_info[["tissue_hires_scalef"]], - stop("Unexpected image type: ", visiumHD_img_type)) + "lowres" = json_info[["tissue_lowres_scalef"]], + "hires" = json_info[["tissue_hires_scalef"]], + stop("Unexpected image type: ", visiumHD_img_type) + ) if (is.null(scale_factor)) { - stop("Scale factor for ", visiumHD_img_type, - " image not found in json_info.") + stop( + "Scale factor for ", visiumHD_img_type, + " image not found in json_info." + ) } return(scale_factor) @@ -833,9 +842,9 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { } .visiumHD_image <- function(image_path, - json_info = NULL, - micron_scale = FALSE, - verbose = NULL) { + json_info = NULL, + micron_scale = FALSE, + verbose = NULL) { # Assume image already checked vmsg(.v = verbose, .initial = " - ", "found image") @@ -865,7 +874,7 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { } visiumHD_img_type <- .get_image_type(png_name) scale_factor <- .get_scale_factor(visiumHD_img_type, json_info) - #scale_factor <- .apply_micron_scale(scale_factor, json_info, px_to_micron) + # scale_factor <- .apply_micron_scale(scale_factor, json_info, px_to_micron) # 2. create image -------------------------------------------------------- # visiumHD_img <- createGiottoLargeImage( @@ -882,13 +891,12 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { } .visiumHD_poly <- function(path, - shape = "hexagon", - shape_size = 400, - name = "hex400", - verbose = TRUE){ - + shape = "hexagon", + shape_size = 400, + name = "hex400", + verbose = TRUE) { if (!shape %in% c("hexagon", "square", "circle")) { - stop("Invalid shape. Please choose either + stop("Invalid shape. Please choose either 'hexagon', 'square', or 'circle'.") } @@ -898,8 +906,11 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { tp <- arrow::read_parquet( file = .visiumHD_read_folder( - path, verbose = FALSE)[3]$tissue_positions_path, - as_data_frame = FALSE) + path, + verbose = FALSE + )[3]$tissue_positions_path, + as_data_frame = FALSE + ) original_feat_ext <- tp %>% @@ -907,25 +918,27 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { xmin = min(pxl_row_in_fullres, na.rm = TRUE), xmax = max(pxl_row_in_fullres, na.rm = TRUE), ymin = min(pxl_col_in_fullres, na.rm = TRUE), - ymax = max(pxl_col_in_fullres, na.rm = TRUE)) %>% + ymax = max(pxl_col_in_fullres, na.rm = TRUE) + ) %>% dplyr::collect() %>% - { ext(.$xmin, .$xmax, .$ymin, .$ymax) } + { + ext(.$xmin, .$xmax, .$ymin, .$ymax) + } - #ext(gpoints$rna@spatVector) + # ext(gpoints$rna@spatVector) message(paste("Creating a", shape, "polygon with size", shape_size)) - polygons <- tessellate(extent = original_feat_ext, - shape = shape, - shape_size = shape_size, - name = name) + polygons <- tessellate( + extent = original_feat_ext, + shape = shape, + shape_size = shape_size, + name = name + ) return(polygons) - } -.visiumHD_meta <- function( - path, - verbose = TRUE) { - +.visiumHD_meta <- function(path, + verbose = TRUE) { # check if path is provided if (missing(path)) { stop(wrap_txt( @@ -945,7 +958,8 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { # read with parquet and data.table tissue_positions <- data.table::as.data.table( - x = arrow::read_parquet(tissue_positions_path)) + x = arrow::read_parquet(tissue_positions_path) + ) vmsg(.v = verbose, "creating metadata ...") @@ -959,24 +973,21 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { verbose = verbose ) return(cx) - } .visiumHD_transcript <- function(expr_path, - gene_column_index = 2, - remove_zero_rows = TRUE, - split_by_type = TRUE, - tissue_positions_path, - barcodes = NULL, - array_subset_row = c(500, 1000), - array_subset_col = c(500, 1000), - pxl_subset_row = NULL, - pxl_subset_col = NULL, - verbose = TRUE) { - - + gene_column_index = 2, + remove_zero_rows = TRUE, + split_by_type = TRUE, + tissue_positions_path, + barcodes = NULL, + array_subset_row = c(500, 1000), + array_subset_col = c(500, 1000), + pxl_subset_row = NULL, + pxl_subset_col = NULL, + verbose = TRUE) { # function to create expression matrix matrix <- .visiumHD_matrix( path = expr_path, @@ -995,69 +1006,77 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { - vmsg(.v = verbose, - "creating visiumHD tissue position x expression data file ...") + vmsg( + .v = verbose, + "creating visiumHD tissue position x expression data file ..." + ) # subset data - if(!is.null(barcodes)) { + if (!is.null(barcodes)) { vmsg(.v = verbose, "subsetting visiumHD on barcodes") tissue_positions <- tissue_positions[barcode %in% barcodes] } - if(!is.null(array_subset_row)) { - if(is.vector(array_subset_row) & length(array_subset_row) == 2) { + if (!is.null(array_subset_row)) { + if (is.vector(array_subset_row) & length(array_subset_row) == 2) { vmsg(.v = verbose, "subsetting visiumHD on array rows") tissue_positions <- tissue_positions[ - array_row > array_subset_row[1] & - array_row < array_subset_row[2]] + array_row > array_subset_row[1] & + array_row < array_subset_row[2] + ] } else { - stop("array_subset_row was provided but is not a vector with + stop("array_subset_row was provided but is not a vector with length 2") } } - if(!is.null(array_subset_col)) { - if(is.vector(array_subset_col) & length(array_subset_col) == 2) { + if (!is.null(array_subset_col)) { + if (is.vector(array_subset_col) & length(array_subset_col) == 2) { vmsg(.v = verbose, "subsetting visiumHD on array columns") tissue_positions <- tissue_positions[ - array_col > array_subset_col[1] & - array_col < array_subset_col[2]] + array_col > array_subset_col[1] & + array_col < array_subset_col[2] + ] } else { - stop("array_subset_col was provided but is not a vector with + stop("array_subset_col was provided but is not a vector with length 2") } } - if(!is.null(pxl_subset_row)) { - if(is.vector(pxl_subset_row) & length(pxl_subset_row) == 2) { + if (!is.null(pxl_subset_row)) { + if (is.vector(pxl_subset_row) & length(pxl_subset_row) == 2) { vmsg(.v = verbose, "subsetting visiumHD on row pixels") tissue_positions <- tissue_positions[ - pxl_row_in_fullres > pxl_subset_row[1] & - pxl_row_in_fullres < pxl_subset_row[2]] + pxl_row_in_fullres > pxl_subset_row[1] & + pxl_row_in_fullres < pxl_subset_row[2] + ] } else { cat("pxl_subset_row is ", pxl_subset_row) - stop("pxl_subset_row was provided but is not a vector with + stop("pxl_subset_row was provided but is not a vector with length 2") } } - if(!is.null(pxl_subset_col)) { - if(is.vector(pxl_subset_col) & length(pxl_subset_col) == 2) { + if (!is.null(pxl_subset_col)) { + if (is.vector(pxl_subset_col) & length(pxl_subset_col) == 2) { vmsg(.v = verbose, "subsetting visiumHD on column pixels") tissue_positions <- tissue_positions[ - pxl_col_in_fullres > pxl_subset_col[1] & - pxl_col_in_fullres < pxl_subset_col[2]] + pxl_col_in_fullres > pxl_subset_col[1] & + pxl_col_in_fullres < pxl_subset_col[2] + ] } else { cat(pxl_subset_col) - stop("pxl_subset_col was provided but is not a vector with + stop("pxl_subset_col was provided but is not a vector with length 2") } } # also subset matrix if needed - if(any(!is.null(c(barcodes, - array_subset_row, array_subset_col, - pxl_subset_row, pxl_subset_col)))) { + if (any(!is.null(c( + barcodes, + array_subset_row, array_subset_col, + pxl_subset_row, pxl_subset_col + )))) { vmsg(.v = verbose, "subsetting visiumHD on expression matrix") matrix <- matrix[, colnames(matrix) %in% tissue_positions$barcode] } @@ -1070,15 +1089,18 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { matrix_tile_dt[, pixel := samples[j]] - # merge data.table matrix and spatial coordinates to create input for + # merge data.table matrix and spatial coordinates to create input for # Giotto Polygons gpoints <- data.table::merge.data.table( - matrix_tile_dt, tissue_positions, by.x = "pixel", by.y = "barcode") + matrix_tile_dt, tissue_positions, + by.x = "pixel", by.y = "barcode" + ) gpoints <- gpoints[ - ,.(pixel, pxl_row_in_fullres, pxl_col_in_fullres, gene, x)] + , .(pixel, pxl_row_in_fullres, pxl_col_in_fullres, gene, x) + ] colnames(gpoints) <- c("pixel", "x", "y", "gene", "counts") - gpoints <- createGiottoPoints(x = gpoints[,.(x, y, gene, pixel, counts)]) + gpoints <- createGiottoPoints(x = gpoints[, .(x, y, gene, pixel, counts)]) # ensure output is always a list if (!is.list(gpoints)) { @@ -1086,10 +1108,11 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { names(gpoints) <- objName(gpoints[[1L]]) } - return(list("matrix" = matrix, - "tissue_positions" = tissue_positions, - "gpoints" = gpoints)) - + return(list( + "matrix" = matrix, + "tissue_positions" = tissue_positions, + "gpoints" = gpoints + )) } #' @title Create 10x VisiumHD Giotto Object @@ -1108,21 +1131,19 @@ setMethod("$<-", signature("VisiumHDReader"), function(x, name, value) { #' @returns giotto object #' @details #' \itemize{ -#' \item{expr_data: raw will take expression data from raw_feature_bc_matrix +#' \item{expr_data: raw will take expression data from raw_feature_bc_matrix #' and filter from filtered_feature_bc_matrix} -#' \item{gene_column_index: which gene identifiers (names) to use if there +#' \item{gene_column_index: which gene identifiers (names) to use if there #' are multiple columns (e.g. ensemble and gene symbol)} #' } #' @export -createGiottoVisiumHDObject <- function( - visiumHD_dir = NULL, - expr_data = c("raw", "filter"), - gene_column_index = 1, - instructions = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray"), - cores = NA, - verbose = FALSE){ - +createGiottoVisiumHDObject <- function(visiumHD_dir = NULL, + expr_data = c("raw", "filter"), + gene_column_index = 1, + instructions = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray"), + cores = NA, + verbose = FALSE) { # NSE vars barcode <- row_pxl <- col_pxl <- in_tissue <- array_row <- array_col <- NULL @@ -1143,18 +1164,16 @@ createGiottoVisiumHDObject <- function( return(giotto_object) } -.visiumHD_create <- function( - expr_counts_path, - gene_column_index = NULL, # folder - tissue_positions_path, - image_path = NULL, - scale_json_path = NULL, - png_name = NULL, - instructions = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray"), - readerHD = readerHD, - verbose = NULL -) { +.visiumHD_create <- function(expr_counts_path, + gene_column_index = NULL, # folder + tissue_positions_path, + image_path = NULL, + scale_json_path = NULL, + png_name = NULL, + instructions = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray"), + readerHD = readerHD, + verbose = NULL) { # NSE vars barcode <- cell_ID <- row_pxl <- col_pxl <- in_tissue <- array_row <- array_col <- NULL @@ -1165,16 +1184,20 @@ createGiottoVisiumHDObject <- function( expr_counts_path <- readerHD$read_folder()[[1]] # 1. expression - expr_results <- get10Xmatrix(path_to_data = expr_counts_path, - gene_column_index = gene_column_index) + expr_results <- get10Xmatrix( + path_to_data = expr_counts_path, + gene_column_index = gene_column_index + ) # if expr_results is not a list, make it a list compatible with downstream - if (!is.list(expr_results)) + if (!is.list(expr_results)) { expr_results <- list("Gene Expression" = expr_results) + } # format expected data into list to be used with readExprData() raw_matrix_list <- list("cell" = list("rna" = list( - "raw" = expr_results[["Gene Expression"]]))) + "raw" = expr_results[["Gene Expression"]] + ))) # add protein expression data to list if it exists if ("Antibody Capture" %in% names(expr_results)) { @@ -1186,8 +1209,9 @@ createGiottoVisiumHDObject <- function( spatial_results <- readerHD$load_tissue_position() data.table::setnames(spatial_results, old = "barcode", new = "cell_ID") spatial_locs <- spatial_results[ - ,.(cell_ID, pxl_row_in_fullres,-pxl_col_in_fullres)] # flip x and y - colnames(spatial_locs) <- c("cell_ID", 'sdimx', 'sdimy') + , .(cell_ID, pxl_row_in_fullres, -pxl_col_in_fullres) + ] # flip x and y + colnames(spatial_locs) <- c("cell_ID", "sdimx", "sdimy") # 3. scalefactors (optional) json_info <- readerHD$load_scalefactor() @@ -1196,7 +1220,7 @@ createGiottoVisiumHDObject <- function( visium_png_list <- readerHD$load_image() # 5. metadata - meta_results <- spatial_results[,.(cell_ID, in_tissue, array_row, array_col)] + meta_results <- spatial_results[, .(cell_ID, in_tissue, array_row, array_col)] expr_types <- names(raw_matrix_list$cell) meta_list <- list() for (etype in expr_types) { @@ -1213,15 +1237,14 @@ createGiottoVisiumHDObject <- function( ) # 7. polygon information - visium_polygons <- readerHD$load_polygon() - giotto_object <- setPolygonInfo( - gobject = giotto_object, - x = visium_polygons, - centroids_to_spatlocs = FALSE, - verbose = FALSE, - initialize = TRUE - ) - -return(giotto_object) + visium_polygons <- readerHD$load_polygon() + giotto_object <- setPolygonInfo( + gobject = giotto_object, + x = visium_polygons, + centroids_to_spatlocs = FALSE, + verbose = FALSE, + initialize = TRUE + ) + return(giotto_object) } diff --git a/R/convenience_xenium.R b/R/convenience_xenium.R index 931ce3fa0..7b3af24fc 100644 --- a/R/convenience_xenium.R +++ b/R/convenience_xenium.R @@ -82,11 +82,12 @@ setMethod("print", signature("XeniumReader"), function(x, ...) show(x)) # * init #### setMethod( "initialize", signature("XeniumReader"), - function(.Object, - xenium_dir, - filetype, - qv_cutoff, - micron) { + function( + .Object, + xenium_dir, + filetype, + qv_cutoff, + micron) { obj <- callNextMethod(.Object) # provided params (if any) @@ -220,23 +221,24 @@ setMethod( } # transcripts load call - tx_fun <- function(path = tx_path, - feat_type = c( - "rna", - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - split_keyword = list( - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - flip_vertical = TRUE, - dropcols = c(), - qv_threshold = obj@qv, - cores = determine_cores(), - verbose = NULL) { + tx_fun <- function( + path = tx_path, + feat_type = c( + "rna", + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + split_keyword = list( + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + flip_vertical = TRUE, + dropcols = c(), + qv_threshold = obj@qv, + cores = determine_cores(), + verbose = NULL) { .xenium_transcript( path = path, feat_type = feat_type, @@ -251,12 +253,13 @@ setMethod( obj@calls$load_transcripts <- tx_fun # load polys call - poly_fun <- function(path = cell_bound_path, - name = "cell", - flip_vertical = TRUE, - calc_centroids = TRUE, - cores = determine_cores(), - verbose = NULL) { + poly_fun <- function( + path = cell_bound_path, + name = "cell", + flip_vertical = TRUE, + calc_centroids = TRUE, + cores = determine_cores(), + verbose = NULL) { .xenium_poly( path = path, name = name, @@ -269,10 +272,11 @@ setMethod( obj@calls$load_polys <- poly_fun # load cellmeta - cmeta_fun <- function(path = cell_meta_path, - dropcols = c("x_centroid", "y_centroid"), - cores = determine_cores(), - verbose = NULL) { + cmeta_fun <- function( + path = cell_meta_path, + dropcols = c("x_centroid", "y_centroid"), + cores = determine_cores(), + verbose = NULL) { .xenium_cellmeta( path = path, dropcols = dropcols, @@ -283,11 +287,12 @@ setMethod( obj@calls$load_cellmeta <- cmeta_fun # load featmeta - fmeta_fun <- function(path = panel_meta_path, - gene_ids = "symbols", - dropcols = c(), - cores = determine_cores(), - verbose = NULL) { + fmeta_fun <- function( + path = panel_meta_path, + gene_ids = "symbols", + dropcols = c(), + cores = determine_cores(), + verbose = NULL) { .xenium_featmeta( path = path, gene_ids = gene_ids, @@ -299,11 +304,12 @@ setMethod( obj@calls$load_featmeta <- fmeta_fun # load expression call - expr_fun <- function(path = expr_path, - gene_ids = "symbols", - remove_zero_rows = TRUE, - split_by_type = TRUE, - verbose = NULL) { + expr_fun <- function( + path = expr_path, + gene_ids = "symbols", + remove_zero_rows = TRUE, + split_by_type = TRUE, + verbose = NULL) { .xenium_expression( path = path, gene_ids = gene_ids, @@ -315,15 +321,16 @@ setMethod( obj@calls$load_expression <- expr_fun # load image call - img_fun <- function(path = img_focus_path, - name = "image", - output_dir, - micron = obj@micron, - negative_y = TRUE, - flip_vertical = FALSE, - flip_horizontal = FALSE, - verbose = NULL, - ...) { + img_fun <- function( + path = img_focus_path, + name = "image", + output_dir, + micron = obj@micron, + negative_y = TRUE, + flip_vertical = FALSE, + flip_horizontal = FALSE, + verbose = NULL, + ...) { .xenium_image( path = path, name = name, @@ -339,11 +346,12 @@ setMethod( obj@calls$load_image <- img_fun # load aligned image call - img_aff_fun <- function(path, - imagealignment_path, - name = "aligned_image", - micron = obj@micron, - verbose = NULL) { + img_aff_fun <- function( + path, + imagealignment_path, + name = "aligned_image", + micron = obj@micron, + verbose = NULL) { read10xAffineImage( file = path, imagealignment_path = imagealignment_path, @@ -356,36 +364,37 @@ setMethod( # create giotto object call - gobject_fun <- function(transcript_path = tx_path, - load_bounds = list( - cell = "cell", - nucleus = "nucleus" - ), - gene_panel_json_path = panel_meta_path, - expression_path = expr_path, - metadata_path = cell_meta_path, - feat_type = c( - "rna", - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - split_keyword = list( - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - load_images = "focus", - load_aligned_images = NULL, - load_transcripts = TRUE, - load_expression = FALSE, - load_cellmeta = FALSE, - instructions = NULL, - verbose = NULL) { + gobject_fun <- function( + transcript_path = tx_path, + load_bounds = list( + cell = "cell", + nucleus = "nucleus" + ), + gene_panel_json_path = panel_meta_path, + expression_path = expr_path, + metadata_path = cell_meta_path, + feat_type = c( + "rna", + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + split_keyword = list( + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + load_images = "focus", + load_aligned_images = NULL, + load_transcripts = TRUE, + load_expression = FALSE, + load_cellmeta = FALSE, + instructions = NULL, + verbose = NULL) { load_transcripts <- as.logical(load_transcripts) load_expression <- as.logical(load_expression) load_cellmeta <- as.logical(load_cellmeta) - + if (!load_transcripts && !load_expression) { warning(wrap_txt( "One of either transcripts or expression info should be loaded for a fully functioning object" @@ -436,7 +445,7 @@ setMethod( g <- setGiotto(g, tx_list, verbose = FALSE) # lists are fine } - + # polys if (!is.null(load_bounds)) { # replace convenient shortnames @@ -455,8 +464,8 @@ setMethod( } g <- setGiotto(g, blist, verbose = FALSE) } - - + + # expression if (load_expression) { ex <- funs$load_expression( @@ -496,12 +505,12 @@ setMethod( if (!is.null(load_images)) { load_images <- lapply(load_images, normalizePath, mustWork = FALSE) img_focus_path <- normalizePath(img_focus_path, mustWork = FALSE) - + # [exception] handle focus image dir is_focus <- load_images == "focus" | load_images == img_focus_path # split the focus image dir away from other entries load_images <- load_images[!is_focus] - + if (any(is_focus)) { focus_dir <- img_focus_path focus_files <- list.files(focus_dir, full.names = TRUE) @@ -509,17 +518,17 @@ setMethod( nbound <- length(focus_files) - 1L focus_names <- c("dapi", sprintf("bound%d", seq_len(nbound))) names(focus_files) <- focus_names - + # append to rest of entries load_images <- c(load_images, focus_files) } - + # ensure that input is list checkmate::assert_list(load_images) if (is.null(names(load_images))) { stop("'load_images' must be a named list of filepaths\n") } - + imglist <- list() imnames <- names(load_images) for (impath_i in seq_along(load_images)) { @@ -552,16 +561,16 @@ setMethod( } g <- setGiotto(g, aimglist) } - + # centroids vmsg(.v = verbose, "calculating centroids") spat_units_to_calc <- list_spatial_info_names(g) - g <- addSpatialCentroidLocations(g, + g <- addSpatialCentroidLocations(g, poly_info = spat_units_to_calc, provenance = as.list(spat_units_to_calc), verbose = FALSE ) - + vmsg(.v = verbose, "done") return(g) @@ -650,23 +659,24 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { ## transcript #### -.xenium_transcript <- function(path, - feat_type = c( - "rna", - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - split_keyword = list( - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - flip_vertical = TRUE, - dropcols = c(), - qv_threshold = 20, - cores = determine_cores(), - verbose = NULL) { +.xenium_transcript <- function( + path, + feat_type = c( + "rna", + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + split_keyword = list( + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + flip_vertical = TRUE, + dropcols = c(), + qv_threshold = 20, + cores = determine_cores(), + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to tx file provided or auto-detected" @@ -718,11 +728,12 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { } -.xenium_transcript_csv <- function(path, - dropcols = c(), - qv_threshold = 20, - cores = determine_cores(), - verbose = NULL) { +.xenium_transcript_csv <- function( + path, + dropcols = c(), + qv_threshold = 20, + cores = determine_cores(), + verbose = NULL) { tx_dt <- data.table::fread( path, nThread = cores, @@ -755,10 +766,11 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { return(tx_dt) } -.xenium_transcript_parquet <- function(path, - dropcols = c(), - qv_threshold = 20, - verbose = NULL) { +.xenium_transcript_parquet <- function( + path, + dropcols = c(), + qv_threshold = 20, + verbose = NULL) { package_check("dplyr") package_check("arrow", custom_msg = sprintf( "package 'arrow' is not yet installed\n\n To install:\n%s\n%s%s", @@ -804,12 +816,13 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { ## polygon #### -.xenium_poly <- function(path, - name = "cell", - flip_vertical = TRUE, - calc_centroids = TRUE, - cores = determine_cores(), - verbose = NULL) { +.xenium_poly <- function( + path, + name = "cell", + flip_vertical = TRUE, + calc_centroids = TRUE, + cores = determine_cores(), + verbose = NULL) { checkmate::assert_file_exists(path) checkmate::assert_character(name, len = 1L) @@ -866,10 +879,11 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { ## cellmeta #### -.xenium_cellmeta <- function(path, - dropcols = c(), - cores = determine_cores(), - verbose = NULL) { +.xenium_cellmeta <- function( + path, + dropcols = c(), + cores = determine_cores(), + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to metadata file provided or auto-detected" @@ -905,7 +919,7 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { } .xenium_cellmeta_csv <- function(path, dropcols = c(), - cores = determine_cores()) { + cores = determine_cores()) { data.table::fread(path, nThread = cores, drop = dropcols) } @@ -919,11 +933,12 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { ## featmeta #### -.xenium_featmeta <- function(path, - gene_ids = "symbols", - dropcols = c(), - cores = determine_cores(), - verbose = NULL) { +.xenium_featmeta <- function( + path, + gene_ids = "symbols", + dropcols = c(), + cores = determine_cores(), + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to panel metadata file provided or auto-detected" @@ -994,11 +1009,12 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { ## expression #### -.xenium_expression <- function(path, - gene_ids = "symbols", - remove_zero_rows = TRUE, - split_by_type = TRUE, - verbose = NULL) { +.xenium_expression <- function( + path, + gene_ids = "symbols", + remove_zero_rows = TRUE, + split_by_type = TRUE, + verbose = NULL) { if (missing(path)) { stop(wrap_txt( "No path to expression dir (mtx) or file (h5) provided or @@ -1038,7 +1054,7 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { # set correct feature name fname <- "rna" if (length(names(ex_list)) > 1L) fname <- names(ex_list) - + # specific feat type naming updates fname[fname == "Gene Expression"] <- "rna" fname[fname == "Negative Control Codeword"] <- "NegControlCodeword" @@ -1047,10 +1063,10 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { fname[fname == "Genomic Control"] <- "GenomicControl" fname[fname == "Unassigned Codeword"] <- "UnassignedCodeword" fname[fname == "Deprecated Codeword"] <- "DeprecatedCodeword" - - # catch for " " characters in feat type + + # catch for " " characters in feat type # (no major reason for doing this. spaces just make it harder to read) - fname <- gsub(" ", "_", fname) + fname <- gsub(" ", "_", fname) # lapply to process more than one if present eo_list <- lapply(seq_along(ex_list), function(ex_i) { @@ -1066,10 +1082,11 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { return(eo_list) } -.xenium_expression_h5 <- function(path, - gene_ids = "symbols", - remove_zero_rows = TRUE, - split_by_type = TRUE) { +.xenium_expression_h5 <- function( + path, + gene_ids = "symbols", + remove_zero_rows = TRUE, + split_by_type = TRUE) { get10Xmatrix_h5( path_to_data = path, gene_ids = gene_ids, @@ -1078,10 +1095,11 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { ) } -.xenium_expression_mtx <- function(path, - gene_ids = "symbols", - remove_zero_rows = TRUE, - split_by_type = TRUE) { +.xenium_expression_mtx <- function( + path, + gene_ids = "symbols", + remove_zero_rows = TRUE, + split_by_type = TRUE) { gene_ids <- switch(gene_ids, "ensembl" = 1, "symbols" = 2 @@ -1099,28 +1117,29 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { ## image #### -.xenium_image <- function(path, - name, - output_dir, - micron, - negative_y = TRUE, - flip_vertical = FALSE, - flip_horizontal = FALSE, - verbose = NULL, - ...) { +.xenium_image <- function( + path, + name, + output_dir, + micron, + negative_y = TRUE, + flip_vertical = FALSE, + flip_horizontal = FALSE, + verbose = NULL, + ...) { if (missing(path)) { stop(wrap_txt( "No path to image file provided or auto-detected" ), call. = FALSE) } - + # *** whether .ome or not does not matter for this function *** # # set default if still missing if (missing(name)) name <- "image" # default = new tif_exports folder one layer down if (missing(output_dir)) output_dir <- "default" - + # [names] if (length(name) != length(path) && length(name) != 1) { @@ -1138,17 +1157,17 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { dir_name <- name[is_dir] path <- path[!is_dir] name <- name[!is_dir] - + # expand directory inputs if (length(dir_path) > 0L) { for (dir_i in seq_along(dir_path)) { dp_i <- dir_path[[dir_i]] # dir path dn_i <- dir_name[[dir_i]] # dir name vmsg(.is_debug = TRUE, "img dir input:", dp_i) - + # expand and update to per-image dfp_i <- list.files(dp_i, full.names = TRUE) # dir file paths - dfp_i <- dfp_i[!dir.exists(dfp_i)] # ignore dir matches + dfp_i <- dfp_i[!dir.exists(dfp_i)] # ignore dir matches # (such as the export directory) dfn_i <- sprintf("%s_%d", dn_i, seq_along(dfp_i)) # dir file names vmsg(.is_debug = TRUE, "* [img paths]:\n", paste(dfp_i, collapse = "\n")) @@ -1159,7 +1178,7 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { name <- c(name, dfn_i) } } - + # [paths] # check files exist vapply(path, checkmate::assert_file_exists, FUN.VALUE = character(1L)) @@ -1195,15 +1214,16 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { # if exists && if overwrite : remove converted image # if still not exist : create converted image # use image -.xenium_image_single <- function(path, - name = "image", - output_dir, - micron, - negative_y = TRUE, - flip_vertical = FALSE, - flip_horizontal = FALSE, - overwrite = FALSE, - verbose = NULL) { +.xenium_image_single <- function( + path, + name = "image", + output_dir, + micron, + negative_y = TRUE, + flip_vertical = FALSE, + flip_horizontal = FALSE, + overwrite = FALSE, + verbose = NULL) { vmsg(.v = verbose, sprintf("loading image as '%s'", name)) vmsg(.v = verbose, .is_debug = TRUE, path) vmsg( @@ -1215,7 +1235,7 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { .prefix = "" ) - # terra::rast() and gdal still have difficulties with 10x single channel + # terra::rast() and gdal still have difficulties with 10x single channel # .ome.tif images. May be related to JP2OpenJPEG driver but even loading # this does not seem to fix it. if ("ome" %in% file_extension(path)) { @@ -1223,7 +1243,7 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { # default output dir is a new folder under the same directory output_dir <- file.path(dirname(path), "tif_exports") } - + # check for existence of converted tiff file in output dir # fullpath of tiff to write tiff_path <- file.path(output_dir, basename(path)) @@ -1239,7 +1259,7 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { # the convenience fun can be run multiple times on the dataset # So, we allow directly using already converted imgs } - + # check the fullpath again if (!checkmate::test_file_exists(tiff_path)) { vmsg(.is_debug = TRUE, sprintf( @@ -1253,7 +1273,7 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { overwrite = overwrite ) } - + path <- tiff_path } @@ -1366,34 +1386,35 @@ importXenium <- function(xenium_dir = NULL, qv_threshold = 20) { #' #' @md #' @export -createGiottoXeniumObject <- function(xenium_dir, - transcript_path = NULL, # optional - bounds_path = list( # looks for parquets by default - cell = "cell", - nucleus = "nucleus" - ), - gene_panel_json_path = NULL, # optional - expression_path = NULL, # optional - cell_metadata_path = NULL, # optional - feat_type = c( - "rna", - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - split_keyword = list( - "NegControlProbe", - "UnassignedCodeword", - "NegControlCodeword" - ), - qv_threshold = 20, - load_images = "focus", - load_aligned_images = NULL, - load_transcripts = TRUE, - load_expression = FALSE, - load_cellmeta = FALSE, - instructions = NULL, - verbose = NULL) { +createGiottoXeniumObject <- function( + xenium_dir, + transcript_path = NULL, # optional + bounds_path = list( # looks for parquets by default + cell = "cell", + nucleus = "nucleus" + ), + gene_panel_json_path = NULL, # optional + expression_path = NULL, # optional + cell_metadata_path = NULL, # optional + feat_type = c( + "rna", + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + split_keyword = list( + "NegControlProbe", + "UnassignedCodeword", + "NegControlCodeword" + ), + qv_threshold = 20, + load_images = "focus", + load_aligned_images = NULL, + load_transcripts = TRUE, + load_expression = FALSE, + load_cellmeta = FALSE, + instructions = NULL, + verbose = NULL) { x <- importXenium(xenium_dir) # apply reader params x$qv <- qv_threshold diff --git a/R/cross_section.R b/R/cross_section.R index 1887bbc3a..05001ad99 100644 --- a/R/cross_section.R +++ b/R/cross_section.R @@ -31,20 +31,21 @@ #' @param cell_subset_projection_coords 2D PCA coordinates of selected cells #' in the cross section plane #' @returns crossSection object -create_crossSection_object <- function(name = NULL, - method = NULL, - thickness_unit = NULL, - slice_thickness = NULL, - cell_distance_estimate_method = NULL, - extend_ratio = NULL, - plane_equation = NULL, - mesh_grid_n = NULL, - mesh_obj = NULL, - cell_subset = NULL, - cell_subset_spatial_locations = NULL, - cell_subset_projection_locations = NULL, - cell_subset_projection_PCA = NULL, - cell_subset_projection_coords = NULL) { +create_crossSection_object <- function( + name = NULL, + method = NULL, + thickness_unit = NULL, + slice_thickness = NULL, + cell_distance_estimate_method = NULL, + extend_ratio = NULL, + plane_equation = NULL, + mesh_grid_n = NULL, + mesh_obj = NULL, + cell_subset = NULL, + cell_subset_spatial_locations = NULL, + cell_subset_projection_locations = NULL, + cell_subset_projection_PCA = NULL, + cell_subset_projection_coords = NULL) { crossSection_obj <- list( "method" = method, "thickness_unit" = thickness_unit, @@ -69,10 +70,11 @@ create_crossSection_object <- function(name = NULL, #' @param spatial_network_name spatial_network_name #' @returns crossSectionObjects #' @keywords internal -read_crossSection <- function(gobject, - spat_unit = NULL, - name = NULL, - spatial_network_name = NULL) { +read_crossSection <- function( + gobject, + spat_unit = NULL, + name = NULL, + spatial_network_name = NULL) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -129,10 +131,11 @@ read_crossSection <- function(gobject, #' @param method method #' @returns matrix #' @keywords internal -estimateCellCellDistance <- function(gobject, - spat_unit = NULL, - spatial_network_name = "Delaunay_network", - method = c("mean", "median")) { +estimateCellCellDistance <- function( + gobject, + spat_unit = NULL, + spatial_network_name = "Delaunay_network", + method = c("mean", "median")) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -162,13 +165,14 @@ estimateCellCellDistance <- function(gobject, #' @param plane_equation plane_equation #' @returns numeric #' @keywords internal -get_sectionThickness <- function(gobject, - spat_unit = NULL, - thickness_unit = c("cell", "natural"), - slice_thickness = 2, - spatial_network_name = "Delaunay_network", - cell_distance_estimate_method = c("mean", "median"), - plane_equation = NULL) { +get_sectionThickness <- function( + gobject, + spat_unit = NULL, + thickness_unit = c("cell", "natural"), + slice_thickness = 2, + spatial_network_name = "Delaunay_network", + cell_distance_estimate_method = c("mean", "median"), + plane_equation = NULL) { thickness_unit <- match.arg(thickness_unit, c("cell", "natural")) section_thickness <- switch(thickness_unit, @@ -225,9 +229,10 @@ projection_fun <- function(point_to_project, plane_point, plane_norm) { #' @param mesh_obj mesh_obj #' @returns numeric #' @keywords internal -adapt_aspect_ratio <- function(current_ratio, cell_locations, - sdimx = NULL, sdimy = NULL, sdimz = NULL, - mesh_obj = NULL) { +adapt_aspect_ratio <- function( + current_ratio, cell_locations, + sdimx = NULL, sdimy = NULL, sdimz = NULL, + mesh_obj = NULL) { x_range <- max(cell_locations[[sdimx]]) - min(cell_locations[[sdimx]]) y_range <- max(cell_locations[[sdimy]]) - min(cell_locations[[sdimy]]) z_range <- max(cell_locations[[sdimz]]) - min(cell_locations[[sdimz]]) @@ -315,8 +320,8 @@ find_x_y_ranges <- function(data, extend_ratio) { #' @param mesh_grid_n mesh_grid_n #' @returns 2d mesh grid line object #' @keywords internal -create_2d_mesh_grid_line_obj <- function(x_min, x_max, y_min, - y_max, mesh_grid_n) { +create_2d_mesh_grid_line_obj <- function(x_min, x_max, y_min, + y_max, mesh_grid_n) { x_grid <- seq(x_min, x_max, length.out = mesh_grid_n) y_grid <- seq(y_min, y_max, length.out = mesh_grid_n) @@ -414,8 +419,8 @@ reshape_to_mesh_grid_obj <- function(data_points, mesh_grid_n) { #' @param mesh_grid_n mesh_grid_n #' @returns 3d mesh #' @keywords internal -transform_2d_mesh_to_3d_mesh <- function(mesh_line_obj_2d, pca_out, - center_vec, mesh_grid_n) { +transform_2d_mesh_to_3d_mesh <- function(mesh_line_obj_2d, pca_out, + center_vec, mesh_grid_n) { data_point_2d <- reshape_to_data_point(mesh_line_obj_2d) center_mat <- matrix( rep(center_vec, dim(data_point_2d)[1]), @@ -458,8 +463,8 @@ get_cross_section_coordinates <- function(cell_subset_projection_locations) { #' @param mesh_grid_n mesh_grid_n #' @returns mesh grid lines #' @keywords internal -create_mesh_grid_lines <- function(cell_subset_projection_locations, - extend_ratio, mesh_grid_n) { +create_mesh_grid_lines <- function(cell_subset_projection_locations, + extend_ratio, mesh_grid_n) { cell_subset_projection_PCA <- stats::prcomp( cell_subset_projection_locations ) @@ -557,26 +562,27 @@ create_mesh_grid_lines <- function(cell_subset_projection_locations, #' #' crossSectionPlot(g, name = "new_cs") #' @export -createCrossSection <- function(gobject, - spat_unit = NULL, - spat_loc_name = "raw", - name = "cross_section", - spatial_network_name = "Delaunay_network", - thickness_unit = c("cell", "natural"), - slice_thickness = 2, - cell_distance_estimate_method = "mean", - extend_ratio = 0.2, - method = c( - "equation", "3 points", "point and norm vector", - "point and two plane vectors" - ), - equation = NULL, - point1 = NULL, point2 = NULL, point3 = NULL, - normVector = NULL, - planeVector1 = NULL, planeVector2 = NULL, - mesh_grid_n = 20, - return_gobject = TRUE, - verbose = NULL) { +createCrossSection <- function( + gobject, + spat_unit = NULL, + spat_loc_name = "raw", + name = "cross_section", + spatial_network_name = "Delaunay_network", + thickness_unit = c("cell", "natural"), + slice_thickness = 2, + cell_distance_estimate_method = "mean", + extend_ratio = 0.2, + method = c( + "equation", "3 points", "point and norm vector", + "point and two plane vectors" + ), + equation = NULL, + point1 = NULL, point2 = NULL, point3 = NULL, + normVector = NULL, + planeVector1 = NULL, planeVector2 = NULL, + mesh_grid_n = 20, + return_gobject = TRUE, + verbose = NULL) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -778,16 +784,15 @@ createCrossSection <- function(gobject, #' @md #' @seealso [GiottoVisuals::spatGenePlot3D] and [GiottoVisuals::spatFeatPlot2D] #' @export -crossSectionFeatPlot <- function( - gobject = NULL, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - crossSection_obj = NULL, - name = NULL, - spatial_network_name = "Delaunay_network", - default_save_name = "crossSectionGenePlot", - ...) { +crossSectionFeatPlot <- function(gobject = NULL, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + crossSection_obj = NULL, + name = NULL, + spatial_network_name = "Delaunay_network", + default_save_name = "crossSectionGenePlot", + ...) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -865,15 +870,16 @@ crossSectionFeatPlot <- function( #' @details Description of parameters. #' @export #' @seealso \code{\link{crossSectionPlot}} -crossSectionPlot <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - crossSection_obj = NULL, - name = NULL, - spatial_network_name = "Delaunay_network", - default_save_name = "crossSectionPlot", - ...) { +crossSectionPlot <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + crossSection_obj = NULL, + name = NULL, + spatial_network_name = "Delaunay_network", + default_save_name = "crossSectionPlot", + ...) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -939,7 +945,7 @@ crossSectionPlot <- function(gobject, #' @param gobject giotto object #' @param spat_unit spatial unit #' @param feat_type feature type -#' @param crossSection_obj cross section object as alternative input. +#' @param crossSection_obj cross section object as alternative input. #' default = NULL. #' @param name name of virtual cross section to use #' @param spatial_network_name name of spatial network to use @@ -952,16 +958,17 @@ crossSectionPlot <- function(gobject, #' @return ggplot #' @details Description of parameters. #' @export -crossSectionFeatPlot3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - crossSection_obj = NULL, - name = NULL, - spatial_network_name = "Delaunay_network", - show_other_cells = TRUE, - other_cell_color = alpha("lightgrey", 0), - default_save_name = "crossSectionGenePlot3D", - ...) { +crossSectionFeatPlot3D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + crossSection_obj = NULL, + name = NULL, + spatial_network_name = "Delaunay_network", + show_other_cells = TRUE, + other_cell_color = alpha("lightgrey", 0), + default_save_name = "crossSectionGenePlot3D", + ...) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -1020,16 +1027,17 @@ crossSectionFeatPlot3D <- function(gobject, #' @returns ggplot #' @details Description of parameters. #' @export -crossSectionPlot3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - crossSection_obj = NULL, - name = NULL, - spatial_network_name = "Delaunay_network", - show_other_cells = TRUE, - other_cell_color = alpha("lightgrey", 0), - default_save_name = "crossSection3D", - ...) { +crossSectionPlot3D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + crossSection_obj = NULL, + name = NULL, + spatial_network_name = "Delaunay_network", + show_other_cells = TRUE, + other_cell_color = alpha("lightgrey", 0), + default_save_name = "crossSection3D", + ...) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -1098,22 +1106,23 @@ crossSectionPlot3D <- function(gobject, #' @returns ggplot #' @details Description of parameters. #' @export -insertCrossSectionSpatPlot3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - crossSection_obj = NULL, - name = NULL, - spatial_network_name = "Delaunay_network", - mesh_grid_color = "#1f77b4", - mesh_grid_width = 3, - mesh_grid_style = "dot", - sdimx = "sdimx", sdimy = "sdimy", sdimz = "sdimz", - show_other_cells = FALSE, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - default_save_name = "spat3D_with_cross_section", - ...) { +insertCrossSectionSpatPlot3D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + crossSection_obj = NULL, + name = NULL, + spatial_network_name = "Delaunay_network", + mesh_grid_color = "#1f77b4", + mesh_grid_width = 3, + mesh_grid_style = "dot", + sdimx = "sdimx", sdimy = "sdimy", sdimz = "sdimz", + show_other_cells = FALSE, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + default_save_name = "spat3D_with_cross_section", + ...) { package_check("plotly", repository = "CRAN:plotly") spat_unit <- set_default_spat_unit( @@ -1232,25 +1241,24 @@ insertCrossSectionSpatPlot3D <- function(gobject, #' @details Description of parameters. #' @md #' @export -insertCrossSectionFeatPlot3D <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - crossSection_obj = NULL, - name = NULL, - spatial_network_name = "Delaunay_network", - mesh_grid_color = "#1f77b4", - mesh_grid_width = 3, - mesh_grid_style = "dot", - sdimx = "sdimx", sdimy = "sdimy", sdimz = "sdimz", - show_other_cells = FALSE, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - show_plot = NULL, return_plot = NULL, save_plot = NULL, - save_param = list(), - default_save_name = "spatGenePlot3D_with_cross_section", - ...) { +insertCrossSectionFeatPlot3D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + crossSection_obj = NULL, + name = NULL, + spatial_network_name = "Delaunay_network", + mesh_grid_color = "#1f77b4", + mesh_grid_width = 3, + mesh_grid_style = "dot", + sdimx = "sdimx", sdimy = "sdimy", sdimz = "sdimz", + show_other_cells = FALSE, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + show_plot = NULL, return_plot = NULL, save_plot = NULL, + save_param = list(), + default_save_name = "spatGenePlot3D_with_cross_section", + ...) { package_check("plotly", repository = "CRAN:plotly") spat_unit <- set_default_spat_unit( diff --git a/R/dd.R b/R/dd.R index b3e7510e7..f25f5ffdd 100644 --- a/R/dd.R +++ b/R/dd.R @@ -28,13 +28,13 @@ #' @param gobject giotto object #' @param spat_unit spatial unit (e.g. "cell") #' @param feat_type feature type (e.g. "rna", "dna", "protein") -#' @param return_uniques return unique nesting names (ignores if final object +#' @param return_uniques return unique nesting names (ignores if final object #' exists/is correct class) #' @param output what format in which to get information (e.g. "data.table") -#' @param set_defaults set default spat_unit and feat_type. Change to FALSE +#' @param set_defaults set default spat_unit and feat_type. Change to FALSE #' only when #' expression and spat_info are not expected to exist. -#' @param copy_obj whether to deep copy/duplicate when getting the object +#' @param copy_obj whether to deep copy/duplicate when getting the object #' (default = TRUE) #' @param initialize (default = FALSE) whether to initialize the gobject before #' returning @@ -69,7 +69,7 @@ NULL #' @name plot_cell_params #' @param cell_color character. what to color cells by (e.g. metadata col or #' spatial enrichment col) -#' @param color_as_factor logical. convert color column to factor. discrete +#' @param color_as_factor logical. convert color column to factor. discrete #' colors are used when this is TRUE. continuous colors when FALSE. #' @param cell_color_code character. discrete colors to use. palette to use or #' named vector of colors @@ -93,13 +93,13 @@ NULL #' @param use_overlap use polygon and feature coordinates overlap results #' @param polygon_feat_type feature type associated with polygon information #' @param polygon_color color for polygon border -#' @param polygon_bg_color color for polygon background (overruled by +#' @param polygon_bg_color color for polygon background (overruled by #' polygon_fill) -#' @param polygon_fill character. what to color to fill polgyons by (e.g. +#' @param polygon_fill character. what to color to fill polgyons by (e.g. #' metadata col or spatial enrichment col) -#' @param polygon_fill_gradient polygon fill gradient colors given in order +#' @param polygon_fill_gradient polygon fill gradient colors given in order #' from low to high -#' @param polygon_fill_gradient_midpoint value to set as gradient midpoint +#' @param polygon_fill_gradient_midpoint value to set as gradient midpoint #' (optional). If left as \code{NULL}, the median value detected will be chosen #' @param polygon_fill_gradient_style either 'divergent' (midpoint is used in #' color scaling) or 'sequential' (scaled based on data range) @@ -122,7 +122,7 @@ NULL #' @param dim_point_size size of points in dim. reduction space #' @param dim_point_alpha transparancy of point in dim. reduction space #' @param dim_point_border_col border color of points in dim. reduction space -#' @param dim_point_border_stroke border stroke of points in dim. reduction +#' @param dim_point_border_stroke border stroke of points in dim. reduction #' space #' @returns plot #' @keywords internal @@ -132,9 +132,9 @@ NULL #' @name plot_nn_net_params #' @param show_NN_network logical. Show underlying NN network #' @param nn_network_to_use character. type of NN network to use (kNN vs sNN) -#' @param network_name character. name of NN network to use, if +#' @param network_name character. name of NN network to use, if #' show_NN_network = TRUE -#' @param nn_network_name character. name of NN network to use, if +#' @param nn_network_name character. name of NN network to use, if #' show_NN_network = TRUE #' @param network_color color of NN network #' @param nn_network_alpha column to use for alpha of the edges @@ -156,7 +156,7 @@ NULL #' Params documentation template: plot_spatenr_params #' @name plot_spatenr_params -#' @param spat_enr_names character. names of spatial enrichment results to +#' @param spat_enr_names character. names of spatial enrichment results to #' include #' @returns plot #' @keywords internal @@ -167,7 +167,7 @@ NULL #' @param show_image show a tissue background image #' @param gimage a giotto image #' @param image_name name of a giotto image or multiple images with group_by -#' @param largeImage_name name of a giottoLargeImage or multiple images with +#' @param largeImage_name name of a giottoLargeImage or multiple images with #' group_by #' @returns plot #' @keywords internal @@ -178,7 +178,7 @@ NULL #' #' @name plot_params #' -#' @param group_by character. Create multiple plots based on cell annotation +#' @param group_by character. Create multiple plots based on cell annotation #' column #' @param group_by_subset character. subset the group_by factor column #' @@ -189,7 +189,7 @@ NULL #' @param gradient_color character. continuous colors to use. palette to #' use or vector of colors to use (minimum of 2). #' -#' @param select_cell_groups select subset of cells/clusters based on +#' @param select_cell_groups select subset of cells/clusters based on #' cell_color parameter #' @param select_cells select subset of cells based on cell IDs #' @@ -243,9 +243,9 @@ NULL #' @param show_plot logical. show plot #' @param return_plot logical. return ggplot object #' @param save_plot logical. save the plot -#' @param save_param list of saving parameters, see +#' @param save_param list of saving parameters, see #' \code{\link{showSaveParameters}} -#' @param default_save_name default save name for saving, don't change, +#' @param default_save_name default save name for saving, don't change, #' change save_name in save_param #' @returns plot #' @keywords internal diff --git a/R/differential_expression.R b/R/differential_expression.R index 03c8e26e5..68c557814 100644 --- a/R/differential_expression.R +++ b/R/differential_expression.R @@ -35,18 +35,19 @@ #' #' findScranMarkers(g, cluster_column = "leiden_clus") #' @export -findScranMarkers <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - subset_clusters = NULL, - group_1 = NULL, - group_1_name = NULL, - group_2 = NULL, - group_2_name = NULL, - verbose = TRUE, - ...) { +findScranMarkers <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + subset_clusters = NULL, + group_1 = NULL, + group_1_name = NULL, + group_2 = NULL, + group_2_name = NULL, + verbose = TRUE, + ...) { # verify if optional package is installed package_check(pkg_name = "scran", repository = "Bioc") @@ -188,18 +189,19 @@ findScranMarkers <- function(gobject, #' #' findScranMarkers_one_vs_all(g, cluster_column = "leiden_clus") #' @export -findScranMarkers_one_vs_all <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - subset_clusters = NULL, - pval = 0.01, - logFC = 0.5, - min_feats = 10, - min_genes = NULL, - verbose = TRUE, - ...) { +findScranMarkers_one_vs_all <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + subset_clusters = NULL, + pval = 0.01, + logFC = 0.5, + min_feats = 10, + min_genes = NULL, + verbose = TRUE, + ...) { ## deprecated arguments if (!is.null(min_genes)) { min_feats <- min_genes @@ -401,22 +403,23 @@ findScranMarkers_one_vs_all <- function(gobject, #' #' findGiniMarkers(g, cluster_column = "leiden_clus") #' @export -findGiniMarkers <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - subset_clusters = NULL, - group_1 = NULL, - group_1_name = NULL, - group_2 = NULL, - group_2_name = NULL, - min_expr_gini_score = 0.2, - min_det_gini_score = 0.2, - detection_threshold = 0, - rank_score = 1, - min_feats = 5, - min_genes = NULL) { +findGiniMarkers <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + subset_clusters = NULL, + group_1 = NULL, + group_1_name = NULL, + group_2 = NULL, + group_2_name = NULL, + min_expr_gini_score = 0.2, + min_det_gini_score = 0.2, + detection_threshold = 0, + rank_score = 1, + min_feats = 5, + min_genes = NULL) { ## deprecated arguments if (!is.null(min_genes)) { min_feats <- min_genes @@ -654,19 +657,20 @@ findGiniMarkers <- function(gobject, #' #' findGiniMarkers_one_vs_all(g, cluster_column = "leiden_clus") #' @export -findGiniMarkers_one_vs_all <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - subset_clusters = NULL, - min_expr_gini_score = 0.5, - min_det_gini_score = 0.5, - detection_threshold = 0, - rank_score = 1, - min_feats = 4, - min_genes = NULL, - verbose = TRUE) { +findGiniMarkers_one_vs_all <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + subset_clusters = NULL, + min_expr_gini_score = 0.5, + min_det_gini_score = 0.5, + detection_threshold = 0, + rank_score = 1, + min_feats = 4, + min_genes = NULL, + verbose = TRUE) { ## deprecated arguments if (!is.null(min_genes)) { min_feats <- min_genes @@ -804,18 +808,19 @@ findGiniMarkers_one_vs_all <- function(gobject, #' group_2 = 2 #' ) #' @export -findMastMarkers <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - group_1 = NULL, - group_1_name = NULL, - group_2 = NULL, - group_2_name = NULL, - adjust_columns = NULL, - verbose = FALSE, - ...) { +findMastMarkers <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + group_1 = NULL, + group_1_name = NULL, + group_2 = NULL, + group_2_name = NULL, + adjust_columns = NULL, + verbose = FALSE, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1018,19 +1023,20 @@ findMastMarkers <- function(gobject, #' #' findMastMarkers_one_vs_all(gobject = g, cluster_column = "leiden_clus") #' @export -findMastMarkers_one_vs_all <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - subset_clusters = NULL, - adjust_columns = NULL, - pval = 0.001, - logFC = 1, - min_feats = 10, - min_genes = NULL, - verbose = TRUE, - ...) { +findMastMarkers_one_vs_all <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + subset_clusters = NULL, + adjust_columns = NULL, + pval = 0.001, + logFC = 1, + min_feats = 10, + min_genes = NULL, + verbose = TRUE, + ...) { ## deprecated arguments if (!is.null(min_genes)) { min_feats <- min_genes @@ -1178,25 +1184,26 @@ findMastMarkers_one_vs_all <- function(gobject, #' #' findMarkers(g, cluster_column = "leiden_clus") #' @export -findMarkers <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column = NULL, - method = c("scran", "gini", "mast"), - subset_clusters = NULL, - group_1 = NULL, - group_2 = NULL, - min_expr_gini_score = 0.5, - min_det_gini_score = 0.5, - detection_threshold = 0, - rank_score = 1, - min_feats = 4, - min_genes = NULL, - group_1_name = NULL, - group_2_name = NULL, - adjust_columns = NULL, - ...) { +findMarkers <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column = NULL, + method = c("scran", "gini", "mast"), + subset_clusters = NULL, + group_1 = NULL, + group_2 = NULL, + min_expr_gini_score = 0.5, + min_det_gini_score = 0.5, + detection_threshold = 0, + rank_score = 1, + min_feats = 4, + min_genes = NULL, + group_1_name = NULL, + group_2_name = NULL, + adjust_columns = NULL, + ...) { ## deprecated arguments if (!is.null(min_genes)) { min_feats <- min_genes @@ -1300,27 +1307,28 @@ findMarkers <- function(gobject, #' #' findMarkers_one_vs_all(g, cluster_column = "leiden_clus") #' @export -findMarkers_one_vs_all <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - subset_clusters = NULL, - method = c("scran", "gini", "mast"), - # scran & mast - pval = 0.01, - logFC = 0.5, - min_feats = 10, - min_genes = NULL, - # gini - min_expr_gini_score = 0.5, - min_det_gini_score = 0.5, - detection_threshold = 0, - rank_score = 1, - # mast specific - adjust_columns = NULL, - verbose = TRUE, - ...) { +findMarkers_one_vs_all <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + subset_clusters = NULL, + method = c("scran", "gini", "mast"), + # scran & mast + pval = 0.01, + logFC = 0.5, + min_feats = 10, + min_genes = NULL, + # gini + min_expr_gini_score = 0.5, + min_det_gini_score = 0.5, + detection_threshold = 0, + rank_score = 1, + # mast specific + adjust_columns = NULL, + verbose = TRUE, + ...) { ## deprecated arguments if (!is.null(min_genes)) { min_feats <- min_genes diff --git a/R/dimension_reduction.R b/R/dimension_reduction.R index 8b658a634..8bd3bccaa 100644 --- a/R/dimension_reduction.R +++ b/R/dimension_reduction.R @@ -23,12 +23,11 @@ #' x <- reduceDims(x, method = "nmf") #' @export reduceDims <- function( - gobject, - method = c("pca", "nmf", "umap", "tsne"), - projection = FALSE, - toplevel = 1L, - ... -) { + gobject, + method = c("pca", "nmf", "umap", "tsne"), + projection = FALSE, + toplevel = 1L, + ...) { a <- list(...) method <- match.arg(method, choices = c("pca", "nmf", "umap", "tsne")) if (projection) method <- paste(method, "proj", sep = "_") @@ -73,13 +72,14 @@ reduceDims <- function( #' @param seed_number seed number to use #' @keywords internal #' @returns list of eigenvalues, loadings and pca coordinates -.run_pca_factominer <- function(x, - ncp = 100, - scale = TRUE, - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - ...) { +.run_pca_factominer <- function( + x, + ncp = 100, + scale = TRUE, + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + ...) { # verify if optional package is installed package_check(pkg_name = "FactoMineR", repository = "CRAN") @@ -192,16 +192,17 @@ reduceDims <- function( #' @param BPPARAM BiocParallelParam object #' @keywords internal #' @returns list of eigenvalues, loadings and pca coordinates -.run_pca_biocsingular <- function(x, - ncp = 100, - center = TRUE, - scale = TRUE, - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - BSPARAM = c("irlba", "exact", "random"), - BPPARAM = BiocParallel::SerialParam(), - ...) { +.run_pca_biocsingular <- function( + x, + ncp = 100, + center = TRUE, + scale = TRUE, + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + BSPARAM = c("irlba", "exact", "random"), + BPPARAM = BiocParallel::SerialParam(), + ...) { BSPARAM <- match.arg(BSPARAM, choices = c("irlba", "exact", "random")) min_ncp <- min(dim(x)) @@ -289,12 +290,13 @@ reduceDims <- function( #' @keywords internal #' @noRd #' @returns subsetted matrix based on selected features -.create_feats_to_use_matrix <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - sel_matrix, - feats_to_use, - verbose = FALSE) { +.create_feats_to_use_matrix <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + sel_matrix, + feats_to_use, + verbose = FALSE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -392,25 +394,26 @@ reduceDims <- function( #' #' runPCA(g) #' @export -runPCA <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - name = NULL, - feats_to_use = "hvf", - return_gobject = TRUE, - center = TRUE, - scale_unit = TRUE, - ncp = 100, - method = c("irlba", "exact", "random", "factominer"), - method_params = BiocParallel::SerialParam(), - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - toplevel = 1L, - ...) { +runPCA <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + name = NULL, + feats_to_use = "hvf", + return_gobject = TRUE, + center = TRUE, + scale_unit = TRUE, + ncp = 100, + method = c("irlba", "exact", "random", "factominer"), + method_params = BiocParallel::SerialParam(), + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + toplevel = 1L, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -559,7 +562,8 @@ runPCA <- function(gobject, ## update parameters used ## gobject <- update_giotto_params( - gobject, description = "_pca", toplevel = toplevel + 1L + gobject, + description = "_pca", toplevel = toplevel + 1L ) return(gobject) } else { @@ -594,17 +598,18 @@ runPCA <- function(gobject, #' @param verbose verbosity level #' @keywords internal #' @returns list of eigenvalues, loadings and pca coordinates -.run_pca_biocsingular_irlba_projection <- function(x, - ncp = 100, - center = TRUE, - scale = TRUE, - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - BPPARAM = BiocParallel::SerialParam(), - random_subset = 500, - verbose = TRUE, - ...) { +.run_pca_biocsingular_irlba_projection <- function( + x, + ncp = 100, + center = TRUE, + scale = TRUE, + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + BPPARAM = BiocParallel::SerialParam(), + random_subset = 500, + verbose = TRUE, + ...) { x <- scale(x, center = center, scale = scale) min_ncp <- min(dim(x)) @@ -787,26 +792,27 @@ runPCA <- function(gobject, #' #' runPCAprojection(g) #' @export -runPCAprojection <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - random_subset = 500, - name = "pca.projection", - feats_to_use = "hvf", - return_gobject = TRUE, - center = TRUE, - scale_unit = TRUE, - ncp = 100, - method = c("irlba"), - method_params = BiocParallel::SerialParam(), - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - toplevel = 1L, - ...) { +runPCAprojection <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + random_subset = 500, + name = "pca.projection", + feats_to_use = "hvf", + return_gobject = TRUE, + center = TRUE, + scale_unit = TRUE, + ncp = 100, + method = c("irlba"), + method_params = BiocParallel::SerialParam(), + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + toplevel = 1L, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -923,7 +929,6 @@ runPCAprojection <- function(gobject, } if (isTRUE(return_gobject)) { - if (reduction == "cells") { my_row_names <- colnames(expr_values) } else { @@ -952,7 +957,8 @@ runPCAprojection <- function(gobject, ## update parameters used ## gobject <- update_giotto_params( - gobject, description = "_pca", toplevel = toplevel + 1L + gobject, + description = "_pca", toplevel = toplevel + 1L ) return(gobject) } else { @@ -1012,27 +1018,28 @@ runPCAprojection <- function(gobject, #' # (only 48 in this mini dataset) #' runPCAprojectionBatch(g, feats_to_use = NULL) #' @export -runPCAprojectionBatch <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - random_subset = 500, - batch_number = 5, - name = "pca.projection.batch", - feats_to_use = "hvf", - return_gobject = TRUE, - center = TRUE, - scale_unit = TRUE, - ncp = 100, - method = c("irlba"), - method_params = BiocParallel::SerialParam(), - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - toplevel = 1L, - ...) { +runPCAprojectionBatch <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + random_subset = 500, + batch_number = 5, + name = "pca.projection.batch", + feats_to_use = "hvf", + return_gobject = TRUE, + center = TRUE, + scale_unit = TRUE, + ncp = 100, + method = c("irlba"), + method_params = BiocParallel::SerialParam(), + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + toplevel = 1L, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1319,7 +1326,6 @@ runPCAprojectionBatch <- function(gobject, if (return_gobject == TRUE) { - if (reduction == "cells") { my_row_names <- colnames(expr_values) } else { @@ -1348,7 +1354,8 @@ runPCAprojectionBatch <- function(gobject, ## update parameters used ## gobject <- update_giotto_params( - gobject, description = "_pca", toplevel = toplevel + 1L + gobject, + description = "_pca", toplevel = toplevel + 1L ) return(gobject) } else { @@ -1394,27 +1401,28 @@ runPCAprojectionBatch <- function(gobject, #' #' screePlot(g) #' @export -screePlot <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - dim_reduction_name = NULL, - name = deprecated(), - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - method = c("irlba", "exact", "random", "factominer"), - rev = FALSE, - feats_to_use = NULL, - center = FALSE, - scale_unit = FALSE, - ncp = 100, - ylim = c(0, 20), - verbose = TRUE, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "screePlot", - ...) { +screePlot <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + dim_reduction_name = NULL, + name = deprecated(), + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + method = c("irlba", "exact", "random", "factominer"), + rev = FALSE, + feats_to_use = NULL, + center = FALSE, + scale_unit = FALSE, + ncp = 100, + ylim = c(0, 20), + verbose = TRUE, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "screePlot", + ...) { if (is_present(name)) { deprecate_warn( when = "4.1.1", @@ -1695,28 +1703,28 @@ create_screeplot <- function(eigs, ncp = 20, ylim = c(0, 20)) { #' jackstrawPlot(gobject = g) #' @md #' @export -jackstrawPlot <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - feats_to_use = "hvf", - center = TRUE, - scale_unit = TRUE, - ncp = 20, - ylim = c(0, 1), - iter = 10, - threshold = 0.01, - random_subset = NULL, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "jackstrawPlot") { - +jackstrawPlot <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + feats_to_use = "hvf", + center = TRUE, + scale_unit = TRUE, + ncp = 20, + ylim = c(0, 1), + iter = 10, + threshold = 0.01, + random_subset = NULL, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "jackstrawPlot") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1769,7 +1777,6 @@ jackstrawPlot <- function(gobject, )) expr_values <- expr_values[, random_selection] } - } @@ -1817,9 +1824,11 @@ jackstrawPlot <- function(gobject, ## results ## nr_sign_components <- jtest$r - vmsg(.v = verbose, - "\nnumber of estimated significant components: ", - nr_sign_components) + vmsg( + .v = verbose, + "\nnumber of estimated significant components: ", + nr_sign_components + ) if (ncp <= nr_sign_components) { warning(wrap_txt( @@ -1866,11 +1875,12 @@ jackstrawPlot <- function(gobject, #' @keywords internal #' @returns ggplot #' @noRd -.create_jackstrawplot <- function(jackstraw_data, - ncp = 20, - ylim = c(0, 1), - threshold = 0.01, - iter = 100) { +.create_jackstrawplot <- function( + jackstraw_data, + ncp = 20, + ylim = c(0, 1), + threshold = 0.01, + iter = 100) { checkmate::assert_numeric(ncp, len = 1L) checkmate::assert_numeric(ylim, len = 2L) checkmate::assert_numeric(threshold, len = 1L) @@ -1912,10 +1922,10 @@ jackstrawPlot <- function(gobject, # based on the `permutationPA`() implementation in jackstraw package -.perm_pa <- function (dat, iter = 100, threshold = 0.05, ncp, verbose = TRUE) -{ - if (missing(dat)) +.perm_pa <- function(dat, iter = 100, threshold = 0.05, ncp, verbose = TRUE) { + if (missing(dat)) { stop("`dat` is required!") + } n <- ncol(dat) m <- nrow(dat) ndf <- min(m, n - 1, ncp) # this is a limitation of svd singular values @@ -1923,8 +1933,11 @@ jackstrawPlot <- function(gobject, # pick SVD fun based on whether partial or full is appropriate # These biocsingular functions should not scale or center - svd_fun <- if (ndf >= 0.5 * m || ndf >= 100) BiocSingular::runExactSVD - else BiocSingular::runIrlbaSVD # partial SVDs + svd_fun <- if (ndf >= 0.5 * m || ndf >= 100) { + BiocSingular::runExactSVD + } else { + BiocSingular::runIrlbaSVD + } # partial SVDs .calc_svd_var_explained <- function(x, k) { res <- svd_fun(x, k = k) @@ -1937,8 +1950,10 @@ jackstrawPlot <- function(gobject, # randomize and compare dstat0 <- matrix(0, nrow = iter, ncol = ndf) - vmsg(.v = verbose, - "Estimating number of significant principal components: ") + vmsg( + .v = verbose, + "Estimating number of significant principal components: " + ) with_pbar({ pb <- pbar(steps = iter) @@ -2001,29 +2016,30 @@ jackstrawPlot <- function(gobject, #' #' signPCA(g) #' @export -signPCA <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - name = NULL, - method = c("screeplot", "jackstraw"), - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - pca_method = c("irlba", "factominer"), - rev = FALSE, - feats_to_use = NULL, - center = TRUE, - scale_unit = TRUE, - ncp = 50, - scree_ylim = c(0, 10), - jack_iter = 10, - jack_threshold = 0.01, - jack_ylim = c(0, 1), - verbose = TRUE, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "signPCA") { +signPCA <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + name = NULL, + method = c("screeplot", "jackstraw"), + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + pca_method = c("irlba", "factominer"), + rev = FALSE, + feats_to_use = NULL, + center = TRUE, + scale_unit = TRUE, + ncp = 50, + scree_ylim = c(0, 10), + jack_iter = 10, + jack_threshold = 0.01, + jack_ylim = c(0, 1), + verbose = TRUE, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "signPCA") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2196,24 +2212,24 @@ signPCA <- function(gobject, #' plotUMAP(x, dim_reduction_name = "nmf_umap", cell_color = "nmf_leiden") #' spatPlot2D(x, cell_color = "nmf_leiden") #' @export -runNMF <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - name = NULL, - feats_to_use = "hvf", - return_gobject = TRUE, - scale_unit = TRUE, - k = 20, - method = c("rcppml"), - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - toplevel = 1L, - ... -) { +runNMF <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + name = NULL, + feats_to_use = "hvf", + return_gobject = TRUE, + scale_unit = TRUE, + k = 20, + method = c("rcppml"), + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + toplevel = 1L, + ...) { checkmate::assert_class(gobject, "giotto") reduction <- match.arg(reduction, c("cells", "feats")) # Set feat_type and spat_unit @@ -2287,7 +2303,6 @@ runNMF <- function(gobject, ) if (return_gobject) { - if (reduction == "cells") { my_row_names <- rownames(expr_values) } else { @@ -2317,22 +2332,23 @@ runNMF <- function(gobject, ## update parameters used ## gobject <- update_giotto_params( - gobject, description = "_nmf", toplevel = toplevel + 1L + gobject, + description = "_nmf", toplevel = toplevel + 1L ) } else { return(nmf_res) } } -.run_nmf_rcppml <- function(x, - k = 50, - scale = TRUE, - rev = FALSE, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - ... -) { +.run_nmf_rcppml <- function( + x, + k = 50, + scale = TRUE, + rev = FALSE, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + ...) { package_check("RcppML", repository = "CRAN") .rcppml_cite() @@ -2381,13 +2397,15 @@ runNMF <- function(gobject, colnames(loadings) <- paste0("Dim.", seq_len(ncol(loadings))) colnames(coords) <- paste0("Dim.", seq_len(ncol(coords))) - result = list( + result <- list( coords = coords, loadings = loadings, d = d, iter = nmf_res$iter, tol = nmf_res$tol ) - vmsg(.is_debug = TRUE, - "finished .run_nmf_rcppml") + vmsg( + .is_debug = TRUE, + "finished .run_nmf_rcppml" + ) return(result) } @@ -2461,34 +2479,36 @@ runNMF <- function(gobject, #' #' runUMAP(g) #' @export -runUMAP <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - dim_reduction_to_use = "pca", - dim_reduction_name = NULL, - dimensions_to_use = 1:10, - name = NULL, - feats_to_use = NULL, - return_gobject = TRUE, - n_neighbors = 40, - n_components = 2, - n_epochs = 400, - min_dist = 0.01, - n_threads = NA, - spread = 5, - set_seed = TRUE, - seed_number = 1234L, - verbose = TRUE, - toplevel_params = deprecated(), - toplevel = 1L, - ...) { +runUMAP <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + dim_reduction_to_use = "pca", + dim_reduction_name = NULL, + dimensions_to_use = 1:10, + name = NULL, + feats_to_use = NULL, + return_gobject = TRUE, + n_neighbors = 40, + n_components = 2, + n_epochs = 400, + min_dist = 0.01, + n_threads = NA, + spread = 5, + set_seed = TRUE, + seed_number = 1234L, + verbose = TRUE, + toplevel_params = deprecated(), + toplevel = 1L, + ...) { # NSE vars cell_ID <- NULL toplevel <- deprecate_param( - toplevel_params, toplevel, fun = "runUMAP",when = "4.1.2" + toplevel_params, toplevel, + fun = "runUMAP", when = "4.1.2" ) # Set feat_type and spat_unit @@ -2632,7 +2652,6 @@ runUMAP <- function(gobject, if (return_gobject == TRUE) { - coordinates <- uwot_clus rownames(coordinates) <- rownames(matrix_to_use) @@ -2721,35 +2740,37 @@ runUMAP <- function(gobject, #' #' runUMAPprojection(g) #' @export -runUMAPprojection <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - dim_reduction_to_use = "pca", - dim_reduction_name = NULL, - dimensions_to_use = 1:10, - random_subset = 500, - name = NULL, - feats_to_use = NULL, - return_gobject = TRUE, - n_neighbors = 40, - n_components = 2, - n_epochs = 400, - min_dist = 0.01, - n_threads = NA, - spread = 5, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - toplevel_params = deprecated(), - toplevel = 1L, - ...) { +runUMAPprojection <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + dim_reduction_to_use = "pca", + dim_reduction_name = NULL, + dimensions_to_use = 1:10, + random_subset = 500, + name = NULL, + feats_to_use = NULL, + return_gobject = TRUE, + n_neighbors = 40, + n_components = 2, + n_epochs = 400, + min_dist = 0.01, + n_threads = NA, + spread = 5, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + toplevel_params = deprecated(), + toplevel = 1L, + ...) { # NSE vars cell_ID <- NULL toplevel <- deprecate_param( - toplevel_params, toplevel, fun = "runUMAPprojection", when = "4.1.2" + toplevel_params, toplevel, + fun = "runUMAPprojection", when = "4.1.2" ) # Set feat_type and spat_unit @@ -2902,7 +2923,6 @@ runUMAPprojection <- function(gobject, if (isTRUE(return_gobject)) { - coordinates <- coords_umap dimObject <- create_dim_obj( @@ -2983,27 +3003,27 @@ runUMAPprojection <- function(gobject, #' #' runtSNE(g) #' @export -runtSNE <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - reduction = c("cells", "feats"), - dim_reduction_to_use = "pca", - dim_reduction_name = NULL, - dimensions_to_use = 1:10, - name = NULL, - feats_to_use = NULL, - return_gobject = TRUE, - dims = 2, - perplexity = 30, - theta = 0.5, - do_PCA_first = FALSE, - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE, - toplevel = 1L, - ...) { - +runtSNE <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + reduction = c("cells", "feats"), + dim_reduction_to_use = "pca", + dim_reduction_name = NULL, + dimensions_to_use = 1:10, + name = NULL, + feats_to_use = NULL, + return_gobject = TRUE, + dims = 2, + perplexity = 30, + theta = 0.5, + do_PCA_first = FALSE, + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE, + toplevel = 1L, + ...) { package_check("Rtsne") # Set feat_type and spat_unit @@ -3124,7 +3144,6 @@ runtSNE <- function(gobject, if (isTRUE(return_gobject)) { - coordinates <- tsne_clus$Y rownames(coordinates) <- rownames(matrix_to_use) @@ -3145,7 +3164,8 @@ runtSNE <- function(gobject, ## update parameters used ## gobject <- update_giotto_params( - gobject, description = "_tsne", toplevel = toplevel + 1L + gobject, + description = "_tsne", toplevel = toplevel + 1L ) return(gobject) } else { @@ -3193,25 +3213,26 @@ runtSNE <- function(gobject, #' #' runGiottoHarmony(g, vars_use = "leiden_clus") #' @export -runGiottoHarmony <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - vars_use = "list_ID", - reduction = "cells", - dim_reduction_to_use = "pca", - dim_reduction_name = NULL, - dimensions_to_use = 1:10, - name = NULL, - set_seed = TRUE, - seed_number = 1234, - toplevel_params = deprecated(), - toplevel = 1L, - return_gobject = TRUE, - verbose = NULL, - ...) { - +runGiottoHarmony <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + vars_use = "list_ID", + reduction = "cells", + dim_reduction_to_use = "pca", + dim_reduction_name = NULL, + dimensions_to_use = 1:10, + name = NULL, + set_seed = TRUE, + seed_number = 1234, + toplevel_params = deprecated(), + toplevel = 1L, + return_gobject = TRUE, + verbose = NULL, + ...) { toplevel <- deprecate_param( - toplevel_params, toplevel, fun = "runGiottoHarmony", when = "4.1.2" + toplevel_params, toplevel, + fun = "runGiottoHarmony", when = "4.1.2" ) # verify if optional package is installed diff --git a/R/feature_set_enrichment.R b/R/feature_set_enrichment.R index 5bfa48277..b970c6219 100644 --- a/R/feature_set_enrichment.R +++ b/R/feature_set_enrichment.R @@ -49,26 +49,27 @@ #' please reference GSEA's documentation here: #' https://www.gsea-msigdb.org/gsea/doc/GSEAUserGuideTEXT.htm#_Syntax #' @export -doFeatureSetEnrichment <- function(dryrun = TRUE, - path_to_GSEA = NULL, - GSEA_dataset = NULL, - GSEA_ranked_file = NULL, - output_folder = NULL, - name_analysis_folder = "my_GSEA_analysis", - collapse = "false", - mode = c( - "Abs_max_of_probes", - "Max_probe", - "Median_of_probes", - "Mean_of_probes", - "Sum_of_probes" - ), - norm = "meandiv", - nperm = 1000, - scoring_scheme = "weighted", - plot_top_x = 20, - set_max = 500, - set_min = 15) { +doFeatureSetEnrichment <- function( + dryrun = TRUE, + path_to_GSEA = NULL, + GSEA_dataset = NULL, + GSEA_ranked_file = NULL, + output_folder = NULL, + name_analysis_folder = "my_GSEA_analysis", + collapse = "false", + mode = c( + "Abs_max_of_probes", + "Max_probe", + "Median_of_probes", + "Mean_of_probes", + "Sum_of_probes" + ), + norm = "meandiv", + nperm = 1000, + scoring_scheme = "weighted", + plot_top_x = 20, + set_max = 500, + set_min = 15) { # set don't run to false as a start dont_run <- FALSE diff --git a/R/filter.R b/R/filter.R index 1ca2e6177..88ac45fd0 100644 --- a/R/filter.R +++ b/R/filter.R @@ -43,25 +43,24 @@ #' #' filterDistributions(g) #' @export -filterDistributions <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("raw", "normalized", "scaled", "custom"), - method = c("threshold", "sum", "mean"), - expression_threshold = 1, - detection = c("feats", "cells"), - plot_type = c("histogram", "violin"), - scale_y = NULL, - nr_bins = 30, - fill_color = "lightblue", - scale_axis = "identity", - axis_offset = 0, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "filterDistributions") { +filterDistributions <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("raw", "normalized", "scaled", "custom"), + method = c("threshold", "sum", "mean"), + expression_threshold = 1, + detection = c("feats", "cells"), + plot_type = c("histogram", "violin"), + scale_y = NULL, + nr_bins = 30, + fill_color = "lightblue", + scale_axis = "identity", + axis_offset = 0, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "filterDistributions") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -240,23 +239,22 @@ filterDistributions <- function( #' #' filterCombinations(g) #' @export -filterCombinations <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("raw", "normalized", "scaled", "custom"), - expression_thresholds = c(1, 2), - feat_det_in_min_cells = c(5, 50), - min_det_feats_per_cell = c(200, 400), - scale_x_axis = "identity", - x_axis_offset = 0, - scale_y_axis = "identity", - y_axis_offset = 0, - show_plot = TRUE, - return_plot = FALSE, - save_plot = NULL, - save_param = list(), - default_save_name = "filterCombinations") { +filterCombinations <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("raw", "normalized", "scaled", "custom"), + expression_thresholds = c(1, 2), + feat_det_in_min_cells = c(5, 50), + min_det_feats_per_cell = c(200, 400), + scale_x_axis = "identity", + x_axis_offset = 0, + scale_y_axis = "identity", + y_axis_offset = 0, + show_plot = TRUE, + return_plot = FALSE, + save_plot = NULL, + save_param = list(), + default_save_name = "filterCombinations") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -440,24 +438,23 @@ filterCombinations <- function( #' #' filterGiotto(g) #' @export -filterGiotto <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("raw", "normalized", "scaled", "custom"), - expression_threshold = 1, - feat_det_in_min_cells = 100, - min_det_feats_per_cell = 100, - spat_unit_fsub = ":all:", - feat_type_ssub = ":all:", - all_spat_units = NULL, - all_feat_types = NULL, - poly_info = NULL, - tag_cells = FALSE, - tag_cell_name = "tag", - tag_feats = FALSE, - tag_feats_name = "tag", - verbose = TRUE) { +filterGiotto <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("raw", "normalized", "scaled", "custom"), + expression_threshold = 1, + feat_det_in_min_cells = 100, + min_det_feats_per_cell = 100, + spat_unit_fsub = ":all:", + feat_type_ssub = ":all:", + all_spat_units = NULL, + all_feat_types = NULL, + poly_info = NULL, + tag_cells = FALSE, + tag_cell_name = "tag", + tag_feats = FALSE, + tag_feats_name = "tag", + verbose = TRUE) { # data.table vars cell_ID <- feat_ID <- NULL diff --git a/R/general_help.R b/R/general_help.R index c993db7e0..2ce69e6d2 100644 --- a/R/general_help.R +++ b/R/general_help.R @@ -7,8 +7,9 @@ #' @description calculate gini coefficient #' @keywords internal #' @returns gini coefficient -mygini_fun <- function(x, - weights = rep(1, length(x))) { +mygini_fun <- function( + x, + weights = rep(1, length(x))) { # adapted from R package GiniWegNeg dataset <- cbind(x, weights) ord_x <- order(x) @@ -36,9 +37,10 @@ mygini_fun <- function(x, #' @description calculate gini coefficient on a minimum length vector #' @keywords internal #' @returns gini coefficient -extended_gini_fun <- function(x, - weights = rep(1, length = length(x)), - minimum_length = 16) { +extended_gini_fun <- function( + x, + weights = rep(1, length = length(x)), + minimum_length = 16) { if (length(x) < minimum_length) { difference <- minimum_length - length(x) min_value <- min(x) @@ -57,10 +59,11 @@ extended_gini_fun <- function(x, #' @description create binarized scores from a vector using kmeans #' @returns numeric #' @keywords internal -.kmeans_binarize <- function(x, - nstart = 3, - iter.max = 10, - seed = NULL) { +.kmeans_binarize <- function( + x, + nstart = 3, + iter.max = 10, + seed = NULL) { if (!is.null(seed)) { on.exit(random_seed(), add = TRUE) set.seed(seed) @@ -131,11 +134,12 @@ extended_gini_fun <- function(x, #' kmeans_arma #' @returns numeric #' @keywords internal -.kmeans_arma_subset_binarize <- function(x, - n_iter = 5, - extreme_nr = 20, - sample_nr = 200, - seed = NULL) { +.kmeans_arma_subset_binarize <- function( + x, + n_iter = 5, + extreme_nr = 20, + sample_nr = 200, + seed = NULL) { length_x <- length(x) vector_x <- sort(x) @@ -186,15 +190,14 @@ extended_gini_fun <- function(x, #' @description wrapper for different binarization functions #' @returns matrix #' @keywords internal -kmeans_binarize_wrapper <- function( - expr_values, - subset_feats = NULL, - kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), - nstart = 3, - iter_max = 10, - extreme_nr = 50, - sample_nr = 50, - seed = NULL) { +kmeans_binarize_wrapper <- function(expr_values, + subset_feats = NULL, + kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), + nstart = 3, + iter_max = 10, + extreme_nr = 50, + sample_nr = 50, + seed = NULL) { # expression values if (!is.null(subset_feats)) { expr_values <- expr_values[rownames(expr_values) %in% subset_feats, ] @@ -251,9 +254,10 @@ kmeans_binarize_wrapper <- function( #' @description wrapper for rank binarization function #' @returns matrix #' @keywords internal -rank_binarize_wrapper <- function(expr_values, - subset_feats = NULL, - percentage_rank = 30) { +rank_binarize_wrapper <- function( + expr_values, + subset_feats = NULL, + percentage_rank = 30) { # expression values if (!is.null(subset_feats)) { expr_values <- expr_values[rownames(expr_values) %in% subset_feats, ] @@ -272,30 +276,32 @@ rank_binarize_wrapper <- function(expr_values, #' @title writeChatGPTqueryDEG #' @name writeChatGPTqueryDEG -#' @description This function writes a query as a .txt file that can be used -#' with ChatGPT or a similar LLM service to find the most likely cell types -#' based on the top differential expressed genes (DEGs) between identified +#' @description This function writes a query as a .txt file that can be used +#' with ChatGPT or a similar LLM service to find the most likely cell types +#' based on the top differential expressed genes (DEGs) between identified #' clusters. -#' @param DEG_output the output format from the differential expression +#' @param DEG_output the output format from the differential expression #' functions #' @param top_n_genes number of genes for each cluster #' @param tissue_type tissue type #' @param folder_name path to the folder where you want to save the .txt file #' @param file_name name of .txt file #' @returns writes a .txt file to the desired location -#' @details This function does not run any LLM service. It simply creates the +#' @details This function does not run any LLM service. It simply creates the #' .txt file that can then be used any LLM service (e.g. OpenAI, Gemini, ...) #' @export -writeChatGPTqueryDEG <- function(DEG_output, - top_n_genes = 10, - tissue_type = "human breast cancer", - folder_name = getwd(), - file_name = "chatgpt_query.txt") { +writeChatGPTqueryDEG <- function( + DEG_output, + top_n_genes = 10, + tissue_type = "human breast cancer", + folder_name = getwd(), + file_name = "chatgpt_query.txt") { chatgpt_query <- paste0( - "Identify cell types of ", tissue_type, - " tissue using the following markers. Identify one cell type for each - row. Only provide the cell type name and the marker genes used for cell - type identification.") + "Identify cell types of ", tissue_type, + " tissue using the following markers. Identify one cell type for each + row. Only provide the cell type name and the marker genes used for cell + type identification." + ) selected_DEG_output <- DEG_output[, head(.SD, top_n_genes), by = "cluster"] @@ -332,8 +338,9 @@ writeChatGPTqueryDEG <- function(DEG_output, #' @returns expression matrix with gene symbols as rownames #' @details This function requires that the biomaRt library is installed #' @export -convertEnsemblToGeneSymbol <- function(matrix, - species = c("mouse", "human")) { +convertEnsemblToGeneSymbol <- function( + matrix, + species = c("mouse", "human")) { # data.table: set global variable dupes <- mgi_symbol <- gene_symbol <- ensembl_gene_id <- hgnc_symbol <- NULL @@ -446,17 +453,16 @@ convertEnsemblToGeneSymbol <- function(matrix, #' @name gpoly_from_dfr_smoothed_wrapped #' @returns giottoPolygon #' @keywords internal -gpoly_from_dfr_smoothed_wrapped <- function( - segmdfr, - name = "cell", - calc_centroids = FALSE, - smooth_polygons = FALSE, - vertices = 20L, - k = 3L, - set_neg_to_zero = TRUE, - skip_eval_dfr = FALSE, - copy_dt = TRUE, - verbose = TRUE) { +gpoly_from_dfr_smoothed_wrapped <- function(segmdfr, + name = "cell", + calc_centroids = FALSE, + smooth_polygons = FALSE, + vertices = 20L, + k = 3L, + set_neg_to_zero = TRUE, + skip_eval_dfr = FALSE, + copy_dt = TRUE, + verbose = TRUE) { gpoly <- createGiottoPolygonsFromDfr( segmdfr = segmdfr, name = name, @@ -516,10 +522,11 @@ gpoly_from_dfr_smoothed_wrapped <- function( #' annotations are provided (e.g. ensembl gene ids and gene symbols) the user #' can select another column. #' @export -get10Xmatrix <- function(path_to_data, - gene_column_index = 1, - remove_zero_rows = TRUE, - split_by_type = TRUE) { +get10Xmatrix <- function( + path_to_data, + gene_column_index = 1, + remove_zero_rows = TRUE, + split_by_type = TRUE) { # data.table variables total <- gene_symbol <- gene_id <- gene_id_num <- cell_id <- cell_id_num <- sort_gene_id_num <- NULL @@ -606,10 +613,11 @@ get10Xmatrix <- function(path_to_data, #' (e.g. expression vs QC probes) or modalities (e.g. RNA and protein), and #' \code{split_by_type} param is \code{TRUE}, multiple matrices will be returned #' @export -get10Xmatrix_h5 <- function(path_to_data, - gene_ids = c("symbols", "ensembl"), - remove_zero_rows = TRUE, - split_by_type = TRUE) { +get10Xmatrix_h5 <- function( + path_to_data, + gene_ids = c("symbols", "ensembl"), + remove_zero_rows = TRUE, + split_by_type = TRUE) { ## function inspired by and modified from the VISION package ## see read_10x_h5_v3 in ## https://github.com/YosefLab/VISION/blob/master/R/Utilities.R @@ -738,8 +746,8 @@ get10Xmatrix_h5 <- function(path_to_data, #' @md #' @returns 10xAffineImage #' @export -read10xAffineImage <- function(file, imagealignment_path, - name = "aligned_image", micron = 0.2125, ...) { +read10xAffineImage <- function(file, imagealignment_path, + name = "aligned_image", micron = 0.2125, ...) { checkmate::assert_file_exists(file) checkmate::assert_file_exists(imagealignment_path) if (!is.numeric(micron)) { @@ -794,18 +802,19 @@ read10xAffineImage <- function(file, imagealignment_path, #' @details Set H5Fopen_flags to "H5F_ACC_RDONLY" if you encounter permission #' issues. #' @export -readPolygonFilesVizgenHDF5_old <- function(boundaries_path, - fovs = NULL, - polygon_feat_types = 0:6, - custom_polygon_names = NULL, - flip_x_axis = FALSE, - flip_y_axis = FALSE, - smooth_polygons = TRUE, - smooth_vertices = 60, - set_neg_to_zero = FALSE, - H5Fopen_flags = "H5F_ACC_RDWR", - cores = NA, - verbose = TRUE) { +readPolygonFilesVizgenHDF5_old <- function( + boundaries_path, + fovs = NULL, + polygon_feat_types = 0:6, + custom_polygon_names = NULL, + flip_x_axis = FALSE, + flip_y_axis = FALSE, + smooth_polygons = TRUE, + smooth_vertices = 60, + set_neg_to_zero = FALSE, + H5Fopen_flags = "H5F_ACC_RDWR", + cores = NA, + verbose = TRUE) { # necessary pkgs package_check(pkg_name = "rhdf5", repository = "Bioc") @@ -1000,24 +1009,25 @@ readPolygonFilesVizgenHDF5_old <- function(boundaries_path, #' @details Set H5Fopen_flags to "H5F_ACC_RDONLY" if you encounter permission #' issues. #' @export -readPolygonFilesVizgenHDF5 <- function(boundaries_path, - fovs = NULL, - z_indices = 1L:7L, - segm_to_use = 1L, - custom_polygon_names = NULL, - flip_x_axis = FALSE, - flip_y_axis = TRUE, - calc_centroids = FALSE, - smooth_polygons = TRUE, - smooth_vertices = 60L, - set_neg_to_zero = FALSE, - H5Fopen_flags = "H5F_ACC_RDWR", - cores = determine_cores(), - create_gpoly_parallel = TRUE, - create_gpoly_bin = FALSE, - verbose = TRUE, - output = c("giottoPolygon", "data.table"), - polygon_feat_types = NULL) { +readPolygonFilesVizgenHDF5 <- function( + boundaries_path, + fovs = NULL, + z_indices = 1L:7L, + segm_to_use = 1L, + custom_polygon_names = NULL, + flip_x_axis = FALSE, + flip_y_axis = TRUE, + calc_centroids = FALSE, + smooth_polygons = TRUE, + smooth_vertices = 60L, + set_neg_to_zero = FALSE, + H5Fopen_flags = "H5F_ACC_RDWR", + cores = determine_cores(), + create_gpoly_parallel = TRUE, + create_gpoly_bin = FALSE, + verbose = TRUE, + output = c("giottoPolygon", "data.table"), + polygon_feat_types = NULL) { # necessary pkgs package_check(pkg_name = "rhdf5", repository = "Bioc") @@ -1145,15 +1155,16 @@ readPolygonFilesVizgenHDF5 <- function(boundaries_path, #' @keywords internal #' @noRd -.create_giotto_polygons_vizgen <- function(z_read_DT, - poly_names = names(z_read_DT), - set_neg_to_zero = FALSE, - calc_centroids = FALSE, - smooth_polygons = TRUE, - smooth_vertices = 60L, - create_gpoly_parallel = TRUE, - create_gpoly_bin = FALSE, - verbose = TRUE) { +.create_giotto_polygons_vizgen <- function( + z_read_DT, + poly_names = names(z_read_DT), + set_neg_to_zero = FALSE, + calc_centroids = FALSE, + smooth_polygons = TRUE, + smooth_vertices = 60L, + create_gpoly_parallel = TRUE, + create_gpoly_bin = FALSE, + verbose = TRUE) { checkmate::assert_list(z_read_DT) checkmate::assert_numeric(smooth_vertices) @@ -1190,7 +1201,7 @@ readPolygonFilesVizgenHDF5 <- function(boundaries_path, ) } if (isTRUE(calc_centroids)) { - # NOTE: won't recalculate if centroids are already + # NOTE: won't recalculate if centroids are already # attached cell_polygons <- centroids( cell_polygons, @@ -1353,11 +1364,10 @@ readPolygonFilesVizgenHDF5 <- function(boundaries_path, #' @param verbose be verbose #' @returns giottoPolygons #' @export -readPolygonVizgenParquet <- function( - file, - z_index = "all", - calc_centroids = TRUE, - verbose = TRUE) { +readPolygonVizgenParquet <- function(file, + z_index = "all", + calc_centroids = TRUE, + verbose = TRUE) { # package checks package_check("arrow") package_check("sf") @@ -1467,17 +1477,18 @@ readPolygonVizgenParquet <- function( #' @returns giotto object or cell polygons list #' @seealso \code{\link{smoothGiottoPolygons}} #' @export -readPolygonFilesVizgen <- function(gobject, - boundaries_path, - fovs = NULL, - polygon_feat_types = 0:6, - flip_x_axis = FALSE, - flip_y_axis = FALSE, - smooth_polygons = TRUE, - smooth_vertices = 60, - set_neg_to_zero = FALSE, - return_gobject = TRUE, - verbose = TRUE) { +readPolygonFilesVizgen <- function( + gobject, + boundaries_path, + fovs = NULL, + polygon_feat_types = 0:6, + flip_x_axis = FALSE, + flip_y_axis = FALSE, + smooth_polygons = TRUE, + smooth_vertices = 60, + set_neg_to_zero = FALSE, + return_gobject = TRUE, + verbose = TRUE) { # define names poly_feat_names <- paste0("z", polygon_feat_types) poly_feat_indexes <- paste0("zIndex_", polygon_feat_types) @@ -1522,10 +1533,11 @@ readPolygonFilesVizgen <- function(gobject, #' @describeIn readPolygonFilesVizgen (internal) Optimized .hdf5 reading for #' vizgen merscope output. Returns a data.table of xyz coords and cell_id #' @keywords internal -.h5_read_vizgen <- function(h5File, - z_indices = 1L:7L, - segm_to_use = "p_0", - H5Fopen_flags = "H5F_ACC_RDWR") { +.h5_read_vizgen <- function( + h5File, + z_indices = 1L:7L, + segm_to_use = "p_0", + H5Fopen_flags = "H5F_ACC_RDWR") { # data.table vars group <- name <- cell <- z_name <- otype <- d_name <- cell_id <- NULL @@ -1626,8 +1638,9 @@ readPolygonFilesVizgen <- function(gobject, #' @param bin_size bin size to select from .gef file #' @returns transcript with coordinates #' @export -getGEFtxCoords <- function(gef_file, - bin_size = "bin100") { +getGEFtxCoords <- function( + gef_file, + bin_size = "bin100") { # data.table vars genes <- NULL diff --git a/R/giotto_viewer.R b/R/giotto_viewer.R index ea8d84b41..4c3c2f20c 100644 --- a/R/giotto_viewer.R +++ b/R/giotto_viewer.R @@ -6,9 +6,10 @@ #' @param output_directory directory where to save the files #' @returns write a .txt and .annot file for the selection annotation #' @keywords internal -write_giotto_viewer_annotation <- function(annotation, - annot_name = "test", - output_directory = getwd()) { +write_giotto_viewer_annotation <- function( + annotation, + annot_name = "test", + output_directory = getwd()) { if (is.numeric(annotation) == TRUE) { # annotation information and mapping sorted_unique_numbers <- sort(unique(annotation)) @@ -27,7 +28,8 @@ write_giotto_viewer_annotation <- function(annotation, # annotation information and mapping annot_map <- data.table::data.table( - num = uniq_numerics, fac = uniq_factors) + num = uniq_numerics, fac = uniq_factors + ) annot_information <- uniq_factor_num_converter[annotation] } @@ -50,16 +52,17 @@ write_giotto_viewer_annotation <- function(annotation, #' @title write_giotto_viewer_numeric_annotation -#' @description write out numeric annotation data from a giotto object for the +#' @description write out numeric annotation data from a giotto object for the #' Viewer #' @param annotation annotation from the data.table from giotto object #' @param annot_name name of the annotation #' @param output_directory directory where to save the files #' @returns write a .txt and .annot file for the selection annotation #' @keywords internal -write_giotto_viewer_numeric_annotation <- function(annotation, - annot_name = "test", - output_directory = getwd()) { +write_giotto_viewer_numeric_annotation <- function( + annotation, + annot_name = "test", + output_directory = getwd()) { # write to output directory annot_inf_map <- paste0(annot_name, "_num_annot_information", ".txt") write.table(annotation, @@ -73,7 +76,7 @@ write_giotto_viewer_numeric_annotation <- function(annotation, #' @title write_giotto_viewer_dim_reduction -#' @description write out dimensional reduction data from a giotto object for +#' @description write out dimensional reduction data from a giotto object for #' the Viewer #' @param dim_reduction_cell dimension reduction slot from giotto object #' @param dim_red high level name of dimension reduction @@ -83,19 +86,22 @@ write_giotto_viewer_numeric_annotation <- function(annotation, #' @param output_directory directory where to save the files #' @returns write a .txt and .annot file for the selection annotation #' @keywords internal -write_giotto_viewer_dim_reduction <- function(dim_reduction_cell, - dim_red = NULL, - dim_red_name = NULL, - dim_red_rounding = NULL, - dim_red_rescale = c(-20, 20), - output_directory = getwd()) { +write_giotto_viewer_dim_reduction <- function( + dim_reduction_cell, + dim_red = NULL, + dim_red_name = NULL, + dim_red_rounding = NULL, + dim_red_rescale = c(-20, 20), + output_directory = getwd()) { dim_red_coord <- dim_reduction_cell[[dim_red]][[ dim_red_name ]]$coordinates[, seq_len(2)] if (is.null(dim_red_coord)) { - cat("\n combination of ", dim_red, " and ", dim_red_name, - " does not exist \n") + cat( + "\n combination of ", dim_red, " and ", dim_red_name, + " does not exist \n" + ) } else { # round dimension reduction coordinates if (!is.null(dim_red_rounding) & is.integer(dim_red_rounding)) { @@ -135,33 +141,34 @@ write_giotto_viewer_dim_reduction <- function(dim_reduction_cell, #' @param expression_values expression values to use in Viewer #' @param dim_red_rounding numerical indicating how to round the coordinates #' @param dim_red_rescale numericals to rescale the coordinates -#' @param expression_rounding numerical indicating how to round the expression +#' @param expression_rounding numerical indicating how to round the expression #' data #' @param overwrite_dir overwrite files in the directory if it already existed #' @param verbose be verbose #' @returns writes the necessary output to use in Giotto Viewer -#' @details Giotto Viewer expects the results from Giotto Analyzer in a -#' specific format, which is provided by this function. To include enrichment -#' results from {\code{\link{createSpatialEnrich}}} include the provided -#' spatial enrichment name (default PAGE or rank) and add the gene signature +#' @details Giotto Viewer expects the results from Giotto Analyzer in a +#' specific format, which is provided by this function. To include enrichment +#' results from {\code{\link{createSpatialEnrich}}} include the provided +#' spatial enrichment name (default PAGE or rank) and add the gene signature #' names (.e.g cell types) to the numeric annotations parameter. #' @export -exportGiottoViewer <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - output_directory = NULL, - spat_enr_names = NULL, - factor_annotations = NULL, - numeric_annotations = NULL, - dim_reductions, - dim_reduction_names, - expression_values = c("scaled", "normalized", "custom"), - dim_red_rounding = NULL, - dim_red_rescale = c(-20, 20), - expression_rounding = 2, - overwrite_dir = TRUE, - verbose = TRUE) { +exportGiottoViewer <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + output_directory = NULL, + spat_enr_names = NULL, + factor_annotations = NULL, + numeric_annotations = NULL, + dim_reductions, + dim_reduction_names, + expression_values = c("scaled", "normalized", "custom"), + dim_red_rounding = NULL, + dim_red_rescale = c(-20, 20), + expression_rounding = 2, + overwrite_dir = TRUE, + verbose = TRUE) { ## output directory ## if (file.exists(output_directory)) { if (overwrite_dir == TRUE) { @@ -252,11 +259,13 @@ exportGiottoViewer <- function(gobject, # factor annotations # if (!is.null(factor_annotations)) { found_factor_annotations <- factor_annotations[ - factor_annotations %in% colnames(cell_metadata)] + factor_annotations %in% colnames(cell_metadata) + ] for (sel_annot in found_factor_annotations) { - if (verbose == TRUE) + if (verbose == TRUE) { cat("\n write annotation data for: ", sel_annot, "\n") + } selected_annotation <- cell_metadata[[sel_annot]] write_giotto_viewer_annotation( @@ -272,7 +281,8 @@ exportGiottoViewer <- function(gobject, for (sel_annot_id in seq_along(found_factor_annotations)) { sel_annot_name <- found_factor_annotations[sel_annot_id] annot_inf_name <- paste0( - sel_annot_name, "_annot_information.txt") + sel_annot_name, "_annot_information.txt" + ) annot_names[[sel_annot_id]] <- sel_annot_name text_file_names[[sel_annot_id]] <- annot_inf_name @@ -295,10 +305,12 @@ exportGiottoViewer <- function(gobject, # numeric annotations # if (!is.null(numeric_annotations)) { found_numeric_annotations <- numeric_annotations[ - numeric_annotations %in% colnames(cell_metadata)] + numeric_annotations %in% colnames(cell_metadata) + ] for (sel_annot in found_numeric_annotations) { - if (verbose == TRUE) + if (verbose == TRUE) { cat("\n write annotation data for: ", sel_annot, "\n") + } selected_annotation <- cell_metadata[[sel_annot]] write_giotto_viewer_numeric_annotation( annotation = selected_annotation, @@ -315,7 +327,8 @@ exportGiottoViewer <- function(gobject, for (sel_annot_id in seq_along(found_numeric_annotations)) { sel_annot_name <- found_numeric_annotations[sel_annot_id] annot_inf_name <- paste0( - sel_annot_name, "_num_annot_information.txt") + sel_annot_name, "_num_annot_information.txt" + ) annot_names[[sel_annot_id]] <- sel_annot_name text_file_names[[sel_annot_id]] <- annot_inf_name @@ -350,9 +363,12 @@ exportGiottoViewer <- function(gobject, temp_dim_red <- dim_reductions[i] temp_dim_red_name <- dim_reduction_names[i] - if (verbose == TRUE) - cat("write annotation data for: ", temp_dim_red, " for ", - temp_dim_red_name, "\n") + if (verbose == TRUE) { + cat( + "write annotation data for: ", temp_dim_red, " for ", + temp_dim_red_name, "\n" + ) + } write_giotto_viewer_dim_reduction( dim_reduction_cell = dim_reduction_cell, @@ -371,8 +387,9 @@ exportGiottoViewer <- function(gobject, # expression values to be used if (verbose == TRUE) cat("\n write expression values \n") values <- match.arg( - expression_values, - unique(c("scaled", "normalized", "custom", expression_values))) + expression_values, + unique(c("scaled", "normalized", "custom", expression_values)) + ) for (feat in feat_type) { expr_values <- getExpression( diff --git a/R/gstop.R b/R/gstop.R index be2a805e1..d83ad98d8 100644 --- a/R/gstop.R +++ b/R/gstop.R @@ -2,14 +2,15 @@ # .n should be increased when called from a nested location if capturing the # original call is desired. # .n should be increased to 2L when within a generic method -.gstop <- function(..., - sep = " ", - strWidth = 100, - errWidth = FALSE, - .prefix = " ", - .initial = "", - .n = 1L, - .call = FALSE) { +.gstop <- function( + ..., + sep = " ", + strWidth = 100, + errWidth = FALSE, + .prefix = " ", + .initial = "", + .n = 1L, + .call = FALSE) { GiottoUtils::gstop( ..., sep = sep, diff --git a/R/image_registration.R b/R/image_registration.R index 0cc485233..fbca01844 100644 --- a/R/image_registration.R +++ b/R/image_registration.R @@ -88,9 +88,10 @@ #' @returns spatlocs #' @keywords internal # Rotation is performed first, followed by XY transform. -.rigid_transform_spatial_locations <- function(spatlocs, - transform_values, - method) { +.rigid_transform_spatial_locations <- function( + spatlocs, + transform_values, + method) { if (method == "fiji") { spatlocsXY <- spatlocs[, c("sdimx", "sdimy")] # These functions must be performed in positive y values @@ -138,12 +139,13 @@ #' @returns list #' @keywords internal # Automatically account for changes in image size due to alignment -.reg_img_minmax_finder <- function(gobject_list, - image_unreg = NULL, - largeImage_unreg = NULL, # TODO Currently unused - scale_factor, - transform_values, - method) { +.reg_img_minmax_finder <- function( + gobject_list, + image_unreg = NULL, + largeImage_unreg = NULL, # TODO Currently unused + scale_factor, + transform_values, + method) { # Find image spatial info from original image if possible # Check to make sure that image_unreg finds an existing image in each # gobject to be registered @@ -285,21 +287,22 @@ #' @returns List of registered giotto objects where the registered images and #' spatial locations #' @export -registerGiottoObjectList <- function(gobject_list, - spat_unit = NULL, - method = c("fiji", "rvision"), - image_unreg = "image", - image_reg_name = "image", - image_list = NULL, # Rvision - save_dir = NULL, # Rvision - spatloc_unreg = "raw", - spatloc_reg_name = "raw", - fiji_xml_files, - fiji_registered_images, - scale_factor = NULL, - allow_rvision_autoscale = TRUE, # Rvision - # auto_comp_reg_border = TRUE, - verbose = TRUE) { +registerGiottoObjectList <- function( + gobject_list, + spat_unit = NULL, + method = c("fiji", "rvision"), + image_unreg = "image", + image_reg_name = "image", + image_list = NULL, # Rvision + save_dir = NULL, # Rvision + spatloc_unreg = "raw", + spatloc_reg_name = "raw", + fiji_xml_files, + fiji_registered_images, + scale_factor = NULL, + allow_rvision_autoscale = TRUE, # Rvision + # auto_comp_reg_border = TRUE, + verbose = TRUE) { method <- match.arg(method, choices = c("fiji", "rvision")) if (method == "fiji") { @@ -360,18 +363,19 @@ registerGiottoObjectList <- function(gobject_list, #' @returns list of registered giotto objects where the registered images and #' spatial locations #' @export -registerGiottoObjectListFiji <- function(gobject_list, - spat_unit = NULL, - image_unreg = "image", - image_reg_name = "image", - image_replace_name = "unregistered", - registered_images = NULL, - spatloc_unreg = "raw", - spatloc_reg_name = "raw", - spatloc_replace_name = "unregistered", - xml_files, - scale_factor = NULL, - verbose = TRUE) { +registerGiottoObjectListFiji <- function( + gobject_list, + spat_unit = NULL, + image_unreg = "image", + image_reg_name = "image", + image_replace_name = "unregistered", + registered_images = NULL, + spatloc_unreg = "raw", + spatloc_reg_name = "raw", + spatloc_replace_name = "unregistered", + xml_files, + scale_factor = NULL, + verbose = TRUE) { # set spat_unit based on first gobject spat_unit <- set_default_spat_unit( gobject = gobject_list[[1]], @@ -615,12 +619,13 @@ registerGiottoObjectListFiji <- function(gobject_list, #' spatial locations #' @export # Register giotto objects when given raw images and spatial locations -registerGiottoObjectListRvision <- function(gobject_list = gobject_list, - image_list = NULL, - save_dir = NULL, - spatloc_unreg = NULL, - spatloc_reg_name = "raw", - verbose = TRUE) { # Not used +registerGiottoObjectListRvision <- function( + gobject_list = gobject_list, + image_list = NULL, + save_dir = NULL, + spatloc_unreg = NULL, + spatloc_reg_name = "raw", + verbose = TRUE) { # Not used package_check( pkg_name = "Rvision", @@ -880,35 +885,36 @@ fiji <- function(fijiPath = NULL) { #' jimpipeline by jefferislab #' #' @export -registerImagesFIJI <- function(source_img_dir, - output_img_dir, - transforms_save_dir, - ref_img_name, - # Scale Invariant Interest Point Detector Options - init_gauss_blur = 1.6, - steps_per_scale_octave = 3, - min_img_size = 64, - max_img_size = 1024, - # Feature Descriptor Options - feat_desc_size = 8, - feat_desc_orient_bins = 8, - closest_next_closest_ratio = 0.92, - # Geometric Consensus Filter Options - max_align_err = 25, - inlier_ratio = 0.05, - # FIJI Options - headless = FALSE, - batch = TRUE, - MinMem = MaxMem, - MaxMem = 2500, - IncrementalGC = TRUE, - Threads = NULL, - fijiArgs = NULL, - javaArgs = NULL, - ijArgs = NULL, - jython = FALSE, - fijiPath = fiji(), - DryRun = FALSE) { +registerImagesFIJI <- function( + source_img_dir, + output_img_dir, + transforms_save_dir, + ref_img_name, + # Scale Invariant Interest Point Detector Options + init_gauss_blur = 1.6, + steps_per_scale_octave = 3, + min_img_size = 64, + max_img_size = 1024, + # Feature Descriptor Options + feat_desc_size = 8, + feat_desc_orient_bins = 8, + closest_next_closest_ratio = 0.92, + # Geometric Consensus Filter Options + max_align_err = 25, + inlier_ratio = 0.05, + # FIJI Options + headless = FALSE, + batch = TRUE, + MinMem = MaxMem, + MaxMem = 2500, + IncrementalGC = TRUE, + Threads = NULL, + fijiArgs = NULL, + javaArgs = NULL, + ijArgs = NULL, + jython = FALSE, + fijiPath = fiji(), + DryRun = FALSE) { # Check if output directory exists. If not, create the directory if (!file.exists(output_img_dir)) { dir.create(output_img_dir) @@ -1017,11 +1023,11 @@ registerImagesFIJI <- function(source_img_dir, #' @title title Record landmarks by interactive selection #' @name interactiveLandmarkSelection #' @description Record landmarks by interactive selection -#' @param source_image the image to be plotted on the left, and landmarks will -#' output in the first of the list. Input can be a ggplot object, +#' @param source_image the image to be plotted on the left, and landmarks will +#' output in the first of the list. Input can be a ggplot object, #' a GiottoImage, or a character represent a path to a image -#' @param target_image the image to be plotted on the right, and landmarks will -#' output in the second of the list. Input can be a ggplot object, a +#' @param target_image the image to be plotted on the right, and landmarks will +#' output in the second of the list. Input can be a ggplot object, a #' GiottoImage, or a character represent a path to a image #' #' @returns a list of landmarks @@ -1066,36 +1072,42 @@ interactiveLandmarkSelection <- function(source, target) { miniUI::miniContentPanel( shiny::fluidRow( shiny::column( - 6, shiny::plotOutput("plot1", click = "plot1_click")), + 6, shiny::plotOutput("plot1", click = "plot1_click") + ), shiny::column( - 6, shiny::plotOutput("plot2", click = "plot2_click")) + 6, shiny::plotOutput("plot2", click = "plot2_click") + ) ), shiny::fluidRow( shiny::column( 6, shiny::sliderInput( - "xrange1", "X Range for Plot 1", - min = source_ranges$x_range[1], - max = source_ranges$x_range[2], - value = source_ranges$x_range), + "xrange1", "X Range for Plot 1", + min = source_ranges$x_range[1], + max = source_ranges$x_range[2], + value = source_ranges$x_range + ), shiny::sliderInput( - "yrange1", "Y Range for Plot 1", - min = source_ranges$y_range[1], - max = source_ranges$y_range[2], - value = source_ranges$y_range) + "yrange1", "Y Range for Plot 1", + min = source_ranges$y_range[1], + max = source_ranges$y_range[2], + value = source_ranges$y_range + ) ), shiny::column( 6, shiny::sliderInput( - "xrange2", "X Range for Plot 2", - min = target_ranges$x_range[1], - max = target_ranges$x_range[2], - value = target_ranges$x_range), + "xrange2", "X Range for Plot 2", + min = target_ranges$x_range[1], + max = target_ranges$x_range[2], + value = target_ranges$x_range + ), shiny::sliderInput( - "yrange2", "Y Range for Plot 2", - min = target_ranges$y_range[1], - max = target_ranges$y_range[2], - value = target_ranges$y_range) + "yrange2", "Y Range for Plot 2", + min = target_ranges$y_range[1], + max = target_ranges$y_range[2], + value = target_ranges$y_range + ) ) ), shiny::fluidRow( @@ -1104,55 +1116,69 @@ interactiveLandmarkSelection <- function(source, target) { ), shiny::fluidRow( shiny::column(6, shiny::actionButton( - "undo1", "Undo Click on Source Image")), + "undo1", "Undo Click on Source Image" + )), shiny::column(6, shiny::actionButton( - "undo2", "Undo Click on Target Image")) + "undo2", "Undo Click on Target Image" + )) ) ) ) server <- function(input, output, session) { - click_history1 <- shiny::reactiveVal(data.frame(x = numeric(), - y = numeric())) - click_history2 <- shiny::reactiveVal(data.frame(x = numeric(), - y = numeric())) + click_history1 <- shiny::reactiveVal(data.frame( + x = numeric(), + y = numeric() + )) + click_history2 <- shiny::reactiveVal(data.frame( + x = numeric(), + y = numeric() + )) output$plot1 <- shiny::renderPlot({ source_image + ggplot2::coord_cartesian( - xlim = input$xrange1, ylim = input$yrange1) + + xlim = input$xrange1, ylim = input$yrange1 + ) + ggplot2::geom_point( - data = click_history1(), ggplot2::aes(x = x, y = y), - color = "red", size = 4.5) + data = click_history1(), ggplot2::aes(x = x, y = y), + color = "red", size = 4.5 + ) }) output$plot2 <- shiny::renderPlot({ target_image + ggplot2::coord_cartesian( - xlim = input$xrange2, ylim = input$yrange2) + + xlim = input$xrange2, ylim = input$yrange2 + ) + ggplot2::geom_point( - data = click_history2(), ggplot2::aes(x = x, y = y), - color = "blue", size = 4.5) + data = click_history2(), ggplot2::aes(x = x, y = y), + color = "blue", size = 4.5 + ) }) shiny::observeEvent(input$plot1_click, { click <- input$plot1_click new_coords <- rbind( - click_history1(), data.frame(x = click$x, y = click$y)) + click_history1(), data.frame(x = click$x, y = click$y) + ) click_history1(new_coords) }) shiny::observeEvent(input$plot2_click, { click <- input$plot2_click new_coords <- rbind( - click_history2(), data.frame(x = click$x, y = click$y)) + click_history2(), data.frame(x = click$x, y = click$y) + ) click_history2(new_coords) }) shiny::observeEvent(input$undo1, { if (nrow(click_history1()) > 0) { new_coords <- click_history1()[ - -nrow(click_history1()), , drop = FALSE] + -nrow(click_history1()), , + drop = FALSE + ] click_history1(new_coords) } }) @@ -1160,7 +1186,9 @@ interactiveLandmarkSelection <- function(source, target) { shiny::observeEvent(input$undo2, { if (nrow(click_history2()) > 0) { new_coords <- click_history2()[ - -nrow(click_history2()), , drop = FALSE] + -nrow(click_history2()), , + drop = FALSE + ] click_history2(new_coords) } }) @@ -1189,11 +1217,11 @@ interactiveLandmarkSelection <- function(source, target) { #' @title Calculate a affine transformation matrix from two set of landmarks #' @name calculateAffineMatrixFromLandmarks -#' @description calculate a affine transformation matrix from two set of +#' @description calculate a affine transformation matrix from two set of #' landmarks -#' @param source_df source landmarks, two columns, first column represent +#' @param source_df source landmarks, two columns, first column represent #' x coordinate and second column represent y coordinate. -#' @param target_df target landmarks, two columns, first column represent +#' @param target_df target landmarks, two columns, first column represent #' x coordinate and second column represent y coordinate. #' #' @returns a 3 by 3 matrix with the third row close to (0,0,1) @@ -1202,11 +1230,13 @@ interactiveLandmarkSelection <- function(source, target) { calculateAffineMatrixFromLandmarks <- function(source_df, target_df) { source_landmarks_matrix <- as.matrix(source_df) source_landmarks_matrix <- cbind( - source_landmarks_matrix, rep(1, nrow(source_landmarks_matrix))) + source_landmarks_matrix, rep(1, nrow(source_landmarks_matrix)) + ) ## Create landmark matrix for the target image target_landmarks_matrix <- as.matrix(target_df) target_landmarks_matrix <- cbind( - target_landmarks_matrix, rep(1, nrow(target_landmarks_matrix))) + target_landmarks_matrix, rep(1, nrow(target_landmarks_matrix)) + ) ## Compute the affine matrix source_dp <- t(source_landmarks_matrix) %*% source_landmarks_matrix source_target_dp <- t(source_landmarks_matrix) %*% target_landmarks_matrix @@ -1221,9 +1251,9 @@ calculateAffineMatrixFromLandmarks <- function(source_df, target_df) { #' @name .sift_detect #' @title Run SIFT feature detector and descriptor extractor #' @description -#' Perform feature detector and descriptor extractor on a matrix object or +#' Perform feature detector and descriptor extractor on a matrix object or #' preprocessed image object -#' @param x input matrix or preprocessed image to extract feature and +#' @param x input matrix or preprocessed image to extract feature and #' descriptor from #' @param ... additional params to pass to `skimage.feature.SIFT()` #' @returns list of keypoints and descriptors @@ -1267,12 +1297,13 @@ calculateAffineMatrixFromLandmarks <- function(source_df, target_df) { #' @param ... additional params to pass to `skimage.feature.match_descriptors()` #' @returns list #' -.match_descriptor <- function(descriptor_list, - target_idx = 1L, - cross_check = TRUE, - max_ratio = 0.8, - ..., - pkg_ptr) { +.match_descriptor <- function( + descriptor_list, + target_idx = 1L, + cross_check = TRUE, + max_ratio = 0.8, + ..., + pkg_ptr) { checkmate::assert_list(descriptor_list, min.len = 2L) target_idx <- as.integer(target_idx) @@ -1339,36 +1370,37 @@ calculateAffineMatrixFromLandmarks <- function(source_df, target_df) { #' @name preprocessImageToMatrix -#' @title Preprocess from image directory to the required matrix format for +#' @title Preprocess from image directory to the required matrix format for #' Image registration pipeline built on scikit-image #' @description -#' Preprocess a image path to the required matrix format for Image +#' Preprocess a image path to the required matrix format for Image #' registration pipeline built on scikit-image #' @param x input file path, required -#' @param invert whether or not to invert intensity to make calculation of +#' @param invert whether or not to invert intensity to make calculation of #' descriptors more accurate, default FALSE -#' @param equalize_histogram whether or not to calculate equalized histogram of +#' @param equalize_histogram whether or not to calculate equalized histogram of #' the image,default TRUE #' @param flip_vertical whether or not to flip vertical, default FALSE #' @param flip_horizontal whether or not to flip horizontal, default FALSE -#' @param rotate_90 whether or not to rotates the image 90 degrees +#' @param rotate_90 whether or not to rotates the image 90 degrees #' counter-clockwise, default FALSE -#' @param use_single_channel If input is a multichannel image, whether or not +#' @param use_single_channel If input is a multichannel image, whether or not #' to extract single channel, default FALSE -#' @param single_channel_number Channel number in the multichannel image, +#' @param single_channel_number Channel number in the multichannel image, #' required if use_single_channel = TRUE #' @returns a matrix array to input to .sift_detect #' #' @export -preprocessImageToMatrix <- function(x, - invert = FALSE, - equalize_histogram = TRUE, - flip_vertical = FALSE, - flip_horizontal = FALSE, - rotate_90 = FALSE, - use_single_channel = FALSE, - single_channel_number = NULL, - pkg_ptr) { +preprocessImageToMatrix <- function( + x, + invert = FALSE, + equalize_histogram = TRUE, + flip_vertical = FALSE, + flip_horizontal = FALSE, + rotate_90 = FALSE, + use_single_channel = FALSE, + single_channel_number = NULL, + pkg_ptr) { if (missing(pkg_ptr)) { GiottoUtils::package_check("skimage", repository = "pip:scikit-image") SKI <- reticulate::import("skimage", convert = TRUE, delay_load = TRUE) @@ -1385,7 +1417,7 @@ preprocessImageToMatrix <- function(x, } if (use_single_channel == TRUE) { if (is.null(single_channel_number)) { - stop("Set use single channel == TRUE, please provide a channel + stop("Set use single channel == TRUE, please provide a channel number to continue") } image <- image[, , single_channel_number] @@ -1417,15 +1449,16 @@ preprocessImageToMatrix <- function(x, #' Estimate affine transformation from matched descriptor #' @param keypoints1 keypoints extracted from source image via .sift_detect #' @param keypoints1 keypoints extracted from target image via .sift_detect -#' @param match a 2 col matrix of x to y index matched descriptors via +#' @param match a 2 col matrix of x to y index matched descriptors via #' .match_descriptor_single #' @returns a list of model and inliners -.estimate_transform_from_matched_descriptor <- function(keypoints1, - keypoints2, - match, - estimate_fun, - ..., - pkg_ptr) { +.estimate_transform_from_matched_descriptor <- function( + keypoints1, + keypoints2, + match, + estimate_fun, + ..., + pkg_ptr) { if (missing(pkg_ptr)) { GiottoUtils::package_check("skimage", repository = "pip:scikit-image") SKI <- reticulate::import("skimage", convert = TRUE, delay_load = TRUE) @@ -1438,9 +1471,12 @@ preprocessImageToMatrix <- function(x, dst_pts <- keypoints2[match[, 2] + 1, , drop = FALSE] estimate_fun <- match.arg( - estimate_fun, - unique(c("euclidean", "similarity", "affine", "piecewise-affine", - "projective", "polynomial", estimate_fun))) + estimate_fun, + unique(c( + "euclidean", "similarity", "affine", "piecewise-affine", + "projective", "polynomial", estimate_fun + )) + ) # Estimate homography matrix ransac_result <- SKI$transform$estimate_transform( @@ -1459,14 +1495,15 @@ preprocessImageToMatrix <- function(x, #' Warp transformed images from estimated transformation #' @param x source image from .sift_preprocess #' @param y target image from .sift_preprocess -#' @param model estimated transformation object from +#' @param model estimated transformation object from #' .estimate_transform_from_matched_descriptor #' @returns None, it will write to a output path -.warp_transformed_image <- function(x, - y, - model, - outpath = NULL, - pkg_ptr) { +.warp_transformed_image <- function( + x, + y, + model, + outpath = NULL, + pkg_ptr) { if (missing(pkg_ptr)) { GiottoUtils::package_check("skimage", repository = "pip:scikit-image") SKI <- reticulate::import("skimage", convert = TRUE, delay_load = TRUE) @@ -1487,17 +1524,16 @@ preprocessImageToMatrix <- function(x, #' @name .plot_matched_descriptors #' @title plot matched descriptors #' @description -#' A wrapper function for the plot_matches for the SIFT feature extractor and +#' A wrapper function for the plot_matches for the SIFT feature extractor and #' descriptor pipeline #' @param x source image from .sift_preprocess #' @param y target image from .sift_preprocess #' @param keypoints1 keypoints extracted from source image via .sift_detect #' @param keypoints1 keypoints extracted from target image via .sift_detect -#' @param match a 2 col matrix of x to y index matched descriptors via +#' @param match a 2 col matrix of x to y index matched descriptors via #' .match_descriptor_single #' @returns None -.plot_matched_descriptors <- function( - x, y, keypoints1, keypoints2, match, pkg_ptr) { +.plot_matched_descriptors <- function(x, y, keypoints1, keypoints2, match, pkg_ptr) { if (missing(pkg_ptr)) { GiottoUtils::package_check("skimage", repository = "pip:scikit-image") SKI <- reticulate::import("skimage", convert = TRUE, delay_load = TRUE) @@ -1506,7 +1542,9 @@ preprocessImageToMatrix <- function(x, } matplotlib <- reticulate::import( - "matplotlib", convert = TRUE, delay_load = TRUE) + "matplotlib", + convert = TRUE, delay_load = TRUE + ) np <- reticulate::import("numpy", convert = TRUE, delay_load = TRUE) plt <- matplotlib$pyplot @@ -1520,7 +1558,9 @@ preprocessImageToMatrix <- function(x, # Plot the matches SKI$feature$plot_matches( - ax, x, y, keypoints1, keypoints2, match_py, only_matches = TRUE) + ax, x, y, keypoints1, keypoints2, match_py, + only_matches = TRUE + ) ax$axis("off") plt$show() @@ -1531,50 +1571,60 @@ preprocessImageToMatrix <- function(x, #' @title Estimate Automated ImageRegistration With SIFT #' @name estimateAutomatedImageRegistrationWithSIFT #' @description -#' Automatically estimate a transform with SIFT feature detection, descriptor +#' Automatically estimate a transform with SIFT feature detection, descriptor #' match and returns a transformation object to use -#' @param x required. Source matrix input, could be generated from +#' @param x required. Source matrix input, could be generated from #' preprocessImageToMatrix -#' @param y required. Source matrix input, could be generated from +#' @param y required. Source matrix input, could be generated from #' preprocessImageToMatrix #' @param max_ratio max_ratio parameter for matching descriptors, default 0.6 -#' @param save_warp default NULL, if not NULL, please provide an output image +#' @param save_warp default NULL, if not NULL, please provide an output image #' path to save the warpped image. -#' @param estimate_fun default Affine. The transformation model to use +#' @param estimate_fun default Affine. The transformation model to use #' estimation #' @param plot_match whether or not to plot the matching descriptors. #' Default False #' @returns a list of the estimated transformation object #' @examples #' estimation <- estimateAutomatedImageRegistrationWithSIFT( -#' x = image_mtx1, y = image_mtx2) +#' x = image_mtx1, y = image_mtx2 +#' ) #' @export -estimateAutomatedImageRegistrationWithSIFT <- function(x, - y, - plot_match = FALSE, - max_ratio = 0.6, - estimate_fun = "affine", - save_warp = NULL, - verbose = TRUE) { - GiottoUtils::vmsg(.v = verbose, .is_debug = TRUE, - "Detecting features via SIFT... ") +estimateAutomatedImageRegistrationWithSIFT <- function( + x, + y, + plot_match = FALSE, + max_ratio = 0.6, + estimate_fun = "affine", + save_warp = NULL, + verbose = TRUE) { + GiottoUtils::vmsg( + .v = verbose, .is_debug = TRUE, + "Detecting features via SIFT... " + ) x_sift <- .sift_detect(x) y_sift <- .sift_detect(y) - GiottoUtils::vmsg(.v = verbose, .is_debug = TRUE, - "Matching Descriptors via SIFT... ") + GiottoUtils::vmsg( + .v = verbose, .is_debug = TRUE, + "Matching Descriptors via SIFT... " + ) matched <- .match_descriptor_single( - x_sift$descriptor, y_sift$descriptor, max_ratio = max_ratio) + x_sift$descriptor, y_sift$descriptor, + max_ratio = max_ratio + ) if (plot_match == TRUE) { .plot_matched_descriptors( - x, y, x_sift$keypoints, y_sift$keypoints, matched) + x, y, x_sift$keypoints, y_sift$keypoints, matched + ) } GiottoUtils::vmsg( - .v = verbose, .is_debug = TRUE, - "Estimating transformation matrix from matched descriptor... ") + .v = verbose, .is_debug = TRUE, + "Estimating transformation matrix from matched descriptor... " + ) estimation <- .estimate_transform_from_matched_descriptor(x_sift$keypoints, y_sift$keypoints, matched, diff --git a/R/interactivity.R b/R/interactivity.R index b73cc1878..a4e26c767 100644 --- a/R/interactivity.R +++ b/R/interactivity.R @@ -11,10 +11,11 @@ #' @returns A `data.table` containing x,y coordinates from the plotted polygons. #' #' @export -plotInteractivePolygons <- function(x, - width = "auto", - height = "auto", - ...) { +plotInteractivePolygons <- function( + x, + width = "auto", + height = "auto", + ...) { package_check(pkg_name = "miniUI", repository = "CRAN") package_check(pkg_name = "shiny", repository = "CRAN") @@ -178,11 +179,12 @@ plotInteractivePolygons <- function(x, #' getCellsFromPolygon(g) #' #' @export -getCellsFromPolygon <- function(gobject, - polygon_name = "selections", - spat_unit = "cell", - spat_loc_name = "raw", - polygons = NULL) { +getCellsFromPolygon <- function( + gobject, + polygon_name = "selections", + spat_unit = "cell", + spat_loc_name = "raw", + polygons = NULL) { if (!inherits(gobject, "giotto")) { stop("gobject needs to be a giotto object") } @@ -261,13 +263,14 @@ getCellsFromPolygon <- function(gobject, #' g <- addPolygonCells(g) #' pDataDT(g) #' @export -addPolygonCells <- function(gobject, - polygon_name = "selections", - spat_unit = "cell", - spat_loc_name = "raw", - feat_type = "rna", - polygons = NULL, - na.label = "no_polygon") { +addPolygonCells <- function( + gobject, + polygon_name = "selections", + spat_unit = "cell", + spat_loc_name = "raw", + feat_type = "rna", + polygons = NULL, + na.label = "no_polygon") { ## verify gobject if (!inherits(gobject, "giotto")) { stop("gobject needs to be a giotto object") @@ -362,14 +365,15 @@ addPolygonCells <- function(gobject, #' #' comparePolygonExpression(g) #' @export -comparePolygonExpression <- function(gobject, - polygon_name = "selections", - spat_unit = "cell", - feat_type = "rna", - selected_feats = "top_genes", - expression_values = "normalized", - method = "scran", - ...) { +comparePolygonExpression <- function( + gobject, + polygon_name = "selections", + spat_unit = "cell", + feat_type = "rna", + selected_feats = "top_genes", + expression_values = "normalized", + method = "scran", + ...) { # verify gobject if (!inherits(gobject, "giotto")) { stop("gobject needs to be a giotto object") @@ -483,12 +487,13 @@ comparePolygonExpression <- function(gobject, #' #' compareCellAbundance(g) #' @export -compareCellAbundance <- function(gobject, - polygon_name = "selections", - spat_unit = "cell", - feat_type = "rna", - cell_type_column = "leiden_clus", - ...) { +compareCellAbundance <- function( + gobject, + polygon_name = "selections", + spat_unit = "cell", + feat_type = "rna", + cell_type_column = "leiden_clus", + ...) { # verify gobject if (!inherits(gobject, "giotto")) { stop("gobject needs to be a giotto object") @@ -564,12 +569,13 @@ compareCellAbundance <- function(gobject, #' #' plotPolygons(g, x = x) #' @export -plotPolygons <- function(gobject, - polygon_name = "selections", - x, - spat_unit = "cell", - polygons = NULL, - ...) { +plotPolygons <- function( + gobject, + polygon_name = "selections", + x, + spat_unit = "cell", + polygons = NULL, + ...) { ## verify gobject if (!inherits(gobject, "giotto")) { stop("gobject must be a Giotto object") @@ -638,10 +644,11 @@ plotPolygons <- function(gobject, #' @returns data.table with selected cell_IDs, spatial coordinates, and #' cluster_ID. #' @export -plotInteractive3D <- function(gobject, spat_unit = "cell", feat_type = "rna", - cell_color = "leiden_clus", - cell_color_code = NULL, point_size = 0.5, - width = "100%", height = "400px") { +plotInteractive3D <- function( + gobject, spat_unit = "cell", feat_type = "rna", + cell_color = "leiden_clus", + cell_color_code = NULL, point_size = 0.5, + width = "100%", height = "400px") { package_check( c("plotly", "miniUI", "shiny"), repository = c("CRAN:plotly", "CRAN:miniUI", "CRAN:shiny") @@ -752,7 +759,7 @@ plotInteractive3D <- function(gobject, spat_unit = "cell", feat_type = "rna", #' @param gobject giotto object #' @param spat_unit spatial unit (e.g. "cell") #' @param feat_type feature type (e.g. "rna", "dna", "protein") -#' @param expression expression values to extract (e.g. "raw", "normalized", +#' @param expression expression values to extract (e.g. "raw", "normalized", #' "scaled") #' @param output_path path to create and save the anndata zarr folder #' @@ -776,9 +783,10 @@ plotInteractive3D <- function(gobject, spat_unit = "cell", feat_type = "rna", #' expression = "scaled", #' output_path = tempdir() #' ) -giottoToAnndataZarr <- function(gobject, spat_unit = NULL, - feat_type = NULL, expression = "raw", - output_path) { +giottoToAnndataZarr <- function( + gobject, spat_unit = NULL, + feat_type = NULL, expression = "raw", + output_path) { proc <- basilisk::basiliskStart(GiottoClass::instructions( gobject = gobject, param = "python_path" @@ -787,9 +795,10 @@ giottoToAnndataZarr <- function(gobject, spat_unit = NULL, success <- basilisk::basiliskRun( proc, - function(gobject, - output_path, - expression) { + function( + gobject, + output_path, + expression) { anndata <- reticulate::import("anndata") zarr <- reticulate::import("zarr") diff --git a/R/kriging.R b/R/kriging.R index f8d760af6..0e6faf6cf 100644 --- a/R/kriging.R +++ b/R/kriging.R @@ -43,19 +43,20 @@ NULL #' @export setMethod( "interpolateFeature", signature(x = "giotto", y = "missing"), - function(x, - spat_unit = NULL, - feat_type = NULL, - feats, - spatvalues_params = list(), - spat_loc_name = "raw", - ext = NULL, - buffer = 50, - name_fmt = "%s", - savedir = file.path(getwd(), "interp_rasters"), - overwrite = FALSE, - verbose = NULL, - ...) { + function( + x, + spat_unit = NULL, + feat_type = NULL, + feats, + spatvalues_params = list(), + spat_loc_name = "raw", + ext = NULL, + buffer = 50, + name_fmt = "%s", + savedir = file.path(getwd(), "interp_rasters"), + overwrite = FALSE, + verbose = NULL, + ...) { sl <- NULL # This method prepares the data from the giotto object to pass @@ -141,15 +142,16 @@ setMethod( setMethod( "interpolateFeature", signature(x = "spatLocsObj", y = "data.frame"), - function(x, y, - ext = NULL, - buffer = 50, - rastersize = 500, - name_fmt = "%s", - savedir = file.path(getwd(), "interp_rasters"), - overwrite = FALSE, - # cores = GiottoUtils::determine_cores(), - ...) { + function( + x, y, + ext = NULL, + buffer = 50, + rastersize = 500, + name_fmt = "%s", + savedir = file.path(getwd(), "interp_rasters"), + overwrite = FALSE, + # cores = GiottoUtils::determine_cores(), + ...) { checkmate::assert_character(savedir) checkmate::assert_character(name_fmt) checkmate::assert_logical(overwrite) diff --git a/R/normalize.R b/R/normalize.R index 2a1a2a1a3..510788d8f 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -61,25 +61,24 @@ #' #' normalizeGiotto(g) # default is method A #' @export -normalizeGiotto <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = "raw", - norm_methods = c("standard", "pearson_resid", "osmFISH", "quantile"), - library_size_norm = TRUE, - scalefactor = 6e3, - log_norm = TRUE, - log_offset = 1, - logbase = 2, - scale_feats = TRUE, - scale_genes = deprecated(), - scale_cells = TRUE, - scale_order = c("first_feats", "first_cells"), - theta = 100, - name = "scaled", - update_slot = deprecated(), - verbose = TRUE) { +normalizeGiotto <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = "raw", + norm_methods = c("standard", "pearson_resid", "osmFISH", "quantile"), + library_size_norm = TRUE, + scalefactor = 6e3, + log_norm = TRUE, + log_offset = 1, + logbase = 2, + scale_feats = TRUE, + scale_genes = deprecated(), + scale_cells = TRUE, + scale_order = c("first_feats", "first_cells"), + theta = 100, + name = "scaled", + update_slot = deprecated(), + verbose = TRUE) { ## deprecated arguments scale_feats <- deprecate_param( scale_genes, scale_feats, @@ -285,20 +284,19 @@ normalizeGiotto <- function( #' @returns giotto object #' @keywords internal #' @noRd -.rna_standard_normalization <- function( - gobject, - raw_expr, - feat_type, - spat_unit, - library_size_norm = TRUE, - scalefactor = 6e3, - log_norm = TRUE, - log_offset = 1, - logbase = 2, - scale_feats = TRUE, - scale_cells = TRUE, - scale_order = c("first_feats", "first_cells"), - verbose = TRUE) { +.rna_standard_normalization <- function(gobject, + raw_expr, + feat_type, + spat_unit, + library_size_norm = TRUE, + scalefactor = 6e3, + log_norm = TRUE, + log_offset = 1, + logbase = 2, + scale_feats = TRUE, + scale_cells = TRUE, + scale_order = c("first_feats", "first_cells"), + verbose = TRUE) { # check feature type compatibility if (!feat_type %in% c("rna", "RNA")) { warning("Caution: Standard normalization was developed for RNA data \n") @@ -443,13 +441,12 @@ normalizeGiotto <- function( #' @returns giotto object #' @keywords internal #' @noRd -.rna_osmfish_normalization <- function( - gobject, - raw_expr, - feat_type, - spat_unit, - name = "custom", - verbose = TRUE) { +.rna_osmfish_normalization <- function(gobject, + raw_expr, + feat_type, + spat_unit, + name = "custom", + verbose = TRUE) { # check feature type compatibility if (!feat_type %in% c("rna", "RNA")) { warning("Caution: osmFISH normalization was developed for RNA in situ @@ -494,14 +491,13 @@ normalizeGiotto <- function( #' @returns giotto object #' @keywords internal #' @noRd -.rna_pears_resid_normalization <- function( - gobject, - raw_expr, - feat_type, - spat_unit, - theta = 100, - name = "scaled", - verbose = TRUE) { +.rna_pears_resid_normalization <- function(gobject, + raw_expr, + feat_type, + spat_unit, + theta = 100, + name = "scaled", + verbose = TRUE) { # print message with information # if (verbose) { message("using 'Lause/Kobak' method to normalize count matrix If used in @@ -541,13 +537,12 @@ normalizeGiotto <- function( return(gobject) } -.quantile_norm <- function( - gobject, - raw_expr, - feat_type, - spat_unit, - name = "quantile", - verbose = TRUE) { +.quantile_norm <- function(gobject, + raw_expr, + feat_type, + spat_unit, + name = "quantile", + verbose = TRUE) { z <- .qnorm(x = raw_expr[]) z <- create_expr_obj( name = name, @@ -568,11 +563,10 @@ normalizeGiotto <- function( # x : raw expression matrix # .csums : function for colSums that does not drop to vector # .rsums : function for rowSums that does not drop to vector -.prnorm <- function( - x, - theta = 100, - .csums = .csum_nodrop.Matrix, - .rsums = .rsum_nodrop.Matrix) { +.prnorm <- function(x, + theta = 100, + .csums = .csum_nodrop.Matrix, + .rsums = .rsum_nodrop.Matrix) { # find 1. colsums, 2. rowsums, 3. matrix sum counts_sum0 <- .csums(x) counts_sum1 <- .rsums(x) diff --git a/R/poly_influence.R b/R/poly_influence.R index 6c1bea3fb..cf5a2a031 100644 --- a/R/poly_influence.R +++ b/R/poly_influence.R @@ -26,13 +26,14 @@ #' condensed to align with the smaller number of clusters and ensure overlap. #' #' @export -showPolygonSizeInfluence <- function(gobject = NULL, - spat_unit = NULL, - alt_spat_unit = NULL, - feat_type = NULL, - clus_name = "kmeans", - return_plot = FALSE, - verbose = FALSE) { +showPolygonSizeInfluence <- function( + gobject = NULL, + spat_unit = NULL, + alt_spat_unit = NULL, + feat_type = NULL, + clus_name = "kmeans", + return_plot = FALSE, + verbose = FALSE) { # NSE vars cell_ID <- total_expr <- cluster_interactions <- N <- resize_switch <- NULL @@ -186,9 +187,10 @@ showPolygonSizeInfluence <- function(gobject = NULL, #' in each cluster. #' #' @keywords internal -.determine_switch_string_equal <- function(cell_meta = NULL, - cell_meta_new = NULL, - clus_name = NULL) { +.determine_switch_string_equal <- function( + cell_meta = NULL, + cell_meta_new = NULL, + clus_name = NULL) { k_clusters <- sort(unique(cell_meta[[clus_name]])) num_clusters <- k_clusters[length(k_clusters)] @@ -236,8 +238,9 @@ showPolygonSizeInfluence <- function(gobject = NULL, #' Essentially determines iteration order for .create_switch_string_unequal() #' #' @keywords internal -.determine_switch_string_unequal <- function(num_orig = NULL, - num_new = NULL) { +.determine_switch_string_unequal <- function( + num_orig = NULL, + num_new = NULL) { switch_strs <- c() orig_first <- TRUE @@ -274,9 +277,10 @@ showPolygonSizeInfluence <- function(gobject = NULL, #' n is the number of clusters in the original spatial unit #' m is the number of clusters in the new spatial unit #' @keywords internal -.create_switch_string_unequal <- function(num_first = NULL, - num_second = NULL, - switch_strs = NULL) { +.create_switch_string_unequal <- function( + num_first = NULL, + num_second = NULL, + switch_strs = NULL) { for (o in num_first) { for (n in num_second) { if (as.integer(o) == as.integer(n)) { @@ -308,9 +312,10 @@ showPolygonSizeInfluence <- function(gobject = NULL, #' The function showPolygonSizeInfluence() must have been run on the Giotto #' Object for this function to run. #' @export -showCellProportionSwitchedPie <- function(gobject = NULL, - spat_unit = NULL, - feat_type = NULL) { +showCellProportionSwitchedPie <- function( + gobject = NULL, + spat_unit = NULL, + feat_type = NULL) { # NSE vars cluster_status <- num_cells <- resize_switch <- perc <- ypos <- NULL @@ -382,10 +387,11 @@ showCellProportionSwitchedPie <- function(gobject = NULL, #' @details Creates a Sankey Diagram to illustrate cluster switching behavior. #' Currently only supports displaying cluster switching for kmeans clusters. #' @export -showCellProportionSwitchedSanKey <- function(gobject = NULL, - spat_unit = NULL, - alt_spat_unit = NULL, - feat_type = NULL) { +showCellProportionSwitchedSanKey <- function( + gobject = NULL, + spat_unit = NULL, + alt_spat_unit = NULL, + feat_type = NULL) { # NSE vars kmeans_small <- cell_ID <- NULL diff --git a/R/python_hmrf.R b/R/python_hmrf.R index 38e3330f7..4eca326b9 100644 --- a/R/python_hmrf.R +++ b/R/python_hmrf.R @@ -37,28 +37,27 @@ #' output_folder = tempdir() #' ) #' @export -doHMRF <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - spatial_network_name = "Delaunay_network", - spat_loc_name = "raw", - spatial_genes = NULL, - spatial_dimensions = c("sdimx", "sdimy", "sdimz"), - dim_reduction_to_use = NULL, - dim_reduction_name = "pca", - dimensions_to_use = 1:10, - seed = 100, - name = "test", - k = 10, - betas = c(0, 2, 50), - tolerance = 1e-10, - zscore = c("none", "rowcol", "colrow"), - numinit = 100, - python_path = NULL, - output_folder = NULL, - overwrite_output = TRUE) { +doHMRF <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + spatial_network_name = "Delaunay_network", + spat_loc_name = "raw", + spatial_genes = NULL, + spatial_dimensions = c("sdimx", "sdimy", "sdimz"), + dim_reduction_to_use = NULL, + dim_reduction_name = "pca", + dimensions_to_use = 1:10, + seed = 100, + name = "test", + k = 10, + betas = c(0, 2, 50), + tolerance = 1e-10, + zscore = c("none", "rowcol", "colrow"), + numinit = 100, + python_path = NULL, + output_folder = NULL, + overwrite_output = TRUE) { package_check("smfishHmrf", repository = "pip") # data.table set global variable @@ -145,7 +144,7 @@ doHMRF <- function( # overwrite if exists if (file.exists(expression_file) & overwrite_output == TRUE) { - message("\n expression_matrix.txt already exists at this location, + message("\n expression_matrix.txt already exists at this location, will be overwritten") data.table::fwrite( data.table::as.data.table(expr_values, keep.rownames = "gene"), @@ -153,7 +152,7 @@ doHMRF <- function( row.names = FALSE, sep = " " ) } else if (file.exists(expression_file) & overwrite_output == FALSE) { - message("\n expression_matrix.txt already exists at this location, + message("\n expression_matrix.txt already exists at this location, will be used again") } else { data.table::fwrite( @@ -362,11 +361,12 @@ doHMRF <- function( #' ) #' #' @export -loadHMRF <- function(name_used = "test", - output_folder_used, - k_used = 10, - betas_used, - python_path_used) { +loadHMRF <- function( + name_used = "test", + output_folder_used, + k_used = 10, + betas_used, + python_path_used) { output_data <- paste0(output_folder_used, "/", "result.spatial.zscore") if (!file.exists(output_data)) { stop("\n doHMRF was not run in this output directory") @@ -402,12 +402,13 @@ loadHMRF <- function(name_used = "test", #' @returns spatial plots with HMRF domains #' @seealso \code{\link{spatPlot2D}} and \code{\link{spatPlot3D}} #' @export -viewHMRFresults <- function(gobject, - HMRFoutput, - k = NULL, - betas_to_view = NULL, - third_dim = FALSE, - ...) { +viewHMRFresults <- function( + gobject, + HMRFoutput, + k = NULL, + betas_to_view = NULL, + third_dim = FALSE, + ...) { if (!"HMRFoutput" %in% class(HMRFoutput)) { stop("\n HMRFoutput needs to be output from doHMRFextend") } @@ -488,11 +489,12 @@ viewHMRFresults <- function(gobject, #' @param print_command see the python command #' @returns data.table with HMRF results for each b and the selected k #' @export -writeHMRFresults <- function(gobject, - HMRFoutput, - k = NULL, - betas_to_view = NULL, - print_command = FALSE) { +writeHMRFresults <- function( + gobject, + HMRFoutput, + k = NULL, + betas_to_view = NULL, + print_command = FALSE) { if (!"HMRFoutput" %in% class(HMRFoutput)) { stop("\n HMRFoutput needs to be output from doHMRFextend") } @@ -597,13 +599,14 @@ writeHMRFresults <- function(gobject, #' gobject = g, cell_color = "HMRF_k6_b.20", #' ) #' @export -addHMRF <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - HMRFoutput, - k = NULL, - betas_to_add = NULL, - hmrf_name = NULL) { +addHMRF <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + HMRFoutput, + k = NULL, + betas_to_add = NULL, + hmrf_name = NULL) { if (!"HMRFoutput" %in% class(HMRFoutput)) { stop("\n HMRFoutput needs to be output from doHMRFextend") } @@ -723,13 +726,14 @@ addHMRF <- function(gobject, #' @returns spatial plots with HMRF domains #' @seealso \code{\link{spatPlot2D}} #' @export -viewHMRFresults2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - HMRFoutput, - k = NULL, - betas_to_view = NULL, - ...) { +viewHMRFresults2D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + HMRFoutput, + k = NULL, + betas_to_view = NULL, + ...) { spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit ) @@ -839,13 +843,14 @@ viewHMRFresults2D <- function(gobject, #' @returns spatial plots with HMRF domains #' @seealso \code{\link{spatPlot3D}} #' @export -viewHMRFresults3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - HMRFoutput, - k = NULL, - betas_to_view = NULL, - ...) { +viewHMRFresults3D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + HMRFoutput, + k = NULL, + betas_to_view = NULL, + ...) { if (!"HMRFoutput" %in% class(HMRFoutput)) { stop("\n HMRFoutput needs to be output from doHMRFextend") } @@ -962,10 +967,11 @@ viewHMRFresults3D <- function(gobject, #' Changing from equal size by setting sample_rate = 1 to with exact proportion #' of each cluster by setting sample_rate = +Inf #' @keywords internal -sampling_sp_genes <- function(clust, - sample_rate = 2, - target = 500, - seed = 10) { +sampling_sp_genes <- function( + clust, + sample_rate = 2, + target = 500, + seed = 10) { tot <- 0 num_cluster <- length(unique(clust)) gene_list <- list() @@ -1019,9 +1025,10 @@ sampling_sp_genes <- function(clust, #' This function calculates the number of data points in a sorted sequence #' below a line with given slope through a certain point on this sequence. #' @keywords internal -numPts_below_line <- function(myVector, - slope, - x) { +numPts_below_line <- function( + myVector, + slope, + x) { yPt <- myVector[x] b <- yPt - (slope * x) xPts <- seq_along(myVector) @@ -1050,8 +1057,8 @@ numPts_below_line <- function(myVector, #' #' filterSpatialGenes(g, spatial_genes = "Gm19935") #' @export -filterSpatialGenes <- function(gobject, spat_unit = NULL, feat_type = NULL, - spatial_genes, max = 2500, +filterSpatialGenes <- function(gobject, spat_unit = NULL, feat_type = NULL, + spatial_genes, max = 2500, name = c("binSpect", "silhouetteRank", "silhouetteRankTest"), method = c("none", "elbow")) { name <- match.arg( @@ -1145,8 +1152,8 @@ filterSpatialGenes <- function(gobject, spat_unit = NULL, feat_type = NULL, #' Priorities for showing the spatial gene test names are ‘binSpect’ > #' ‘silhouetteRankTest’ > ‘silhouetteRank’. #' @keywords internal -chooseAvailableSpatialGenes <- function(gobject, - spat_unit = NULL, feat_type = NULL) { +chooseAvailableSpatialGenes <- function(gobject, + spat_unit = NULL, feat_type = NULL) { gx <- fDataDT(gobject, spat_unit = NULL, feat_type = NULL) eval1 <- "binSpect.pval" %in% names(gx) eval2 <- "silhouetteRankTest.pval" %in% names(gx) @@ -1180,11 +1187,12 @@ chooseAvailableSpatialGenes <- function(gobject, #' SilhouetteRank works only with score, and SilhouetteRankTest works only #' with pval. Use parameter use_score to specify. #' @keywords internal -checkAndFixSpatialGenes <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - use_spatial_genes, - use_score = FALSE) { +checkAndFixSpatialGenes <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + use_spatial_genes, + use_score = FALSE) { gx <- fDataDT(gobject, spat_unit = NULL, feat_type = NULL) if (use_spatial_genes == "silhouetteRank") { @@ -1318,37 +1326,38 @@ checkAndFixSpatialGenes <- function(gobject, #' initHMRF_V2(gobject = g, cl.method = "km") #' @export initHMRF_V2 <- - function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("scaled", "normalized", "custom"), - spatial_network_name = "Delaunay_network", - use_spatial_genes = c("binSpect", "silhouetteRank"), - use_score = FALSE, - gene_list_from_top = 2500, - filter_method = c("none", "elbow"), - user_gene_list = NULL, - use_pca = FALSE, - use_pca_dim = 1:20, - gene_samples = 500, - gene_sampling_rate = 2, - gene_sampling_seed = 10, - use_metagene = FALSE, - cluster_metagene = 50, - top_metagene = 20, - existing_spatial_enrichm_to_use = NULL, - use_neighborhood_composition = FALSE, - spatial_network_name_for_neighborhood = NULL, - metadata_to_use = NULL, - hmrf_seed = 100, - cl.method = c("km", "leiden", "louvain"), - resolution.cl = 1, - k = 10, - tolerance = 1e-05, - zscore = c("none", "rowcol", "colrow"), - nstart = 1000, - factor_step = 1.05, - python_path = NULL) { + function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("scaled", "normalized", "custom"), + spatial_network_name = "Delaunay_network", + use_spatial_genes = c("binSpect", "silhouetteRank"), + use_score = FALSE, + gene_list_from_top = 2500, + filter_method = c("none", "elbow"), + user_gene_list = NULL, + use_pca = FALSE, + use_pca_dim = 1:20, + gene_samples = 500, + gene_sampling_rate = 2, + gene_sampling_seed = 10, + use_metagene = FALSE, + cluster_metagene = 50, + top_metagene = 20, + existing_spatial_enrichm_to_use = NULL, + use_neighborhood_composition = FALSE, + spatial_network_name_for_neighborhood = NULL, + metadata_to_use = NULL, + hmrf_seed = 100, + cl.method = c("km", "leiden", "louvain"), + resolution.cl = 1, + k = 10, + tolerance = 1e-05, + zscore = c("none", "rowcol", "colrow"), + nstart = 1000, + factor_step = 1.05, + python_path = NULL) { wrap_msg( "\n If used in published research, please cite: Q Zhu, S Shah, R Dries, L Cai, GC Yuan. @@ -1770,8 +1779,8 @@ initHMRF_V2 <- gobject@dimension_reduction$cells$spatial$spatial_feat$coordinates <- y gobject <- createNearestNetwork( - gobject = gobject, - spat_unit = spat_unit, + gobject = gobject, + spat_unit = spat_unit, feat_type = feat_type, dim_reduction_to_use = "spatial", dim_reduction_name = "spatial_feat", @@ -1782,8 +1791,8 @@ initHMRF_V2 <- if (cl.method == "leiden") { message("\n Leiden clustering initialization...") leiden.cl <- doLeidenCluster( - gobject = gobject, - spat_unit = spat_unit, + gobject = gobject, + spat_unit = spat_unit, feat_type = feat_type, nn_network_to_use = "sNN", network_name = "sNN.initHMRF", @@ -1799,8 +1808,8 @@ initHMRF_V2 <- } else if (cl.method == "louvain") { message("\n Louvain clustering initialization...") louvain.cl <- doLouvainCluster( - gobject = gobject, - spat_unit = spat_unit, + gobject = gobject, + spat_unit = spat_unit, feat_type = feat_type, nn_network_to_use = "sNN", network_name = "sNN.initHMRF", @@ -2073,21 +2082,22 @@ addHMRF_V2 <- function(gobject, HMRFoutput, name = "hmrf") { #' (for example name of ‘hmrf1 k=8 b=0.00’ is ‘hmrf1’) #' @export viewHMRFresults_V2 <- - function(gobject, k, betas, - hmrf_name, - spat_unit = NULL, - feat_type = NULL, - third_dim = FALSE, - cow_n_col = 2, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - show_plot = TRUE, - save_plot = TRUE, - return_plot = TRUE, - default_save_name = "HMRF_result", - save_param = list(), - ...) { + function( + gobject, k, betas, + hmrf_name, + spat_unit = NULL, + feat_type = NULL, + third_dim = FALSE, + cow_n_col = 2, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + show_plot = TRUE, + save_plot = TRUE, + return_plot = TRUE, + default_save_name = "HMRF_result", + save_param = list(), + ...) { # beta_seq = round(betas,digits = 2) # t_key = paste0(hmrf_name,'_k', k, '_b.',beta_seq) t_key <- paste(hmrf_name, sprintf("k=%d b=%.2f", k, betas)) diff --git a/R/python_scrublet.R b/R/python_scrublet.R index b22e373c3..0f422ceae 100644 --- a/R/python_scrublet.R +++ b/R/python_scrublet.R @@ -36,17 +36,18 @@ #' pDataDT(g) # doublet_scores and doublet cols are added #' dimPlot2D(g, cell_color = "doublet_scores", color_as_factor = FALSE) #' @export -doScrubletDetect <- function(gobject, - feat_type = NULL, - spat_unit = "cell", - expression_values = "raw", - expected_doublet_rate = 0.06, - min_counts = 1, - min_cells = 1, - min_gene_variability_pctl = 85, - n_prin_comps = 30, - return_gobject = TRUE, - seed = 1234) { +doScrubletDetect <- function( + gobject, + feat_type = NULL, + spat_unit = "cell", + expression_values = "raw", + expected_doublet_rate = 0.06, + min_counts = 1, + min_cells = 1, + min_gene_variability_pctl = 85, + n_prin_comps = 30, + return_gobject = TRUE, + seed = 1234) { # verify if optional package is installed package_check( pkg_name = "scrublet", diff --git a/R/spatial_clusters.R b/R/spatial_clusters.R index 81fbf9e98..71f0bf292 100644 --- a/R/spatial_clusters.R +++ b/R/spatial_clusters.R @@ -21,14 +21,15 @@ #' # don't show legend since there are too many categories generated #' spatPlot2D(g, cell_color = "new", show_legend = FALSE) #' @export -spatialSplitCluster <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network_name = "Delaunay_network", - cluster_col, - split_clus_name = paste0(cluster_col, "_split"), - missing_id_name = "not_connected", - return_gobject = TRUE) { +spatialSplitCluster <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "Delaunay_network", + cluster_col, + split_clus_name = paste0(cluster_col, "_split"), + missing_id_name = "not_connected", + return_gobject = TRUE) { # NSE vars cell_ID <- NULL @@ -122,18 +123,19 @@ spatialSplitCluster <- function(gobject, #' @param return_gobject logical. Return giotto object #' @returns cluster annotations #' @export -identifyTMAcores <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network_name = "Delaunay_network", - core_id_name = "core_id", - id_fmt = "%d", - include_all_ids = TRUE, - missing_id_name = "not_connected", - min_nodes = 5, - join_split_cores = TRUE, - join_tolerance = 1.2, - return_gobject = TRUE) { +identifyTMAcores <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "Delaunay_network", + core_id_name = "core_id", + id_fmt = "%d", + include_all_ids = TRUE, + missing_id_name = "not_connected", + min_nodes = 5, + join_split_cores = TRUE, + join_tolerance = 1.2, + return_gobject = TRUE) { # NSE vars cell_ID <- NULL @@ -248,7 +250,6 @@ identifyTMAcores <- function(gobject, con[init_idx == idx_2, init_idx := idx_1] } - } # apply core_id_name @@ -337,8 +338,8 @@ identifyTMAcores <- function(gobject, #' @keywords internal #' @noRd .igraph_vertex_membership <- function(g, - clus_name, - all_ids = NULL) { + clus_name, + all_ids = NULL) { # get membership membership <- igraph::components(g)$membership %>% data.table::as.data.table(keep.rownames = TRUE) @@ -353,13 +354,9 @@ identifyTMAcores <- function(gobject, ) data.table::setnames(missing_membership, c("cell_ID", clus_name)) membership <- data.table::rbindlist( - list(membership, missing_membership)) + list(membership, missing_membership) + ) } return(membership) } - - - - - diff --git a/R/spatial_enrichment.R b/R/spatial_enrichment.R index 76f3c652a..8864acc02 100644 --- a/R/spatial_enrichment.R +++ b/R/spatial_enrichment.R @@ -81,8 +81,9 @@ NULL #' @rdname enrichment_PAGE #' @export -makeSignMatrixPAGE <- function(sign_names, - sign_list) { +makeSignMatrixPAGE <- function( + sign_names, + sign_list) { ## check input if (!inherits(sign_list, "list")) { stop("sign_list needs to be a list of signatures for each cell type / @@ -146,9 +147,10 @@ makeSignMatrixPAGE <- function(sign_names, #' cell_type_vector = c("cell_type1", "cell_type2", "cell_type3") #' ) #' @export -makeSignMatrixDWLSfromMatrix <- function(matrix, - sign_gene, - cell_type_vector) { +makeSignMatrixDWLSfromMatrix <- function( + matrix, + sign_gene, + cell_type_vector) { # 1. check if cell_type_vector and matrix are compatible if (ncol(matrix) != length(cell_type_vector)) { stop("ncol(matrix) needs to be the same as length(cell_type_vector)") @@ -222,15 +224,16 @@ makeSignMatrixDWLSfromMatrix <- function(matrix, #' cell_type_vector = pDataDT(g)[["leiden_clus"]] #' ) #' @export -makeSignMatrixDWLS <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - reverse_log = TRUE, - log_base = 2, - sign_gene, - cell_type_vector, - cell_type = NULL) { +makeSignMatrixDWLS <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + reverse_log = TRUE, + log_base = 2, + sign_gene, + cell_type_vector, + cell_type = NULL) { ## deprecated arguments if (!is.null(cell_type)) { warning("cell_type is deprecated, use cell_type_vector in the future") @@ -309,10 +312,11 @@ makeSignMatrixDWLS <- function(gobject, #' sc_cluster_ids = c("cell_type1", "cell_type2", "cell_type3") #' ) #' @export -makeSignMatrixRank <- function(sc_matrix, - sc_cluster_ids, - ties_method = c("random", "max"), - gobject = NULL) { +makeSignMatrixRank <- function( + sc_matrix, + sc_cluster_ids, + ties_method = c("random", "max"), + gobject = NULL) { if (inherits(sc_matrix, "exprObj")) { sc_matrix <- sc_matrix[] } @@ -393,9 +397,10 @@ makeSignMatrixRank <- function(sc_matrix, #' @description creates permutation for the PAGEEnrich test #' @returns PAGEEnrich test #' @keywords internal -.do_page_permutation <- function(gobject, - sig_gene, - ntimes) { +.do_page_permutation <- function( + gobject, + sig_gene, + ntimes) { # check available gene available_ct <- c() for (i in colnames(sig_gene)) { @@ -468,17 +473,18 @@ makeSignMatrixRank <- function(sc_matrix, #' @param expr_values matrix of expression values #' @returns data.table #' @keywords internal -.page_dt_method <- function(sign_matrix, - expr_values, - min_overlap_genes = 5, - logbase = 2, - reverse_log_scale = TRUE, - output_enrichment = c("original", "zscore"), - p_value = FALSE, - include_depletion = FALSE, - n_times = 1000, - max_block = 20e6, - verbose = TRUE) { +.page_dt_method <- function( + sign_matrix, + expr_values, + min_overlap_genes = 5, + logbase = 2, + reverse_log_scale = TRUE, + output_enrichment = c("original", "zscore"), + p_value = FALSE, + include_depletion = FALSE, + n_times = 1000, + max_block = 20e6, + verbose = TRUE) { # data.table variables Var1 <- value <- Var2 <- V1 <- marker <- nr_markers <- fc <- cell_ID <- zscore <- colmean <- colSd <- pval <- NULL @@ -713,22 +719,23 @@ makeSignMatrixRank <- function(sc_matrix, #' @rdname enrichment_PAGE #' @export -runPAGEEnrich <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - sign_matrix, - expression_values = c("normalized", "scaled", "custom"), - min_overlap_genes = 5, - reverse_log_scale = TRUE, - logbase = 2, - output_enrichment = c("original", "zscore"), - p_value = FALSE, - include_depletion = FALSE, - n_times = 1000, - max_block = 20e6, - name = NULL, - verbose = TRUE, - return_gobject = TRUE) { +runPAGEEnrich <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + sign_matrix, + expression_values = c("normalized", "scaled", "custom"), + min_overlap_genes = 5, + reverse_log_scale = TRUE, + logbase = 2, + output_enrichment = c("original", "zscore"), + p_value = FALSE, + include_depletion = FALSE, + n_times = 1000, + max_block = 20e6, + name = NULL, + verbose = TRUE, + return_gobject = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -910,21 +917,22 @@ runPAGEEnrich <- function(gobject, #' expression_values = "normalized" #' ) #' @export -runRankEnrich <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - sign_matrix, - expression_values = c("normalized", "raw", "scaled", "custom"), - reverse_log_scale = TRUE, - logbase = 2, - output_enrichment = c("original", "zscore"), - ties_method = c("average", "max"), - p_value = FALSE, - n_times = 1000, - rbp_p = 0.99, - num_agg = 100, - name = NULL, - return_gobject = TRUE) { +runRankEnrich <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + sign_matrix, + expression_values = c("normalized", "raw", "scaled", "custom"), + reverse_log_scale = TRUE, + logbase = 2, + output_enrichment = c("original", "zscore"), + ties_method = c("average", "max"), + p_value = FALSE, + n_times = 1000, + rbp_p = 0.99, + num_agg = 100, + name = NULL, + return_gobject = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1168,18 +1176,19 @@ runRankEnrich <- function(gobject, #' #' runHyperGeometricEnrich(gobject = g, sign_matrix = sign_matrix) #' @export -runHyperGeometricEnrich <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - sign_matrix, - expression_values = c("normalized", "scaled", "custom"), - reverse_log_scale = TRUE, - logbase = 2, - top_percentage = 5, - output_enrichment = c("original", "zscore"), - p_value = FALSE, - name = NULL, - return_gobject = TRUE) { +runHyperGeometricEnrich <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + sign_matrix, + expression_values = c("normalized", "scaled", "custom"), + reverse_log_scale = TRUE, + logbase = 2, + top_percentage = 5, + output_enrichment = c("original", "zscore"), + p_value = FALSE, + name = NULL, + return_gobject = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1396,25 +1405,26 @@ runHyperGeometricEnrich <- function(gobject, #' #' runSpatialEnrich(gobject = g, sign_matrix = sign_matrix) #' @export -runSpatialEnrich <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - enrich_method = c("PAGE", "rank", "hypergeometric"), - sign_matrix, - expression_values = c("normalized", "scaled", "custom"), - min_overlap_genes = 5, - reverse_log_scale = TRUE, - logbase = 2, - p_value = FALSE, - n_times = 1000, - rbp_p = 0.99, - num_agg = 100, - max_block = 20e6, - top_percentage = 5, - output_enrichment = c("original", "zscore"), - name = NULL, - verbose = TRUE, - return_gobject = TRUE) { +runSpatialEnrich <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + enrich_method = c("PAGE", "rank", "hypergeometric"), + sign_matrix, + expression_values = c("normalized", "scaled", "custom"), + min_overlap_genes = 5, + reverse_log_scale = TRUE, + logbase = 2, + p_value = FALSE, + n_times = 1000, + rbp_p = 0.99, + num_agg = 100, + max_block = 20e6, + top_percentage = 5, + output_enrichment = c("original", "zscore"), + name = NULL, + verbose = TRUE, + return_gobject = TRUE) { enrich_method <- match.arg( enrich_method, choices = c("PAGE", "rank", "hypergeometric") @@ -1550,24 +1560,25 @@ NULL #' \item{\emph{Geary's C} 'geary'} #' } #' @export -spatialAutoCorGlobal <- function(gobject = NULL, - spat_unit = NULL, - feat_type = NULL, - feats = NULL, - method = c("moran", "geary"), - data_to_use = c("expression", "cell_meta"), - expression_values = c("normalized", "scaled", "custom"), - meta_cols = NULL, - spatial_network_to_use = "kNN_network", - wm_method = c("distance", "adjacency"), - wm_name = "spat_weights", - node_values = NULL, - weight_matrix = NULL, - test_method = c("none", "monte_carlo"), - mc_nsim = 99, - cor_name = NULL, - return_gobject = FALSE, - verbose = TRUE) { +spatialAutoCorGlobal <- function( + gobject = NULL, + spat_unit = NULL, + feat_type = NULL, + feats = NULL, + method = c("moran", "geary"), + data_to_use = c("expression", "cell_meta"), + expression_values = c("normalized", "scaled", "custom"), + meta_cols = NULL, + spatial_network_to_use = "kNN_network", + wm_method = c("distance", "adjacency"), + wm_name = "spat_weights", + node_values = NULL, + weight_matrix = NULL, + test_method = c("none", "monte_carlo"), + mc_nsim = 99, + cor_name = NULL, + return_gobject = FALSE, + verbose = TRUE) { # 0. determine inputs method <- match.arg(method, choices = c("moran", "geary")) test_method <- match.arg(test_method, choices = c("none", "monte_carlo")) @@ -1722,25 +1733,26 @@ spatialAutoCorGlobal <- function(gobject = NULL, #' \item{\emph{Local mean} 'mean'} #' } #' @export -spatialAutoCorLocal <- function(gobject = NULL, - spat_unit = NULL, - feat_type = NULL, - feats = NULL, - method = c("moran", "gi", "gi*", "mean"), - data_to_use = c("expression", "cell_meta"), - expression_values = c("normalized", "scaled", "custom"), - meta_cols = NULL, - spatial_network_to_use = "kNN_network", - wm_method = c("distance", "adjacency"), - wm_name = "spat_weights", - node_values = NULL, - weight_matrix = NULL, - test_method = c("none"), - # cor_name = NULL, - enrich_name = NULL, - return_gobject = TRUE, - output = c("spatEnrObj", "data.table"), - verbose = TRUE) { +spatialAutoCorLocal <- function( + gobject = NULL, + spat_unit = NULL, + feat_type = NULL, + feats = NULL, + method = c("moran", "gi", "gi*", "mean"), + data_to_use = c("expression", "cell_meta"), + expression_values = c("normalized", "scaled", "custom"), + meta_cols = NULL, + spatial_network_to_use = "kNN_network", + wm_method = c("distance", "adjacency"), + wm_name = "spat_weights", + node_values = NULL, + weight_matrix = NULL, + test_method = c("none"), + # cor_name = NULL, + enrich_name = NULL, + return_gobject = TRUE, + output = c("spatEnrObj", "data.table"), + verbose = TRUE) { # 0. determine inputs method_select <- match.arg( method, @@ -1907,13 +1919,14 @@ spatialAutoCorLocal <- function(gobject = NULL, #' .run_spat_autocor_global #' @returns data.table #' @keywords internal -.run_spat_autocor_global <- function(use_values, - feats, - weight_matrix, - method, - test_method, - mc_nsim, - cor_name) { +.run_spat_autocor_global <- function( + use_values, + feats, + weight_matrix, + method, + test_method, + mc_nsim, + cor_name) { # data.table vars cell_ID <- nsim <- NULL @@ -1991,12 +2004,13 @@ spatialAutoCorLocal <- function(gobject = NULL, #' .run_spat_autocor_local #' @returns data.table #' @keywords internal -.run_spat_autocor_local <- function(use_values, - feats, - weight_matrix, - method, - test_method, - IDs) { +.run_spat_autocor_local <- function( + use_values, + feats, + weight_matrix, + method, + test_method, + IDs) { cell_ID <- NULL nfeats <- length(feats) @@ -2077,23 +2091,24 @@ spatialAutoCorLocal <- function(gobject = NULL, # 4, IDs - cell_IDs if available # Some additional information about information used in specific workflows are # also returned -.evaluate_autocor_input <- function(gobject, - use_ext_vals, - use_sn, - use_expr, - use_meta, - spat_unit, - feat_type, - feats, - data_to_use, - expression_values, - meta_cols, - spatial_network_to_use, - wm_method, - wm_name, - node_values, - weight_matrix, - verbose = TRUE) { +.evaluate_autocor_input <- function( + gobject, + use_ext_vals, + use_sn, + use_expr, + use_meta, + spat_unit, + feat_type, + feats, + data_to_use, + expression_values, + meta_cols, + spatial_network_to_use, + wm_method, + wm_name, + node_values, + weight_matrix, + verbose = TRUE) { cell_ID <- NULL # 1. Get spatial network to either get or generate a spatial weight matrix @@ -2152,7 +2167,7 @@ spatialAutoCorLocal <- function(gobject = NULL, # 2. Get and format node values for use with autocorrelation function. # End outputs are: # - use_values for a spatID (rows) by features (cols) table or matrix - # - feats the names of selected features to use that will be iterated + # - feats the names of selected features to use that will be iterated # through downstream if (isTRUE(use_expr)) { # EXPR=================================================================# @@ -2257,11 +2272,12 @@ spatialAutoCorLocal <- function(gobject = NULL, #' @description Rui to fill in #' @returns matrix #' @keywords internal -enrich_deconvolution <- function(expr, - log_expr, - cluster_info, - ct_exp, - cutoff) { +enrich_deconvolution <- function( + expr, + log_expr, + cluster_info, + ct_exp, + cutoff) { ##### generate enrich 0/1 matrix based on expression matrix ct_exp <- ct_exp[rowSums(ct_exp) > 0, ] enrich_matrix <- matrix(0, nrow = dim(ct_exp)[1], ncol = dim(ct_exp)[2]) @@ -2328,10 +2344,11 @@ enrich_deconvolution <- function(expr, #' @description Rui to fill in #' @returns matrix #' @keywords internal -spot_deconvolution <- function(expr, - cluster_info, - ct_exp, - binary_matrix) { +spot_deconvolution <- function( + expr, + cluster_info, + ct_exp, + binary_matrix) { ##### generate enrich 0/1 matrix based on expression matrix enrich_matrix <- matrix(0, nrow = dim(ct_exp)[1], ncol = dim(ct_exp)[2]) rowmax_col <- Rfast::rowMaxs(ct_exp) @@ -2413,8 +2430,9 @@ spot_deconvolution <- function(expr, uniq_ct_k_gene, ], constant_J) dwls_results[ - names(solDWLS), - colnames(cluster_cell_exp)[k]] <- solDWLS + names(solDWLS), + colnames(cluster_cell_exp)[k] + ] <- solDWLS } } } @@ -2434,9 +2452,10 @@ spot_deconvolution <- function(expr, #' @description Rui to fill in #' @returns enrichment values #' @keywords internal -cluster_enrich_analysis <- function(exp_matrix, - cluster_info, - enrich_sig_matrix) { +cluster_enrich_analysis <- function( + exp_matrix, + cluster_info, + enrich_sig_matrix) { uniq_cluster <- mixedsort(unique(cluster_info)) if (length(uniq_cluster) == 1) { stop("Only one cluster identified, need at least two.") @@ -2462,8 +2481,9 @@ cluster_enrich_analysis <- function(exp_matrix, #' @description Rui to fill in #' @returns enrichment matrix #' @keywords internal -enrich_analysis <- function(expr_values, - sign_matrix) { +enrich_analysis <- function( + expr_values, + sign_matrix) { # output enrichment # only continue with genes present in both datasets interGene <- intersect(rownames(sign_matrix), rownames(expr_values)) @@ -2506,8 +2526,9 @@ enrich_analysis <- function(expr_values, #' @description Rui to fill in #' @returns matrix #' @keywords internal -optimize_deconvolute_dwls <- function(exp, - Signature) { +optimize_deconvolute_dwls <- function( + exp, + Signature) { ###### overlap signature with spatial genes Genes <- intersect(rownames(Signature), rownames(exp)) S <- Signature[Genes, ] @@ -2541,9 +2562,10 @@ optimize_deconvolute_dwls <- function(exp, #' @title optimize_solveDampenedWLS #' @returns numeric #' @keywords internal -optimize_solveDampenedWLS <- function(S, - B, - constant_J) { +optimize_solveDampenedWLS <- function( + S, + B, + constant_J) { # first solve OLS, use this solution to find a starting point for the # weights solution <- solve_OLS_internal(S, B) @@ -2579,9 +2601,10 @@ optimize_solveDampenedWLS <- function(S, #' @description find a dampening constant for the weights using cross-validation #' @returns numeric #' @keywords internal -find_dampening_constant <- function(S, - B, - goldStandard) { +find_dampening_constant <- function( + S, + B, + goldStandard) { solutionsSd <- NULL # goldStandard is used to define the weights @@ -2630,8 +2653,9 @@ find_dampening_constant <- function(S, #' @description basic functions for dwls #' @returns numeric #' @keywords internal -solve_OLS_internal <- function(S, - B) { +solve_OLS_internal <- function( + S, + B) { D <- t(S) %*% S d <- t(S) %*% B A <- cbind(diag(dim(S)[2])) @@ -2696,10 +2720,11 @@ solve_OLS_internal <- function(S, #' @description solve WLS given a dampening constant #' @returns matrix #' @keywords internal -solve_dampened_WLSj <- function(S, - B, - goldStandard, - j) { +solve_dampened_WLSj <- function( + S, + B, + goldStandard, + j) { multiplier <- 1 * 2^(j - 1) sol <- goldStandard ws <- as.vector((1 / (S %*% sol))^2) @@ -2760,17 +2785,18 @@ solve_dampened_WLSj <- function(S, #' #' runDWLSDeconv(gobject = g, sign_matrix = sign_matrix) #' @export -runDWLSDeconv <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized"), - logbase = 2, - cluster_column = "leiden_clus", - sign_matrix, - n_cell = 50, - cutoff = 2, - name = NULL, - return_gobject = TRUE) { +runDWLSDeconv <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized"), + logbase = 2, + cluster_column = "leiden_clus", + sign_matrix, + n_cell = 50, + cutoff = 2, + name = NULL, + return_gobject = TRUE) { # verify if optional package is installed package_check(pkg_name = "quadprog", repository = "CRAN") package_check(pkg_name = "Rfast", repository = "CRAN") @@ -2939,18 +2965,19 @@ runDWLSDeconv <- function(gobject, #' #' runSpatialDeconv(gobject = g, sign_matrix = sign_matrix) #' @export -runSpatialDeconv <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - deconv_method = c("DWLS"), - expression_values = c("normalized"), - logbase = 2, - cluster_column = "leiden_clus", - sign_matrix, - n_cell = 50, - cutoff = 2, - name = NULL, - return_gobject = TRUE) { +runSpatialDeconv <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + deconv_method = c("DWLS"), + expression_values = c("normalized"), + logbase = 2, + cluster_column = "leiden_clus", + sign_matrix, + n_cell = 50, + cutoff = 2, + name = NULL, + return_gobject = TRUE) { deconv_method <- match.arg(deconv_method, choices = c("DWLS")) diff --git a/R/spatial_enrichment_visuals.R b/R/spatial_enrichment_visuals.R index 103ba6e82..5e9265a11 100644 --- a/R/spatial_enrichment_visuals.R +++ b/R/spatial_enrichment_visuals.R @@ -24,11 +24,12 @@ #' the associated cell types from the enrichment. #' #' @export -findCellTypesFromEnrichment <- function(gobject = NULL, - spat_unit = NULL, - feat_type = NULL, - enrichment_name = "PAGE_z_score", - return_frequency_table = FALSE) { +findCellTypesFromEnrichment <- function( + gobject = NULL, + spat_unit = NULL, + feat_type = NULL, + enrichment_name = "PAGE_z_score", + return_frequency_table = FALSE) { # guard clauses if (!inherits(gobject, "giotto")) { @@ -112,16 +113,17 @@ findCellTypesFromEnrichment <- function(gobject = NULL, #' annotation. #' #' @export -plotCellTypesFromEnrichment <- function(gobject = NULL, - spat_unit = NULL, - feat_type = NULL, - enrichment_name = "PAGE_z_score", - title = NULL, - save_param = list(), - default_save_name = "cell_types_from_enrichment", - save_plot = NULL, - show_plot = NULL, - return_plot = NULL) { +plotCellTypesFromEnrichment <- function( + gobject = NULL, + spat_unit = NULL, + feat_type = NULL, + enrichment_name = "PAGE_z_score", + title = NULL, + save_param = list(), + default_save_name = "cell_types_from_enrichment", + save_plot = NULL, + show_plot = NULL, + return_plot = NULL) { # guard clauses handled at first step downstream # therefore, omitting here. id_and_types <- findCellTypesFromEnrichment( @@ -186,16 +188,17 @@ plotCellTypesFromEnrichment <- function(gobject = NULL, #' and will be determined by the maximum value of the z-score #' or p-value for a given cell or annotation. #' @export -pieCellTypesFromEnrichment <- function(gobject = NULL, - spat_unit = NULL, - feat_type = NULL, - enrichment_name = "PAGE_z_score", - title = NULL, - save_param = list(), - default_save_name = "cell_types_from_enrichment_pie", - save_plot = NULL, - show_plot = NULL, - return_plot = NULL) { +pieCellTypesFromEnrichment <- function( + gobject = NULL, + spat_unit = NULL, + feat_type = NULL, + enrichment_name = "PAGE_z_score", + title = NULL, + save_param = list(), + default_save_name = "cell_types_from_enrichment_pie", + save_plot = NULL, + show_plot = NULL, + return_plot = NULL) { # guard clauses handled one step downstream freq_table <- findCellTypesFromEnrichment( diff --git a/R/spatial_genes.R b/R/spatial_genes.R index 12dee31de..7e047b037 100644 --- a/R/spatial_genes.R +++ b/R/spatial_genes.R @@ -8,11 +8,12 @@ NULL #' @rdname spat_fisher_exact #' @keywords internal -.spat_fish_func <- function(feat, - bin_matrix, - spat_mat, - calc_hub = FALSE, - hub_min_int = 3) { +.spat_fish_func <- function( + feat, + bin_matrix, + spat_mat, + calc_hub = FALSE, + hub_min_int = 3) { feat_vector <- bin_matrix[rownames(bin_matrix) == feat, ] feat_vectorA <- feat_vector[names(feat_vector) %in% rownames(spat_mat)] @@ -75,11 +76,12 @@ NULL #' @describeIn spat_fisher_exact data.table implementation #' @keywords internal -.spat_fish_func_dt <- function(bin_matrix_DTm, - spat_netw_min, - calc_hub = FALSE, - hub_min_int = 3, - cores = NA) { +.spat_fish_func_dt <- function( + bin_matrix_DTm, + spat_netw_min, + calc_hub = FALSE, + hub_min_int = 3, + cores = NA) { # set number of cores automatically, but with limit of 10 cores <- determine_cores(cores) data.table::setDTthreads(threads = cores) @@ -174,11 +176,12 @@ NULL #' @rdname spat_odds_ratio #' @keywords internal -.spat_or_func <- function(feat, - bin_matrix, - spat_mat, - calc_hub = FALSE, - hub_min_int = 3) { +.spat_or_func <- function( + feat, + bin_matrix, + spat_mat, + calc_hub = FALSE, + hub_min_int = 3) { feat_vector <- bin_matrix[rownames(bin_matrix) == feat, ] feat_vectorA <- feat_vector[names(feat_vector) %in% rownames(spat_mat)] @@ -247,11 +250,12 @@ NULL #' @describeIn spat_odds_ratio data.table implementation #' @keywords internal -.spat_or_func_dt <- function(bin_matrix_DTm, - spat_netw_min, - calc_hub = FALSE, - hub_min_int = 3, - cores = NA) { +.spat_or_func_dt <- function( + bin_matrix_DTm, + spat_netw_min, + calc_hub = FALSE, + hub_min_int = 3, + cores = NA) { # set number of cores automatically, but with limit of 10 cores <- determine_cores(cores) data.table::setDTthreads(threads = cores) @@ -357,10 +361,11 @@ NULL #' @describeIn calculate_spatial_enrichment calculate using a 'simple' and #' efficient for loop #' @keywords internal -.calc_spatial_enrichment_minimum <- function(spatial_network, - bin_matrix, - adjust_method = "fdr", - do_fisher_test = TRUE) { +.calc_spatial_enrichment_minimum <- function( + spatial_network, + bin_matrix, + adjust_method = "fdr", + do_fisher_test = TRUE) { # data.table variables from <- to <- feats <- variable <- value <- p.value <- adj.p.value <- score <- estimate <- NULL @@ -450,15 +455,16 @@ NULL #' @describeIn calculate_spatial_enrichment calculate using 'matrix' #' implementation #' @keywords internal -.calc_spatial_enrichment_matrix <- function(spatial_network, - bin_matrix, - adjust_method = "fdr", - do_fisher_test = TRUE, - do_parallel = TRUE, - cores = NA, - calc_hub = FALSE, - hub_min_int = 3, - verbose = TRUE) { +.calc_spatial_enrichment_matrix <- function( + spatial_network, + bin_matrix, + adjust_method = "fdr", + do_fisher_test = TRUE, + do_parallel = TRUE, + cores = NA, + calc_hub = FALSE, + hub_min_int = 3, + verbose = TRUE) { # data.table variables verbose <- feats <- p.value <- estimate <- adj.p.value <- score <- NULL @@ -542,15 +548,14 @@ NULL #' @describeIn calculate_spatial_enrichment calculate using 'data.table' #' implementation #' @keywords internal -.calc_spatial_enrichment_dt <- function( - bin_matrix, - spatial_network, - calc_hub = FALSE, - hub_min_int = 3, - group_size = "automatic", - do_fisher_test = TRUE, - adjust_method = "fdr", - cores = NA) { +.calc_spatial_enrichment_dt <- function(bin_matrix, + spatial_network, + calc_hub = FALSE, + hub_min_int = 3, + group_size = "automatic", + do_fisher_test = TRUE, + adjust_method = "fdr", + cores = NA) { # set number of cores automatically, but with limit of 10 cores <- determine_cores(cores) data.table::setDTthreads(threads = cores) @@ -757,39 +762,38 @@ NULL #' @rdname binSpect #' @export -binSpect <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - bin_method = c("kmeans", "rank"), - expression_values = c("normalized", "scaled", "custom"), - subset_feats = NULL, - spatial_network_name = "Delaunay_network", - spatial_network_k = NULL, - reduce_network = FALSE, - kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), - nstart = 3, - iter_max = 10, - extreme_nr = 50, - sample_nr = 50, - percentage_rank = 30, - do_fisher_test = TRUE, - adjust_method = "fdr", - calc_hub = FALSE, - hub_min_int = 3, - get_av_expr = TRUE, - get_high_expr = TRUE, - implementation = c("data.table", "simple", "matrix"), - group_size = "automatic", - do_parallel = TRUE, - cores = NA, - verbose = TRUE, - knn_params = NULL, - set.seed = deprecated(), - seed = 1234, - bin_matrix = NULL, - summarize = c("p.value", "adj.p.value"), - return_gobject = FALSE) { +binSpect <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + bin_method = c("kmeans", "rank"), + expression_values = c("normalized", "scaled", "custom"), + subset_feats = NULL, + spatial_network_name = "Delaunay_network", + spatial_network_k = NULL, + reduce_network = FALSE, + kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), + nstart = 3, + iter_max = 10, + extreme_nr = 50, + sample_nr = 50, + percentage_rank = 30, + do_fisher_test = TRUE, + adjust_method = "fdr", + calc_hub = FALSE, + hub_min_int = 3, + get_av_expr = TRUE, + get_high_expr = TRUE, + implementation = c("data.table", "simple", "matrix"), + group_size = "automatic", + do_parallel = TRUE, + cores = NA, + verbose = TRUE, + knn_params = NULL, + set.seed = deprecated(), + seed = 1234, + bin_matrix = NULL, + summarize = c("p.value", "adj.p.value"), + return_gobject = FALSE) { # TODO align set.seed, set_seed, seed_number naming and usage across # packages # use only param seed. If NULL, set no seed. If !NULL set value as seed @@ -858,30 +862,31 @@ binSpect <- function( #' @param expression_matrix expression matrix #' @param spatial_network spatial network in data.table format #' @export -binSpectSingleMatrix <- function(expression_matrix, - spatial_network = NULL, - bin_matrix = NULL, - bin_method = c("kmeans", "rank"), - subset_feats = NULL, - kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), - nstart = 3, - iter_max = 10, - extreme_nr = 50, - sample_nr = 50, - percentage_rank = 30, - do_fisher_test = TRUE, - adjust_method = "fdr", - calc_hub = FALSE, - hub_min_int = 3, - get_av_expr = TRUE, - get_high_expr = TRUE, - implementation = c("data.table", "simple", "matrix"), - group_size = "automatic", - do_parallel = TRUE, - cores = NA, - verbose = FALSE, - set.seed = deprecated(), - seed = 1234) { +binSpectSingleMatrix <- function( + expression_matrix, + spatial_network = NULL, + bin_matrix = NULL, + bin_method = c("kmeans", "rank"), + subset_feats = NULL, + kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), + nstart = 3, + iter_max = 10, + extreme_nr = 50, + sample_nr = 50, + percentage_rank = 30, + do_fisher_test = TRUE, + adjust_method = "fdr", + calc_hub = FALSE, + hub_min_int = 3, + get_av_expr = TRUE, + get_high_expr = TRUE, + implementation = c("data.table", "simple", "matrix"), + group_size = "automatic", + do_parallel = TRUE, + cores = NA, + verbose = FALSE, + set.seed = deprecated(), + seed = 1234) { if (is_present(set.seed) && !is.function(set.seed)) { deprecate_warn( when = "4.0.3", @@ -1068,34 +1073,35 @@ binSpectSingleMatrix <- function(expression_matrix, #' @describeIn binSpect binSpect for a single spatial network #' @export -binSpectSingle <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - bin_method = c("kmeans", "rank"), - expression_values = c("normalized", "scaled", "custom"), - subset_feats = NULL, - spatial_network_name = "Delaunay_network", - reduce_network = FALSE, - kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), - nstart = 3, - iter_max = 10, - extreme_nr = 50, - sample_nr = 50, - percentage_rank = 30, - do_fisher_test = TRUE, - adjust_method = "fdr", - calc_hub = FALSE, - hub_min_int = 3, - get_av_expr = TRUE, - get_high_expr = TRUE, - implementation = c("data.table", "simple", "matrix"), - group_size = "automatic", - do_parallel = TRUE, - cores = NA, - verbose = TRUE, - set.seed = deprecated(), - seed = 1234, - bin_matrix = NULL) { +binSpectSingle <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + bin_method = c("kmeans", "rank"), + expression_values = c("normalized", "scaled", "custom"), + subset_feats = NULL, + spatial_network_name = "Delaunay_network", + reduce_network = FALSE, + kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), + nstart = 3, + iter_max = 10, + extreme_nr = 50, + sample_nr = 50, + percentage_rank = 30, + do_fisher_test = TRUE, + adjust_method = "fdr", + calc_hub = FALSE, + hub_min_int = 3, + get_av_expr = TRUE, + get_high_expr = TRUE, + implementation = c("data.table", "simple", "matrix"), + group_size = "automatic", + do_parallel = TRUE, + cores = NA, + verbose = TRUE, + set.seed = deprecated(), + seed = 1234, + bin_matrix = NULL) { ## deprecated arguments if (is_present(set.seed) && !is.function(set.seed)) { @@ -1190,35 +1196,36 @@ binSpectSingle <- function(gobject, #' @describeIn binSpect binSpect for multiple spatial kNN networks #' @export -binSpectMulti <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - bin_method = c("kmeans", "rank"), - expression_values = c("normalized", "scaled", "custom"), - subset_feats = NULL, - spatial_network_k = c(5, 10, 20), - reduce_network = FALSE, - kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), - nstart = 3, - iter_max = 10, - extreme_nr = 50, - sample_nr = 50, - percentage_rank = c(10, 30), - do_fisher_test = TRUE, - adjust_method = "fdr", - calc_hub = FALSE, - hub_min_int = 3, - get_av_expr = TRUE, - get_high_expr = TRUE, - implementation = c("data.table", "simple", "matrix"), - group_size = "automatic", - do_parallel = TRUE, - cores = NA, - verbose = TRUE, - knn_params = NULL, - set.seed = deprecated(), - seed = 1234, - summarize = c("adj.p.value", "p.value")) { +binSpectMulti <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + bin_method = c("kmeans", "rank"), + expression_values = c("normalized", "scaled", "custom"), + subset_feats = NULL, + spatial_network_k = c(5, 10, 20), + reduce_network = FALSE, + kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), + nstart = 3, + iter_max = 10, + extreme_nr = 50, + sample_nr = 50, + percentage_rank = c(10, 30), + do_fisher_test = TRUE, + adjust_method = "fdr", + calc_hub = FALSE, + hub_min_int = 3, + get_av_expr = TRUE, + get_high_expr = TRUE, + implementation = c("data.table", "simple", "matrix"), + group_size = "automatic", + do_parallel = TRUE, + cores = NA, + verbose = TRUE, + knn_params = NULL, + set.seed = deprecated(), + seed = 1234, + summarize = c("adj.p.value", "p.value")) { ## deprecated arguments if (is_present(set.seed) && !is.function(set.seed)) { deprecate_warn( @@ -1448,31 +1455,32 @@ binSpectMulti <- function(gobject, #' is set. #' @param summarize summarize the p-values or adjusted p-values #' @returns data.table with results -binSpectMultiMatrix <- function(expression_matrix, - spatial_networks, - bin_method = c("kmeans", "rank"), - subset_feats = NULL, - kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), - nstart = 3, - iter_max = 10, - extreme_nr = 50, - sample_nr = 50, - percentage_rank = c(10, 30), - do_fisher_test = TRUE, - adjust_method = "fdr", - calc_hub = FALSE, - hub_min_int = 3, - get_av_expr = TRUE, - get_high_expr = TRUE, - implementation = c("data.table", "simple", "matrix"), - group_size = "automatic", - do_parallel = TRUE, - cores = NA, - verbose = TRUE, - knn_params = NULL, - set.seed = deprecated(), - seed = 1234, - summarize = c("adj.p.value", "p.value")) { +binSpectMultiMatrix <- function( + expression_matrix, + spatial_networks, + bin_method = c("kmeans", "rank"), + subset_feats = NULL, + kmeans_algo = c("kmeans", "kmeans_arma", "kmeans_arma_subset"), + nstart = 3, + iter_max = 10, + extreme_nr = 50, + sample_nr = 50, + percentage_rank = c(10, 30), + do_fisher_test = TRUE, + adjust_method = "fdr", + calc_hub = FALSE, + hub_min_int = 3, + get_av_expr = TRUE, + get_high_expr = TRUE, + implementation = c("data.table", "simple", "matrix"), + group_size = "automatic", + do_parallel = TRUE, + cores = NA, + verbose = TRUE, + knn_params = NULL, + set.seed = deprecated(), + seed = 1234, + summarize = c("adj.p.value", "p.value")) { if (is_present(set.seed) && !is.function(set.seed)) { deprecate_warn( when = "4.0.3", @@ -1639,13 +1647,14 @@ binSpectMultiMatrix <- function(expression_matrix, #' #' silhouetteRank(g) #' @export -silhouetteRank <- function(gobject, - expression_values = c("normalized", "scaled", "custom"), - metric = "euclidean", - subset_genes = NULL, - rbp_p = 0.95, - examine_top = 0.3, - python_path = NULL) { +silhouetteRank <- function( + gobject, + expression_values = c("normalized", "scaled", "custom"), + metric = "euclidean", + subset_genes = NULL, + rbp_p = 0.95, + examine_top = 0.3, + python_path = NULL) { # expression values values <- match.arg(expression_values, c("normalized", "scaled", "custom")) expr_values <- getExpression( @@ -1732,18 +1741,19 @@ silhouetteRank <- function(gobject, #' #' silhouetteRankTest(g) #' @export -silhouetteRankTest <- function(gobject, - expression_values = c("normalized", "scaled", "custom"), - subset_genes = NULL, - overwrite_input_bin = TRUE, - rbp_ps = c(0.95, 0.99), - examine_tops = c(0.005, 0.010, 0.050, 0.100, 0.300), - matrix_type = "dissim", - num_core = 4, - parallel_path = "/usr/bin", - output = NULL, - query_sizes = 10L, - verbose = FALSE) { +silhouetteRankTest <- function( + gobject, + expression_values = c("normalized", "scaled", "custom"), + subset_genes = NULL, + overwrite_input_bin = TRUE, + rbp_ps = c(0.95, 0.99), + examine_tops = c(0.005, 0.010, 0.050, 0.100, 0.300), + matrix_type = "dissim", + num_core = 4, + parallel_path = "/usr/bin", + output = NULL, + query_sizes = 10L, + verbose = FALSE) { # data.table variables cell_ID <- sdimx <- sdimy <- sdimz <- NULL @@ -1933,21 +1943,22 @@ silhouetteRankTest <- function(gobject, #' #' spatialDE(g) #' @export -spatialDE <- function(gobject = NULL, - feat_type = NULL, - spat_unit = NULL, - spat_loc_name = "raw", - expression_values = c("raw", "normalized", "scaled", "custom"), - size = c(4, 2, 1), - color = c("blue", "green", "red"), - sig_alpha = 0.5, - unsig_alpha = 0.5, - python_path = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "SpatialDE") { +spatialDE <- function( + gobject = NULL, + feat_type = NULL, + spat_unit = NULL, + spat_loc_name = "raw", + expression_values = c("raw", "normalized", "scaled", "custom"), + size = c(4, 2, 1), + color = c("blue", "green", "red"), + sig_alpha = 0.5, + unsig_alpha = 0.5, + python_path = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "SpatialDE") { # test if SPARK is installed ## module_test <- reticulate::py_module_available("SpatialDE") @@ -2124,17 +2135,18 @@ spatialDE <- function(gobject = NULL, #' #' spatialAEH(g) #' @export -spatialAEH <- function(gobject = NULL, - feat_type = NULL, - spat_unit = NULL, - spat_loc_name = "raw", - SpatialDE_results = NULL, - name_pattern = "AEH_patterns", - expression_values = c("raw", "normalized", "scaled", "custom"), - pattern_num = 6, - l = 1.05, - python_path = NULL, - return_gobject = TRUE) { +spatialAEH <- function( + gobject = NULL, + feat_type = NULL, + spat_unit = NULL, + spat_loc_name = "raw", + SpatialDE_results = NULL, + name_pattern = "AEH_patterns", + expression_values = c("raw", "normalized", "scaled", "custom"), + pattern_num = 6, + l = 1.05, + python_path = NULL, + return_gobject = TRUE) { # data.table variables cell_ID <- NULL @@ -2229,12 +2241,13 @@ spatialAEH <- function(gobject = NULL, #' @param unsig_alpha transparency of unsignificant genes #' @returns ggplot object #' @keywords internal -FSV_show <- function(results, - ms_results = NULL, - size = c(4, 2, 1), - color = c("blue", "green", "red"), - sig_alpha = 0.5, - unsig_alpha = 0.5) { +FSV_show <- function( + results, + ms_results = NULL, + size = c(4, 2, 1), + color = c("blue", "green", "red"), + sig_alpha = 0.5, + unsig_alpha = 0.5) { results$FSV95conf <- 2 * sqrt(results$s2_FSV) results$intervals <- cut( results$FSV95conf, c(0, 1e-1, 1e0, Inf), @@ -2319,15 +2332,16 @@ FSV_show <- function(results, #' #' trendSceek(g) #' @export -trendSceek <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - spat_loc_name = "raw", - expression_values = c("normalized", "raw"), - subset_genes = NULL, - nrand = 100, - ncores = 8, - ...) { +trendSceek <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + spat_loc_name = "raw", + expression_values = c("normalized", "raw"), + subset_genes = NULL, + nrand = 100, + ncores = 8, + ...) { # verify if optional package is installed package_check( pkg_name = "trendsceek", @@ -2442,17 +2456,18 @@ trendSceek <- function(gobject, #' #' spark(g) #' @export -spark <- function(gobject, - spat_loc_name = "raw", - feat_type = NULL, - spat_unit = NULL, - percentage = 0.1, - min_count = 10, - expression_values = "raw", - num_core = 5, - covariates = NULL, - return_object = c("data.table", "spark"), - ...) { +spark <- function( + gobject, + spat_loc_name = "raw", + feat_type = NULL, + spat_unit = NULL, + percentage = 0.1, + min_count = 10, + expression_values = "raw", + num_core = 5, + covariates = NULL, + return_object = c("data.table", "spark"), + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2594,14 +2609,15 @@ spark <- function(gobject, #' select PCs based on a z-score threshold #' } #' @export -detectSpatialPatterns <- function(gobject, - expression_values = c("normalized", "scaled", "custom"), - spatial_grid_name = "spatial_grid", - min_cells_per_grid = 4, - scale_unit = FALSE, - ncp = 100, - show_plot = TRUE, - PC_zscore = 1.5) { +detectSpatialPatterns <- function( + gobject, + expression_values = c("normalized", "scaled", "custom"), + spatial_grid_name = "spatial_grid", + min_cells_per_grid = 4, + scale_unit = FALSE, + ncp = 100, + show_plot = TRUE, + PC_zscore = 1.5) { ############################################################################ stop(wrap_txt( "This function has not been updated for use with the current version @@ -2769,19 +2785,20 @@ detectSpatialPatterns <- function(gobject, #' change save_name in save_param #' @returns ggplot #' @export -showPattern2D <- function(gobject, - spatPatObj, - dimension = 1, - trim = c(0.02, 0.98), - background_color = "white", - grid_border_color = "grey", - show_legend = TRUE, - point_size = 1, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "showPattern2D") { +showPattern2D <- function( + gobject, + spatPatObj, + dimension = 1, + trim = c(0.02, 0.98), + background_color = "white", + grid_border_color = "grey", + show_legend = TRUE, + point_size = 1, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "showPattern2D") { if (!"spatPatObj" %in% class(spatPatObj)) { stop("spatPatObj needs to be the output from detectSpatialPatterns") } @@ -2888,24 +2905,25 @@ showPattern <- function(gobject, spatPatObj, ...) { #' change save_name in save_param #' @returns plotly #' @export -showPattern3D <- function(gobject, - spatPatObj, - dimension = 1, - trim = c(0.02, 0.98), - background_color = "white", - grid_border_color = "grey", - show_legend = TRUE, - point_size = 1, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "showPattern3D") { +showPattern3D <- function( + gobject, + spatPatObj, + dimension = 1, + trim = c(0.02, 0.98), + background_color = "white", + grid_border_color = "grey", + show_legend = TRUE, + point_size = 1, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "showPattern3D") { package_check("plotly", repository = "CRAN:plotly") # data.table variables @@ -2959,7 +2977,7 @@ showPattern3D <- function(gobject, dpl <- plotly::plot_ly( type = "scatter3d", - x = annotated_grid$center_x, + x = annotated_grid$center_x, y = annotated_grid$center_y, z = annotated_grid$center_z, color = annotated_grid[[selected_PC]], marker = list(size = point_size), mode = "markers", colors = c("darkblue", "white", "darkred") @@ -3015,18 +3033,19 @@ showPattern3D <- function(gobject, #' change save_name in save_param #' @returns ggplot #' @export -showPatternGenes <- function(gobject, - spatPatObj, - dimension = 1, - top_pos_genes = 5, - top_neg_genes = 5, - point_size = 1, - return_DT = FALSE, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "showPatternGenes") { +showPatternGenes <- function( + gobject, + spatPatObj, + dimension = 1, + top_pos_genes = 5, + top_neg_genes = 5, + point_size = 1, + return_DT = FALSE, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "showPatternGenes") { # data.table variables gene_ID <- NULL @@ -3099,13 +3118,14 @@ showPatternGenes <- function(gobject, #' @returns Data.table with genes associated with selected dimension (PC). #' @details Description. #' @export -selectPatternGenes <- function(spatPatObj, - dimensions = 1:5, - top_pos_genes = 10, - top_neg_genes = 10, - min_pos_cor = 0.5, - min_neg_cor = -0.5, - return_top_selection = FALSE) { +selectPatternGenes <- function( + spatPatObj, + dimensions = 1:5, + top_pos_genes = 10, + top_neg_genes = 10, + min_pos_cor = 0.5, + min_neg_cor = -0.5, + return_top_selection = FALSE) { if (!"spatPatObj" %in% class(spatPatObj)) { stop("spatPatObj needs to be the output from detectSpatialPatterns") } @@ -3187,10 +3207,11 @@ selectPatternGenes <- function(spatPatObj, #' number of k-neighbors in the selected spatial network. Setting b = 0 means #' no smoothing and b = 1 means no contribution from its own expression. #' @keywords internal -do_spatial_knn_smoothing <- function(expression_matrix, - spatial_network, - subset_feats = NULL, - b = NULL) { +do_spatial_knn_smoothing <- function( + expression_matrix, + spatial_network, + subset_feats = NULL, + b = NULL) { # checks if (!is.null(b)) { if (b > 1 | b < 0) { @@ -3310,11 +3331,12 @@ evaluate_provided_spatial_locations <- function(spatial_locs) { #' @description smooth gene expression over a defined spatial grid #' @returns matrix with smoothened gene expression values based on spatial grid #' @keywords internal -do_spatial_grid_averaging <- function(expression_matrix, - spatial_grid, - spatial_locs, - subset_feats = NULL, - min_cells_per_grid = 4) { +do_spatial_grid_averaging <- function( + expression_matrix, + spatial_grid, + spatial_locs, + subset_feats = NULL, + min_cells_per_grid = 4) { # matrix expr_values <- expression_matrix if (!is.null(subset_feats)) { @@ -3432,19 +3454,18 @@ NULL #' @rdname detectSpatialCorFeats #' @export -detectSpatialCorFeats <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - method = c("grid", "network"), - expression_values = c("normalized", "scaled", "custom"), - subset_feats = NULL, - spatial_network_name = "Delaunay_network", - network_smoothing = NULL, - spatial_grid_name = "spatial_grid", - min_cells_per_grid = 4, - cor_method = c("pearson", "kendall", "spearman")) { +detectSpatialCorFeats <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + method = c("grid", "network"), + expression_values = c("normalized", "scaled", "custom"), + subset_feats = NULL, + spatial_network_name = "Delaunay_network", + network_smoothing = NULL, + spatial_grid_name = "spatial_grid", + min_cells_per_grid = 4, + cor_method = c("pearson", "kendall", "spearman")) { # set default spat_unit and feat_type spat_unit <- set_default_spat_unit( gobject = gobject, @@ -3608,15 +3629,16 @@ detectSpatialCorFeats <- function( #' @rdname detectSpatialCorFeats #' @export -detectSpatialCorFeatsMatrix <- function(expression_matrix, - method = c("grid", "network"), - spatial_network, - spatial_grid, - spatial_locs, - subset_feats = NULL, - network_smoothing = NULL, - min_cells_per_grid = 4, - cor_method = c("pearson", "kendall", "spearman")) { +detectSpatialCorFeatsMatrix <- function( + expression_matrix, + method = c("grid", "network"), + spatial_network, + spatial_grid, + spatial_locs, + subset_feats = NULL, + network_smoothing = NULL, + min_cells_per_grid = 4, + cor_method = c("pearson", "kendall", "spearman")) { ## correlation method to be used cor_method <- match.arg( cor_method, @@ -3748,15 +3770,16 @@ detectSpatialCorFeatsMatrix <- function(expression_matrix, #' @param show_top_feats show top features per gene #' @returns data.table with filtered information #' @export -showSpatialCorFeats <- function(spatCorObject, - use_clus_name = NULL, - selected_clusters = NULL, - feats = NULL, - min_spat_cor = 0.5, - min_expr_cor = NULL, - min_cor_diff = NULL, - min_rank_diff = NULL, - show_top_feats = NULL) { +showSpatialCorFeats <- function( + spatCorObject, + use_clus_name = NULL, + selected_clusters = NULL, + feats = NULL, + min_spat_cor = 0.5, + min_expr_cor = NULL, + min_cor_diff = NULL, + min_rank_diff = NULL, + show_top_feats = NULL) { # data.table variables clus <- feat_ID <- spat_cor <- cor_diff <- rankdiff <- NULL @@ -3839,15 +3862,16 @@ showSpatialCorFeats <- function(spatCorObject, #' @param show_top_genes show top genes per gene #' @returns data.table with filtered information #' @export -showSpatialCorGenes <- function(spatCorObject, - use_clus_name = NULL, - selected_clusters = NULL, - genes = NULL, - min_spat_cor = 0.5, - min_expr_cor = NULL, - min_cor_diff = NULL, - min_rank_diff = NULL, - show_top_genes = NULL) { +showSpatialCorGenes <- function( + spatCorObject, + use_clus_name = NULL, + selected_clusters = NULL, + genes = NULL, + min_spat_cor = 0.5, + min_expr_cor = NULL, + min_cor_diff = NULL, + min_rank_diff = NULL, + show_top_genes = NULL) { warning("Deprecated and replaced by showSpatialCorFeats") showSpatialCorFeats( @@ -3886,11 +3910,12 @@ showSpatialCorGenes <- function(spatCorObject, #' method = "network" #' )) #' @export -clusterSpatialCorFeats <- function(spatCorObject, - name = "spat_clus", - hclust_method = "ward.D", - k = 10, - return_obj = TRUE) { +clusterSpatialCorFeats <- function( + spatCorObject, + name = "spat_clus", + hclust_method = "ward.D", + k = 10, + return_obj = TRUE) { # check input if (!"spatCorObject" %in% class(spatCorObject)) { stop("spatCorObject needs to be the output from @@ -3938,11 +3963,12 @@ clusterSpatialCorFeats <- function(spatCorObject, #' @param return_obj return spatial correlation object (spatCorObject) #' @returns spatCorObject or cluster results #' @export -clusterSpatialCorGenes <- function(spatCorObject, - name = "spat_clus", - hclust_method = "ward.D", - k = 10, - return_obj = TRUE) { +clusterSpatialCorGenes <- function( + spatCorObject, + name = "spat_clus", + hclust_method = "ward.D", + k = 10, + return_obj = TRUE) { warning("Deprecated and replaced by clusterSpatialCorFeats") clusterSpatialCorFeats( @@ -3981,20 +4007,21 @@ clusterSpatialCorGenes <- function(spatCorObject, #' \code{\link[ComplexHeatmap]{Heatmap}} function from ComplexHeatmap #' @returns Heatmap generated by ComplexHeatmap #' @export -heatmSpatialCorFeats <- function(gobject, - spatCorObject, - use_clus_name = NULL, - show_cluster_annot = TRUE, - show_row_dend = TRUE, - show_column_dend = FALSE, - show_row_names = FALSE, - show_column_names = FALSE, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "heatmSpatialCorFeats", - ...) { +heatmSpatialCorFeats <- function( + gobject, + spatCorObject, + use_clus_name = NULL, + show_cluster_annot = TRUE, + show_row_dend = TRUE, + show_column_dend = FALSE, + show_row_names = FALSE, + show_column_names = FALSE, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "heatmSpatialCorFeats", + ...) { ## check input if (!"spatCorObject" %in% class(spatCorObject)) { stop("spatCorObject needs to be the output from @@ -4110,14 +4137,15 @@ heatmSpatialCorFeats <- function(gobject, #' ) #' @md #' @export -rankSpatialCorGroups <- function(gobject, - spatCorObject, - use_clus_name = NULL, - show_plot = NULL, - return_plot = FALSE, - save_plot = NULL, - save_param = list(), - default_save_name = "rankSpatialCorGroups") { +rankSpatialCorGroups <- function( + gobject, + spatCorObject, + use_clus_name = NULL, + show_plot = NULL, + return_plot = FALSE, + save_plot = NULL, + save_param = list(), + default_save_name = "rankSpatialCorGroups") { ## check input if (!"spatCorObject" %in% class(spatCorObject)) { stop("spatCorObject needs to be the output from @@ -4236,12 +4264,13 @@ rankSpatialCorGroups <- function(gobject, #' #' @md #' @export -getBalancedSpatCoexpressionFeats <- function(spatCorObject, - maximum = 50, - rank = c("weighted", "random", "informed"), - informed_ranking = NULL, - seed = NA, - verbose = TRUE) { +getBalancedSpatCoexpressionFeats <- function( + spatCorObject, + maximum = 50, + rank = c("weighted", "random", "informed"), + informed_ranking = NULL, + seed = NA, + verbose = TRUE) { # data.table vars feat_ID <- variable <- combo <- spat_cor <- rnk <- feat_id <- V1 <- NULL @@ -4449,15 +4478,16 @@ getBalancedSpatCoexpressionFeats <- function(spatCorObject, #' gene_name = "Gna12" #' ) #' @export -simulateOneGenePatternGiottoObject <- function(gobject, - pattern_name = "pattern", - pattern_cell_ids = NULL, - gene_name = NULL, - spatial_prob = 0.95, - gradient_direction = NULL, - show_pattern = TRUE, - pattern_colors = c("in" = "green", "out" = "red"), - normalization_params = list()) { +simulateOneGenePatternGiottoObject <- function( + gobject, + pattern_name = "pattern", + pattern_cell_ids = NULL, + gene_name = NULL, + spatial_prob = 0.95, + gradient_direction = NULL, + show_pattern = TRUE, + pattern_colors = c("in" = "green", "out" = "red"), + normalization_params = list()) { # data.table variables cell_ID <- sdimx_y <- sdimx <- sdimy <- NULL @@ -4643,29 +4673,30 @@ simulateOneGenePatternGiottoObject <- function(gobject, #' @description runs all spatial tests for 1 probability and 1 rep #' @returns data.table #' @keywords internal -run_spatial_sim_tests_one_rep <- function(gobject, - pattern_name = "pattern", - pattern_cell_ids = NULL, - gene_name = NULL, - spatial_prob = 0.95, - show_pattern = FALSE, - spatial_network_name = "kNN_network", - spat_methods = c( - "binSpect_single", "binSpect_multi", "spatialDE", - "spark", "silhouetteRank" - ), - spat_methods_params = list(NA, NA, NA, NA, NA), - spat_methods_names = c( - "binSpect_single", "binSpect_multi", "spatialDE", - "spark", "silhouetteRank" - ), - save_plot = FALSE, - save_raw = FALSE, - save_norm = FALSE, - save_dir = "~", - save_name = "plot", - run_simulations = TRUE, - ...) { +run_spatial_sim_tests_one_rep <- function( + gobject, + pattern_name = "pattern", + pattern_cell_ids = NULL, + gene_name = NULL, + spatial_prob = 0.95, + show_pattern = FALSE, + spatial_network_name = "kNN_network", + spat_methods = c( + "binSpect_single", "binSpect_multi", "spatialDE", + "spark", "silhouetteRank" + ), + spat_methods_params = list(NA, NA, NA, NA, NA), + spat_methods_names = c( + "binSpect_single", "binSpect_multi", "spatialDE", + "spark", "silhouetteRank" + ), + save_plot = FALSE, + save_raw = FALSE, + save_norm = FALSE, + save_dir = "~", + save_name = "plot", + run_simulations = TRUE, + ...) { # data.table variables genes <- prob <- time <- adj.p.value <- method <- p.val <- sd <- qval <- pval <- g <- adjusted_pvalue <- feats <- NULL @@ -4979,29 +5010,30 @@ run_spatial_sim_tests_one_rep <- function(gobject, #' repetitions #' @returns data.table #' @keywords internal -run_spatial_sim_tests_multi <- function(gobject, - pattern_name = "pattern", - pattern_cell_ids = NULL, - gene_name = NULL, - spatial_probs = c(0.5, 1), - reps = 2, - spatial_network_name = "kNN_network", - spat_methods = c( - "binSpect_single", "binSpect_multi", "spatialDE", - "spark", "silhouetteRank" - ), - spat_methods_params = list(NA, NA, NA, NA, NA), - spat_methods_names = c( - "binSpect_single", "binSpect_multi", "spatialDE", - "spark", "silhouetteRank" - ), - save_plot = FALSE, - save_raw = FALSE, - save_norm = FALSE, - save_dir = "~", - verbose = TRUE, - run_simulations = TRUE, - ...) { +run_spatial_sim_tests_multi <- function( + gobject, + pattern_name = "pattern", + pattern_cell_ids = NULL, + gene_name = NULL, + spatial_probs = c(0.5, 1), + reps = 2, + spatial_network_name = "kNN_network", + spat_methods = c( + "binSpect_single", "binSpect_multi", "spatialDE", + "spark", "silhouetteRank" + ), + spat_methods_params = list(NA, NA, NA, NA, NA), + spat_methods_names = c( + "binSpect_single", "binSpect_multi", "spatialDE", + "spark", "silhouetteRank" + ), + save_plot = FALSE, + save_raw = FALSE, + save_norm = FALSE, + save_dir = "~", + verbose = TRUE, + run_simulations = TRUE, + ...) { prob_list <- list() for (prob_ind in seq_along(spatial_probs)) { prob_i <- spatial_probs[prob_ind] @@ -5095,37 +5127,38 @@ run_spatial_sim_tests_multi <- function(gobject, #' "AAAGGGATGTAGCAAG-1", #' "TCAAACAACCGCGTCG-1", "ACGATCATACATAGAG-1", "TATGCTCCCTACTTAC-1" #' ), -#' spatial_network_name = "spatial_network", +#' spatial_network_name = "spatial_network", #' gene_names = c("Gna12", "Ccnd2") #' ) #' @export -runPatternSimulation <- function(gobject, - pattern_name = "pattern", - pattern_colors = c("in" = "green", "out" = "red"), - pattern_cell_ids = NULL, - gene_names = NULL, - spatial_probs = c(0.5, 1), - reps = 2, - spatial_network_name = "kNN_network", - spat_methods = c( - "binSpect_single", "binSpect_multi", "spatialDE", - "spark", "silhouetteRank" - ), - spat_methods_params = list(NA, NA, NA, NA, NA), - spat_methods_names = c( - "binSpect_single", "binSpect_multi", "spatialDE", - "spark", "silhouetteRank" - ), - scalefactor = 6000, - save_plot = TRUE, - save_raw = TRUE, - save_norm = TRUE, - save_dir = "~", - max_col = 4, - height = 7, - width = 7, - run_simulations = TRUE, - ...) { +runPatternSimulation <- function( + gobject, + pattern_name = "pattern", + pattern_colors = c("in" = "green", "out" = "red"), + pattern_cell_ids = NULL, + gene_names = NULL, + spatial_probs = c(0.5, 1), + reps = 2, + spatial_network_name = "kNN_network", + spat_methods = c( + "binSpect_single", "binSpect_multi", "spatialDE", + "spark", "silhouetteRank" + ), + spat_methods_params = list(NA, NA, NA, NA, NA), + spat_methods_names = c( + "binSpect_single", "binSpect_multi", "spatialDE", + "spark", "silhouetteRank" + ), + scalefactor = 6000, + save_plot = TRUE, + save_raw = TRUE, + save_norm = TRUE, + save_dir = "~", + max_col = 4, + height = 7, + width = 7, + run_simulations = TRUE, + ...) { # data.table variables prob <- method <- adj.p.value <- time <- NULL diff --git a/R/spatial_interaction.R b/R/spatial_interaction.R index 765d0f56d..be5ef95be 100644 --- a/R/spatial_interaction.R +++ b/R/spatial_interaction.R @@ -5,15 +5,14 @@ #' @description Simulate random network. #' @returns data.table #' @keywords internal -make_simulated_network <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network_name = "Delaunay_network", - cluster_column, - number_of_simulations = 100, - set_seed = TRUE, - seed_number = 1234) { +make_simulated_network <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "Delaunay_network", + cluster_column, + number_of_simulations = 100, + set_seed = TRUE, + seed_number = 1234) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -127,20 +126,19 @@ make_simulated_network <- function( #' #' cellProximityEnrichment(g, cluster_column = "leiden_clus") #' @export -cellProximityEnrichment <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network_name = "Delaunay_network", - cluster_column, - number_of_simulations = 1000, - adjust_method = c( - "none", "fdr", "bonferroni", "BH", - "holm", "hochberg", "hommel", - "BY" - ), - set_seed = TRUE, - seed_number = 1234) { +cellProximityEnrichment <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "Delaunay_network", + cluster_column, + number_of_simulations = 1000, + adjust_method = c( + "none", "fdr", "bonferroni", "BH", + "holm", "hochberg", "hommel", + "BY" + ), + set_seed = TRUE, + seed_number = 1234) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -390,15 +388,14 @@ cellProximityEnrichment <- function( #' cell_interaction = "custom_leiden" #' ) #' @export -addCellIntMetadata <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network = "spatial_network", - cluster_column, - cell_interaction, - name = "select_int", - return_gobject = TRUE) { +addCellIntMetadata <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network = "spatial_network", + cluster_column, + cell_interaction, + name = "select_int", + return_gobject = TRUE) { # set spatial unit and feature type spat_unit <- set_default_spat_unit( gobject = gobject, @@ -503,13 +500,12 @@ NULL #' @describeIn cell_proximity_tests t.test #' @keywords internal -.do_ttest <- function( - expr_values, - select_ind, - other_ind, - adjust_method, - mean_method, - offset = 0.1) { +.do_ttest <- function(expr_values, + select_ind, + other_ind, + adjust_method, + mean_method, + offset = 0.1) { vmsg(.is_debug = TRUE, ".do_ttest") # data.table variables @@ -554,12 +550,11 @@ NULL #' @describeIn cell_proximity_tests limma t.test #' @keywords internal -.do_limmatest <- function( - expr_values, - select_ind, - other_ind, - mean_method, - offset = 0.1) { +.do_limmatest <- function(expr_values, + select_ind, + other_ind, + mean_method, + offset = 0.1) { vmsg(.is_debug = TRUE, ".do_limmatest") package_check("limma") @@ -636,13 +631,12 @@ NULL #' @describeIn cell_proximity_tests wilcoxon #' @keywords internal -.do_wilctest <- function( - expr_values, - select_ind, - other_ind, - adjust_method, - mean_method, - offset = 0.1) { +.do_wilctest <- function(expr_values, + select_ind, + other_ind, + adjust_method, + mean_method, + offset = 0.1) { vmsg(.is_debug = TRUE, ".do_wilctest") # data.table variables @@ -686,13 +680,12 @@ NULL # calculate original values -.do_permuttest_original <- function( - expr_values, - select_ind, - other_ind, - name = "orig", - mean_method, - offset = 0.1) { +.do_permuttest_original <- function(expr_values, + select_ind, + other_ind, + name = "orig", + mean_method, + offset = 0.1) { # data.table variables feats <- NULL @@ -718,15 +711,14 @@ NULL # calculate random values -.do_permuttest_random <- function( - expr_values, - select_ind, - other_ind, - name = "perm_1", - mean_method, - offset = 0.1, - set_seed = TRUE, - seed_number = 1234) { +.do_permuttest_random <- function(expr_values, + select_ind, + other_ind, + name = "perm_1", + mean_method, + offset = 0.1, + set_seed = TRUE, + seed_number = 1234) { # data.table variables feats <- NULL @@ -767,15 +759,14 @@ NULL # calculate multiple random values -.do_multi_permuttest_random <- function( - expr_values, - select_ind, - other_ind, - mean_method, - offset = 0.1, - n = 100, - set_seed = TRUE, - seed_number = 1234) { +.do_multi_permuttest_random <- function(expr_values, + select_ind, + other_ind, + mean_method, + offset = 0.1, + n = 100, + set_seed = TRUE, + seed_number = 1234) { if (set_seed == TRUE) { seed_number_list <- seed_number:(seed_number + (n - 1)) } @@ -801,15 +792,14 @@ NULL #' @describeIn cell_proximity_tests random permutation #' @keywords internal -.do_permuttest <- function( - expr_values, - select_ind, other_ind, - n_perm = 1000, - adjust_method = "fdr", - mean_method, - offset = 0.1, - set_seed = TRUE, - seed_number = 1234) { +.do_permuttest <- function(expr_values, + select_ind, other_ind, + n_perm = 1000, + adjust_method = "fdr", + mean_method, + offset = 0.1, + set_seed = TRUE, + seed_number = 1234) { # data.table variables log2fc_diff <- log2fc <- sel <- other <- feats <- p_higher <- p_lower <- perm_sel <- NULL @@ -889,20 +879,19 @@ NULL #' @returns differential test on subsets of a matrix #' @keywords internal #' @seealso [cell_proximity_tests] -.do_cell_proximity_test <- function( - expr_values, - select_ind, other_ind, - diff_test = c("permutation", "limma", "t.test", "wilcox"), - mean_method = c("arithmic", "geometric"), - offset = 0.1, - n_perm = 100, - adjust_method = c( - "bonferroni", "BH", "holm", "hochberg", "hommel", - "BY", "fdr", "none" - ), - set_seed = TRUE, - seed_number = 1234, - verbose = FALSE) { +.do_cell_proximity_test <- function(expr_values, + select_ind, other_ind, + diff_test = c("permutation", "limma", "t.test", "wilcox"), + mean_method = c("arithmic", "geometric"), + offset = 0.1, + n_perm = 100, + adjust_method = c( + "bonferroni", "BH", "holm", "hochberg", "hommel", + "BY", "fdr", "none" + ), + set_seed = TRUE, + seed_number = 1234, + verbose = FALSE) { # get parameters diff_test <- match.arg( diff_test, @@ -961,22 +950,21 @@ NULL #' @returns data.table #' @keywords internal #' @seealso [.do_cell_proximity_test()] for specific tests -.findCellProximityFeats_per_interaction <- function( - sel_int, - expr_values, - cell_metadata, - annot_spatnetwork, - cluster_column = NULL, - minimum_unique_cells = 1, - minimum_unique_int_cells = 1, - exclude_selected_cells_from_test = TRUE, - diff_test = c("permutation", "limma", "t.test", "wilcox"), - mean_method = c("arithmic", "geometric"), - offset = 0.1, - adjust_method = "bonferroni", - nr_permutations = 100, - set_seed = TRUE, - seed_number = 1234) { +.findCellProximityFeats_per_interaction <- function(sel_int, + expr_values, + cell_metadata, + annot_spatnetwork, + cluster_column = NULL, + minimum_unique_cells = 1, + minimum_unique_int_cells = 1, + exclude_selected_cells_from_test = TRUE, + diff_test = c("permutation", "limma", "t.test", "wilcox"), + mean_method = c("arithmic", "geometric"), + offset = 0.1, + adjust_method = "bonferroni", + nr_permutations = 100, + set_seed = TRUE, + seed_number = 1234) { # data.table variables unified_int <- to_cell_type <- from_cell_type <- cell_type <- int_cell_type <- NULL @@ -1220,28 +1208,27 @@ NULL #' nr_permutations = 10 #' ) #' @export -findInteractionChangedFeats <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = "normalized", - selected_feats = NULL, - cluster_column, - spatial_network_name = "Delaunay_network", - minimum_unique_cells = 1, - minimum_unique_int_cells = 1, - diff_test = c("permutation", "limma", "t.test", "wilcox"), - mean_method = c("arithmic", "geometric"), - offset = 0.1, - adjust_method = c( - "bonferroni", "BH", "holm", "hochberg", "hommel", - "BY", "fdr", "none" - ), - nr_permutations = 1000, - exclude_selected_cells_from_test = TRUE, - do_parallel = TRUE, - set_seed = TRUE, - seed_number = 1234) { +findInteractionChangedFeats <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = "normalized", + selected_feats = NULL, + cluster_column, + spatial_network_name = "Delaunay_network", + minimum_unique_cells = 1, + minimum_unique_int_cells = 1, + diff_test = c("permutation", "limma", "t.test", "wilcox"), + mean_method = c("arithmic", "geometric"), + offset = 0.1, + adjust_method = c( + "bonferroni", "BH", "holm", "hochberg", "hommel", + "BY", "fdr", "none" + ), + nr_permutations = 1000, + exclude_selected_cells_from_test = TRUE, + do_parallel = TRUE, + set_seed = TRUE, + seed_number = 1234) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1446,18 +1433,17 @@ print.icfObject <- function(x, ...) { #' force(icf_filter2) #' #' @export -filterInteractionChangedFeats <- function( - icfObject, - min_cells = 4, - min_cells_expr = 1, - min_int_cells = 4, - min_int_cells_expr = 1, - min_fdr = 0.1, - min_spat_diff = 0.2, - min_log2_fc = 0.2, - min_zscore = 2, - zscores_column = c("cell_type", "feats"), - direction = c("both", "up", "down")) { +filterInteractionChangedFeats <- function(icfObject, + min_cells = 4, + min_cells_expr = 1, + min_int_cells = 4, + min_int_cells_expr = 1, + min_fdr = 0.1, + min_spat_diff = 0.2, + min_log2_fc = 0.2, + min_zscore = 2, + zscores_column = c("cell_type", "feats"), + direction = c("both", "up", "down")) { # NSE vars nr_select <- int_nr_select <- zscores <- log2fc <- sel <- other <- p.adj <- NULL @@ -1535,17 +1521,16 @@ filterICF <- filterInteractionChangedFeats #' @description Combine ICF scores per interaction #' @returns data.table #' @keywords internal -.combineInteractionChangedFeatures_per_interaction <- function( - icfObject, - sel_int, - selected_feats = NULL, - specific_feats_1 = NULL, - specific_feats_2 = NULL, - min_cells = 5, - min_int_cells = 3, - min_fdr = 0.05, - min_spat_diff = 0, - min_log2_fc = 0.5) { +.combineInteractionChangedFeatures_per_interaction <- function(icfObject, + sel_int, + selected_feats = NULL, + specific_feats_1 = NULL, + specific_feats_2 = NULL, + min_cells = 5, + min_int_cells = 3, + min_fdr = 0.05, + min_spat_diff = 0, + min_log2_fc = 0.5) { # data.table variables unif_int <- feats <- cell_type <- p.adj <- nr_select <- int_nr_select <- log2fc <- sel <- NULL @@ -1935,19 +1920,18 @@ filterICF <- filterInteractionChangedFeats #' force(cicf) #' combineICF(g_icf) # this is a shortened alias #' @export -combineInteractionChangedFeats <- function( - icfObject, - selected_ints = NULL, - selected_feats = NULL, - specific_feats_1 = NULL, - specific_feats_2 = NULL, - min_cells = 5, - min_int_cells = 3, - min_fdr = 0.05, - min_spat_diff = 0, - min_log2_fc = 0.5, - do_parallel = TRUE, - verbose = TRUE) { +combineInteractionChangedFeats <- function(icfObject, + selected_ints = NULL, + selected_feats = NULL, + specific_feats_1 = NULL, + specific_feats_2 = NULL, + min_cells = 5, + min_int_cells = 3, + min_fdr = 0.05, + min_spat_diff = 0, + min_log2_fc = 0.5, + do_parallel = TRUE, + verbose = TRUE) { # NSE vars unif_int <- feat1_feat2 <- feats_1 <- feats_2 <- comb_logfc <- log2fc_1 <- log2fc_2 <- direction <- NULL @@ -2091,13 +2075,12 @@ print.combIcfObject <- function(x, ...) { #' @param feat_set_2 second specific feat set from feat pairs #' @returns data.table with average expression scores for each cluster #' @keywords internal -.average_feat_feat_expression_in_groups <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - cluster_column = "cell_types", - feat_set_1, - feat_set_2) { +.average_feat_feat_expression_in_groups <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + cluster_column = "cell_types", + feat_set_1, + feat_set_2) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2235,24 +2218,23 @@ print.combIcfObject <- function(x, ...) { #' #' force(res) #' @export -exprCellCellcom <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - cluster_column = "cell_types", - random_iter = 1000, - feat_set_1, - feat_set_2, - log2FC_addendum = 0.1, - detailed = FALSE, - adjust_method = c( - "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", - "BY", "none" - ), - adjust_target = c("feats", "cells"), - set_seed = TRUE, - seed_number = 1234, - verbose = TRUE) { +exprCellCellcom <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + cluster_column = "cell_types", + random_iter = 1000, + feat_set_1, + feat_set_2, + log2FC_addendum = 0.1, + detailed = FALSE, + adjust_method = c( + "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", + "BY", "none" + ), + adjust_target = c("feats", "cells"), + set_seed = TRUE, + seed_number = 1234, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2431,14 +2413,13 @@ exprCellCellcom <- function( #' @param seed_number seed number #' @returns list of randomly sampled cell ids with same cell type composition #' @keywords internal -.create_cell_type_random_cell_IDs <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - cluster_column = "cell_types", - needed_cell_types, - set_seed = FALSE, - seed_number = 1234) { +.create_cell_type_random_cell_IDs <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + cluster_column = "cell_types", + needed_cell_types, + set_seed = FALSE, + seed_number = 1234) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2565,30 +2546,29 @@ exprCellCellcom <- function( #' #' force(res2) #' @export -spatCellCellcom <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - spatial_network_name = "Delaunay_network", - cluster_column = NULL, - random_iter = 1000, - feat_set_1, - feat_set_2, - gene_set_1 = NULL, - gene_set_2 = NULL, - log2FC_addendum = 0.1, - min_observations = 2, - detailed = FALSE, - adjust_method = c( - "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", - "BY", "none" - ), - adjust_target = c("feats", "cells"), - do_parallel = TRUE, - cores = NA, - set_seed = TRUE, - seed_number = 1234, - verbose = c("a little", "a lot", "none")) { +spatCellCellcom <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + spatial_network_name = "Delaunay_network", + cluster_column = NULL, + random_iter = 1000, + feat_set_1, + feat_set_2, + gene_set_1 = NULL, + gene_set_2 = NULL, + log2FC_addendum = 0.1, + min_observations = 2, + detailed = FALSE, + adjust_method = c( + "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", + "BY", "none" + ), + adjust_target = c("feats", "cells"), + do_parallel = TRUE, + cores = NA, + set_seed = TRUE, + seed_number = 1234, + verbose = c("a little", "a lot", "none")) { verbose <- match.arg(verbose, choices = c("a little", "a lot", "none")) # Set feat_type and spat_unit @@ -2738,29 +2718,30 @@ spatCellCellcom <- function( #' @param cell_type_1 character. First cell type #' @param cell_type_2 character. Second cell type #' @export -specificCellCellcommunicationScores <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - spatial_network_name = "Delaunay_network", - cluster_column = NULL, - random_iter = 100, - cell_type_1 = NULL, - cell_type_2 = NULL, - feat_set_1, - feat_set_2, - gene_set_1 = NULL, - gene_set_2 = NULL, - log2FC_addendum = 0.1, - min_observations = 2, - detailed = FALSE, - adjust_method = c( - "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", - "BY", "none" - ), - adjust_target = c("feats", "cells"), - set_seed = FALSE, - seed_number = 1234, - verbose = TRUE) { +specificCellCellcommunicationScores <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + spatial_network_name = "Delaunay_network", + cluster_column = NULL, + random_iter = 100, + cell_type_1 = NULL, + cell_type_2 = NULL, + feat_set_1, + feat_set_2, + gene_set_1 = NULL, + gene_set_2 = NULL, + log2FC_addendum = 0.1, + min_observations = 2, + detailed = FALSE, + adjust_method = c( + "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", + "BY", "none" + ), + adjust_target = c("feats", "cells"), + set_seed = FALSE, + seed_number = 1234, + verbose = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -3048,15 +3029,14 @@ specificCellCellcommunicationScores <- function(gobject, #' combCC <- combCCcom(spatialCC = spatialCC, exprCC = exprCC) #' force(combCC) #' @export -combCCcom <- function( - spatialCC, - exprCC, - min_lig_nr = 3, - min_rec_nr = 3, - min_padj_value = 1, - min_log2fc = 0, - min_av_diff = 0, - detailed = FALSE) { +combCCcom <- function(spatialCC, + exprCC, + min_lig_nr = 3, + min_rec_nr = 3, + min_padj_value = 1, + min_log2fc = 0, + min_av_diff = 0, + detailed = FALSE) { # data.table variables lig_nr <- rec_nr <- p.adj <- log2fc <- av_diff <- NULL diff --git a/R/spatial_interaction_spot.R b/R/spatial_interaction_spot.R index edc3c92b7..4a95cd791 100644 --- a/R/spatial_interaction_spot.R +++ b/R/spatial_interaction_spot.R @@ -20,8 +20,9 @@ NULL #' value inner each spot #' @param cell_IDs cell_IDs #' @keywords internal -.cell_proximity_spots_internal <- function(cell_IDs, - dwls_values) { +.cell_proximity_spots_internal <- function( + cell_IDs, + dwls_values) { # data.table variables value <- unified_int <- Var1 <- Var2 <- internal <- NULL @@ -85,9 +86,8 @@ NULL #' value for interacted spots #' @param pairs data.table of paired spots. Format: cell_ID1, cell_ID2, N #' @keywords internal -.cell_proximity_spots_external <- function( - pairs, - dwls_values) { +.cell_proximity_spots_external <- function(pairs, + dwls_values) { cell_IDs <- unique(c(pairs$from, pairs$to)) pairs <- pairs[, .N, by = c("from", "to")] # add internal pairs to make full matrix @@ -141,9 +141,10 @@ NULL #' @param pairs_external data.table of paired spots. Format: cell_ID1, cell_ID2, #' N. Passes to `.cell_proximity_spots_external` `pairs` param #' @keywords internal -.cell_proximity_spots <- function(cell_IDs, - pairs_external, - dwls_values) { +.cell_proximity_spots <- function( + cell_IDs, + pairs_external, + dwls_values) { # data.table variables V1 <- internal <- external <- s1 <- s2 <- unified_int <- type_int <- NULL @@ -234,21 +235,22 @@ NULL #' #' cellProximityEnrichmentSpots(gobject = g) #' @export -cellProximityEnrichmentSpots <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network_name = "spatial_network", - cluster_column = "cell_ID", - cells_in_spot = 1, - number_of_simulations = 100, - adjust_method = c( - "none", "fdr", "bonferroni", "BH", - "holm", "hochberg", "hommel", - "BY" - ), - set_seed = TRUE, - seed_number = 1234, - verbose = FALSE) { +cellProximityEnrichmentSpots <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "spatial_network", + cluster_column = "cell_ID", + cells_in_spot = 1, + number_of_simulations = 100, + adjust_method = c( + "none", "fdr", "bonferroni", "BH", + "holm", "hochberg", "hommel", + "BY" + ), + set_seed = TRUE, + seed_number = 1234, + verbose = FALSE) { # p.adj test sel_adjust_method <- match.arg(adjust_method, choices = c( "none", "fdr", "bonferroni", "BH", @@ -474,10 +476,11 @@ cellProximityEnrichmentSpots <- function(gobject, #' #' @returns matrix #' @export -featExpDWLS <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - ave_celltype_exp) { +featExpDWLS <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + ave_celltype_exp) { # exact spatial_enrichment matrix dwls_values <- getSpatialEnrichment(gobject, spat_unit = spat_unit, @@ -534,11 +537,12 @@ featExpDWLS <- function(gobject, #' @param ave_celltype_exp average expression matrix in cell types #' @returns matrix #' @keywords internal -.cal_expr_residual <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - ave_celltype_exp) { +.cal_expr_residual <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + ave_celltype_exp) { # expression data values <- match.arg( expression_values, @@ -601,11 +605,12 @@ featExpDWLS <- function(gobject, #' #' cellProximityEnrichmentEachSpot(gobject = g) #' @export -cellProximityEnrichmentEachSpot <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network_name = "spatial_network", - cluster_column = "cell_ID") { +cellProximityEnrichmentEachSpot <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "spatial_network", + cluster_column = "cell_ID") { spatial_network_annot <- annotateSpatialNetwork( gobject = gobject, spat_unit = spat_unit, @@ -729,12 +734,13 @@ cellProximityEnrichmentEachSpot <- function(gobject, #' cell proximity score of selected cell for spots #' @returns data.table #' @keywords internal -.cal_diff_per_interaction <- function(sel_int, - other_ints, - select_ind, - other_ind, - proximityMat, - expr_residual) { +.cal_diff_per_interaction <- function( + sel_int, + other_ints, + select_ind, + other_ind, + proximityMat, + expr_residual) { pcc_diff <- sel <- other <- NULL # get data @@ -792,13 +798,14 @@ NULL #' @describeIn do_permuttest_spot Calculate original values for spots #' @keywords internal -.do_permuttest_original_spot <- function(sel_int, - other_ints, - select_ind, - other_ind, - name = "orig", - proximityMat, - expr_residual) { +.do_permuttest_original_spot <- function( + sel_int, + other_ints, + select_ind, + other_ind, + name = "orig", + proximityMat, + expr_residual) { resultsDT <- .cal_diff_per_interaction( sel_int = sel_int, other_ints = other_ints, @@ -814,15 +821,16 @@ NULL #' @describeIn do_permuttest_spot Calculate random values for spots #' @keywords internal -.do_permuttest_random_spot <- function(sel_int, - other_ints, - select_ind, - other_ind, - name = "perm_1", - proximityMat, - expr_residual, - set_seed = TRUE, - seed_number = 1234) { +.do_permuttest_random_spot <- function( + sel_int, + other_ints, + select_ind, + other_ind, + name = "perm_1", + proximityMat, + expr_residual, + set_seed = TRUE, + seed_number = 1234) { # data.table variables features <- NULL @@ -873,16 +881,17 @@ NULL #' @describeIn do_permuttest_spot Calculate multiple random values for spots #' @keywords internal -.do_multi_permuttest_random_spot <- function(sel_int, - other_ints, - select_ind, - other_ind, - proximityMat, - expr_residual, - n = 100, - cores = NA, - set_seed = TRUE, - seed_number = 1234) { +.do_multi_permuttest_random_spot <- function( + sel_int, + other_ints, + select_ind, + other_ind, + proximityMat, + expr_residual, + n = 100, + cores = NA, + set_seed = TRUE, + seed_number = 1234) { if (set_seed == TRUE) { seed_number_list <- seed_number:(seed_number + (n - 1)) } @@ -910,17 +919,18 @@ NULL #' @describeIn do_permuttest_spot Performs permutation test on subsets of a #' matrix for spots #' @keywords internal -.do_permuttest_spot <- function(sel_int, - other_ints, - select_ind, - other_ind, - proximityMat, - expr_residual, - n_perm = 100, - adjust_method = "fdr", - cores = 2, - set_seed = TRUE, - seed_number = 1234) { +.do_permuttest_spot <- function( + sel_int, + other_ints, + select_ind, + other_ind, + proximityMat, + expr_residual, + n_perm = 100, + adjust_method = "fdr", + cores = 2, + set_seed = TRUE, + seed_number = 1234) { # data.table variables log2fc_diff <- log2fc <- sel <- other <- features <- p_higher <- p_lower <- perm_sel <- NULL @@ -1000,18 +1010,19 @@ NULL #' for spots #' @returns differential test on subsets of a matrix #' @keywords internal -.do_cell_proximity_test_spot <- function(sel_int, - other_ints, - select_ind, - other_ind, - proximityMat, - expr_residual, - diff_test, - n_perm = 100, - adjust_method = "fdr", - cores = 2, - set_seed = TRUE, - seed_number = 1234) { +.do_cell_proximity_test_spot <- function( + sel_int, + other_ints, + select_ind, + other_ind, + proximityMat, + expr_residual, + diff_test, + n_perm = 100, + adjust_method = "fdr", + cores = 2, + set_seed = TRUE, + seed_number = 1234) { # get parameters diff_test <- match.arg( diff_test, @@ -1047,21 +1058,22 @@ NULL #' proximity to other cell types for spots. #' @returns data.table #' @keywords internal -.findICF_per_interaction_spot <- function(sel_int, - all_ints, - proximityMat, - expr_residual, - dwls_values, - dwls_cutoff = 0.001, - CCI_cell_score = 0.01, - minimum_unique_cells = 1, - minimum_unique_int_cells = 1, - diff_test = "permutation", - n_perm = 100, - adjust_method = "fdr", - cores = 2, - set_seed = TRUE, - seed_number = 1234) { +.findICF_per_interaction_spot <- function( + sel_int, + all_ints, + proximityMat, + expr_residual, + dwls_values, + dwls_cutoff = 0.001, + CCI_cell_score = 0.01, + minimum_unique_cells = 1, + minimum_unique_int_cells = 1, + diff_test = "permutation", + n_perm = 100, + adjust_method = "fdr", + cores = 2, + set_seed = TRUE, + seed_number = 1234) { # data.table variables unified_int <- NULL @@ -1211,27 +1223,26 @@ NULL #' @seealso [findInteractionChangedFeats()] #' @md #' @export -findICFSpot <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - ave_celltype_exp, - selected_features = NULL, - spatial_network_name = "Delaunay_network", - deconv_name = "DWLS", - minimum_unique_cells = 5, - minimum_unique_int_cells = 5, - CCI_cell_score = 0.1, - dwls_cutoff = 0.001, - diff_test = "permutation", - nr_permutations = 100, - adjust_method = "fdr", - do_parallel = TRUE, - cores = NA, - set_seed = TRUE, - seed_number = 1234, - verbose = FALSE) { +findICFSpot <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + ave_celltype_exp, + selected_features = NULL, + spatial_network_name = "Delaunay_network", + deconv_name = "DWLS", + minimum_unique_cells = 5, + minimum_unique_int_cells = 5, + CCI_cell_score = 0.1, + dwls_cutoff = 0.001, + diff_test = "permutation", + nr_permutations = 100, + adjust_method = "fdr", + do_parallel = TRUE, + cores = NA, + set_seed = TRUE, + seed_number = 1234, + verbose = FALSE) { # data.table variables unified_int <- NULL @@ -1399,16 +1410,17 @@ findICFSpot <- function( #' #' filterICFSpot(icfObject = icfObject) #' @export -filterICFSpot <- function(icfObject, - min_cells = 4, - min_cells_expr_resi = 0.05, - min_int_cells = 4, - min_int_cells_expr_resi = 0.05, - min_fdr = 0.5, - min_pcc_diff = 0.05, - min_zscore = 0.05, - zscores_column = c("cell_type", "features"), - direction = c("both", "up", "down")) { +filterICFSpot <- function( + icfObject, + min_cells = 4, + min_cells_expr_resi = 0.05, + min_int_cells = 4, + min_int_cells_expr_resi = 0.05, + min_fdr = 0.5, + min_pcc_diff = 0.05, + min_zscore = 0.05, + zscores_column = c("cell_type", "features"), + direction = c("both", "up", "down")) { # data.table variables nr_select <- int_nr_select <- zscores <- perm_diff <- sel <- other <- p.adj <- NULL @@ -1492,17 +1504,18 @@ filterICFSpot <- function(icfObject, #' ICF_features = c("3" = "Gna12", "1" = "Ccnd2", "8" = "Btbd17") #' ) #' @export -plotICFSpot <- function(gobject, - icfObject, - source_type, - source_markers, - ICF_features, - cell_color_code = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotICFSpot") { +plotICFSpot <- function( + gobject, + icfObject, + source_type, + source_markers, + ICF_features, + cell_color_code = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotICFSpot") { # data.table variables cell_type <- int_cell_type <- pcc_diff <- feats <- perm_diff <- NULL @@ -1611,27 +1624,28 @@ plotICFSpot <- function(gobject, #' min_pcc_diff = 0.01 #' ) #' @export -plotCellProximityFeatSpot <- function(gobject, - icfObject, - method = c( - "volcano", "cell_barplot", "cell-cell", "cell_sankey", - "heatmap", "dotplot" - ), - min_cells = 4, - min_cells_expr_resi = 0.05, - min_int_cells = 4, - min_int_cells_expr_resi = 0.05, - min_fdr = 0.5, - min_pcc_diff = 0.05, - min_zscore = 0.05, - zscores_column = c("cell_type", "features"), - direction = c("both", "up", "down"), - cell_color_code = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCellProximityFeats") { +plotCellProximityFeatSpot <- function( + gobject, + icfObject, + method = c( + "volcano", "cell_barplot", "cell-cell", "cell_sankey", + "heatmap", "dotplot" + ), + min_cells = 4, + min_cells_expr_resi = 0.05, + min_int_cells = 4, + min_int_cells_expr_resi = 0.05, + min_fdr = 0.5, + min_pcc_diff = 0.05, + min_zscore = 0.05, + zscores_column = c("cell_type", "features"), + direction = c("both", "up", "down"), + cell_color_code = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCellProximityFeats") { if (!"icfObject" %in% class(icfObject)) { stop("icfObject needs to be the output from findInteractionChangedFeats() or findICF()") @@ -2023,27 +2037,28 @@ plotCellProximityFeatSpot <- function(gobject, #' * PI: significance score: log2fc \* -log10(p.adj) #' } #' @keywords internal -.specific_CCCScores_spots <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expr_residual, - dwls_values, - proximityMat, - random_iter = 1000, - cell_type_1 = "astrocytes", - cell_type_2 = "endothelial", - feature_set_1, - feature_set_2, - min_observations = 2, - detailed = FALSE, - adjust_method = c( - "fdr", "bonferroni", " BH", "holm", "hochberg", "hommel", - "BY", "none" - ), - adjust_target = c("features", "cells"), - set_seed = FALSE, - seed_number = 1234, - verbose = FALSE) { +.specific_CCCScores_spots <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expr_residual, + dwls_values, + proximityMat, + random_iter = 1000, + cell_type_1 = "astrocytes", + cell_type_2 = "endothelial", + feature_set_1, + feature_set_2, + min_observations = 2, + detailed = FALSE, + adjust_method = c( + "fdr", "bonferroni", " BH", "holm", "hochberg", "hommel", + "BY", "none" + ), + adjust_target = c("features", "cells"), + set_seed = FALSE, + seed_number = 1234, + verbose = FALSE) { # data.table variables from_to <- cell_ID <- lig_cell_type <- rec_cell_type <- lig_nr <- rec_nr <- rand_expr <- NULL @@ -2296,29 +2311,30 @@ plotCellProximityFeatSpot <- function(gobject, #' } #' @md #' @export -spatCellCellcomSpots <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - ave_celltype_exp, - spatial_network_name = "Delaunay_network", - spat_enr_name = "DWLS", - cluster_column = "cell_ID", - random_iter = 1000, - feature_set_1, - feature_set_2, - min_observations = 2, - expression_values = c("normalized", "scaled", "custom"), - detailed = FALSE, - adjust_method = c( - "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", - "BY", "none" - ), - adjust_target = c("features", "cells"), - do_parallel = TRUE, - cores = NA, - set_seed = TRUE, - seed_number = 1234, - verbose = c("a little", "a lot", "none")) { +spatCellCellcomSpots <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + ave_celltype_exp, + spatial_network_name = "Delaunay_network", + spat_enr_name = "DWLS", + cluster_column = "cell_ID", + random_iter = 1000, + feature_set_1, + feature_set_2, + min_observations = 2, + expression_values = c("normalized", "scaled", "custom"), + detailed = FALSE, + adjust_method = c( + "fdr", "bonferroni", "BH", "holm", "hochberg", "hommel", + "BY", "none" + ), + adjust_target = c("features", "cells"), + do_parallel = TRUE, + cores = NA, + set_seed = TRUE, + seed_number = 1234, + verbose = c("a little", "a lot", "none")) { # data.table vars V1 <- V2 <- LR_cell_comb <- NULL diff --git a/R/spatial_interaction_visuals.R b/R/spatial_interaction_visuals.R index cd9ab46d0..cb6b6a1ac 100644 --- a/R/spatial_interaction_visuals.R +++ b/R/spatial_interaction_visuals.R @@ -18,16 +18,17 @@ #' CPscore = cellProximityEnrichment(g, cluster_column = "leiden_clus") #' ) #' @export -cellProximityBarplot <- function(gobject, - CPscore, - min_orig_ints = 5, - min_sim_ints = 5, - p_val = 0.05, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "cellProximityBarplot") { +cellProximityBarplot <- function( + gobject, + CPscore, + min_orig_ints = 5, + min_sim_ints = 5, + p_val = 0.05, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "cellProximityBarplot") { table_mean_results_dc <- CPscore$enrichm_res ## filter to remove low number of cell-cell proximity interactions ## @@ -107,17 +108,18 @@ cellProximityBarplot <- function(gobject, #' #' cellProximityHeatmap(gobject = g, CPscore = x) #' @export -cellProximityHeatmap <- function(gobject, - CPscore, - scale = TRUE, - order_cell_types = TRUE, - color_breaks = NULL, - color_names = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "cellProximityHeatmap") { +cellProximityHeatmap <- function( + gobject, + CPscore, + scale = TRUE, + order_cell_types = TRUE, + color_breaks = NULL, + color_names = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "cellProximityHeatmap") { enrich_res <- CPscore$enrichm_res # data.table variables @@ -249,26 +251,27 @@ cellProximityHeatmap <- function(gobject, #' #' cellProximityNetwork(gobject = g, CPscore = x) #' @export -cellProximityNetwork <- function(gobject, - CPscore, - remove_self_edges = FALSE, - self_loop_strength = 0.1, - color_depletion = "lightgreen", - color_enrichment = "red", - rescale_edge_weights = TRUE, - edge_weight_range_depletion = c(0.1, 1), - edge_weight_range_enrichment = c(1, 5), - layout = c("Fruchterman", "DrL", "Kamada-Kawai"), - only_show_enrichment_edges = FALSE, - edge_width_range = c(0.1, 2), - node_size = 4, - node_color_code = NULL, - node_text_size = 6, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "cellProximityNetwork") { +cellProximityNetwork <- function( + gobject, + CPscore, + remove_self_edges = FALSE, + self_loop_strength = 0.1, + color_depletion = "lightgreen", + color_enrichment = "red", + rescale_edge_weights = TRUE, + edge_weight_range_depletion = c(0.1, 1), + edge_weight_range_enrichment = c(1, 5), + layout = c("Fruchterman", "DrL", "Kamada-Kawai"), + only_show_enrichment_edges = FALSE, + edge_width_range = c(0.1, 2), + node_size = 4, + node_color_code = NULL, + node_text_size = 6, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "cellProximityNetwork") { # extract scores # data.table variables @@ -443,32 +446,33 @@ NULL #' @describeIn cellProximityVisPlot_internals Visualize 2D cell-cell #' interactions according to spatial coordinates in ggplot mode #' @keywords internal -.cellProximityVisPlot_2D_ggplot <- function(gobject, - interaction_name = NULL, - cluster_column = NULL, - sdimx = NULL, - sdimy = NULL, - cell_color = NULL, - cell_color_code = NULL, - color_as_factor = TRUE, - show_other_cells = FALSE, - show_network = FALSE, - show_other_network = FALSE, - network_color = NULL, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - coord_fix_ratio = 1, - show_legend = TRUE, - point_size_select = 2, - point_select_border_col = "black", - point_select_border_stroke = 0.05, - point_size_other = 1, - point_alpha_other = 0.3, - point_other_border_col = "lightgrey", - point_other_border_stroke = 0.01, - ...) { +.cellProximityVisPlot_2D_ggplot <- function( + gobject, + interaction_name = NULL, + cluster_column = NULL, + sdimx = NULL, + sdimy = NULL, + cell_color = NULL, + cell_color_code = NULL, + color_as_factor = TRUE, + show_other_cells = FALSE, + show_network = FALSE, + show_other_network = FALSE, + network_color = NULL, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + coord_fix_ratio = 1, + show_legend = TRUE, + point_size_select = 2, + point_select_border_col = "black", + point_select_border_stroke = 0.05, + point_size_other = 1, + point_alpha_other = 0.3, + point_other_border_col = "lightgrey", + point_other_border_stroke = 0.01, + ...) { # data.table variables unified_int <- sdimx_begin <- sdimy_begin <- sdimx_end <- sdimy_end <- x_start <- x_end <- NULL @@ -690,31 +694,32 @@ NULL #' @describeIn cellProximityVisPlot_internals Visualize 2D cell-cell #' interactions according to spatial coordinates in plotly mode #' @keywords internal -.cellProximityVisPlot_2D_plotly <- function(gobject, - interaction_name = NULL, - cluster_column = NULL, - sdimx = NULL, - sdimy = NULL, - cell_color = NULL, - cell_color_code = NULL, - color_as_factor = TRUE, - show_other_cells = FALSE, - show_network = FALSE, - show_other_network = FALSE, - network_color = NULL, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - show_legend = TRUE, - point_size_select = 2, - point_size_other = 1, - point_alpha_other = 0.3, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - ...) { +.cellProximityVisPlot_2D_plotly <- function( + gobject, + interaction_name = NULL, + cluster_column = NULL, + sdimx = NULL, + sdimy = NULL, + cell_color = NULL, + cell_color_code = NULL, + color_as_factor = TRUE, + show_other_cells = FALSE, + show_network = FALSE, + show_other_network = FALSE, + network_color = NULL, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + show_legend = TRUE, + point_size_select = 2, + point_size_other = 1, + point_alpha_other = 0.3, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + ...) { package_check("plotly") # data.table variables @@ -953,33 +958,34 @@ NULL #' @describeIn cellProximityVisPlot_internals Visualize 3D cell-cell #' interactions according to spatial coordinates in plotly mode #' @keywords internal -.cellProximityVisPlot_3D_plotly <- function(gobject, - interaction_name = NULL, - cluster_column = NULL, - sdimx = NULL, - sdimy = NULL, - sdimz = NULL, - cell_color = NULL, - cell_color_code = NULL, - color_as_factor = TRUE, - show_other_cells = FALSE, - show_network = FALSE, - show_other_network = FALSE, - network_color = NULL, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - show_legend = TRUE, - point_size_select = 2, - point_size_other = 1, - point_alpha_other = 0.5, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - ...) { +.cellProximityVisPlot_3D_plotly <- function( + gobject, + interaction_name = NULL, + cluster_column = NULL, + sdimx = NULL, + sdimy = NULL, + sdimz = NULL, + cell_color = NULL, + cell_color_code = NULL, + color_as_factor = TRUE, + show_other_cells = FALSE, + show_network = FALSE, + show_other_network = FALSE, + network_color = NULL, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + show_legend = TRUE, + point_size_select = 2, + point_size_other = 1, + point_alpha_other = 0.5, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + ...) { package_check("plotly") # data.table variables @@ -1241,39 +1247,40 @@ NULL #' cluster_column = "leiden_clus", sdimx = "sdimx", sdimy = "sdimy" #' ) #' @export -cellProximityVisPlot <- function(gobject, - interaction_name = NULL, - cluster_column = NULL, - sdimx = NULL, - sdimy = NULL, - sdimz = NULL, - cell_color = NULL, - cell_color_code = NULL, - color_as_factor = TRUE, - show_other_cells = FALSE, - show_network = FALSE, - show_other_network = FALSE, - network_color = NULL, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - coord_fix_ratio = 1, - show_legend = TRUE, - point_size_select = 2, - point_select_border_col = "black", - point_select_border_stroke = 0.05, - point_size_other = 1, - point_alpha_other = 0.3, - point_other_border_col = "lightgrey", - point_other_border_stroke = 0.01, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - plot_method = c("ggplot", "plotly"), - ...) { +cellProximityVisPlot <- function( + gobject, + interaction_name = NULL, + cluster_column = NULL, + sdimx = NULL, + sdimy = NULL, + sdimz = NULL, + cell_color = NULL, + cell_color_code = NULL, + color_as_factor = TRUE, + show_other_cells = FALSE, + show_network = FALSE, + show_other_network = FALSE, + network_color = NULL, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + coord_fix_ratio = 1, + show_legend = TRUE, + point_size_select = 2, + point_select_border_col = "black", + point_select_border_stroke = 0.05, + point_size_other = 1, + point_alpha_other = 0.3, + point_other_border_col = "lightgrey", + point_other_border_stroke = 0.01, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + plot_method = c("ggplot", "plotly"), + ...) { ## decide plot method plot_method <- match.arg(plot_method, choices = c("ggplot", "plotly")) axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) @@ -1430,28 +1437,29 @@ cellProximityVisPlot <- function(gobject, #' show_plot = TRUE, save_plot = FALSE, return_plot = FALSE #' ) #' @export -plotCellProximityFeats <- function(gobject, - icfObject, - method = c( - "volcano", "cell_barplot", "cell-cell", "cell_sankey", - "heatmap", "dotplot" - ), - min_cells = 4, - min_cells_expr = 1, - min_int_cells = 4, - min_int_cells_expr = 1, - min_fdr = 0.1, - min_spat_diff = 0.2, - min_log2_fc = 0.2, - min_zscore = 2, - zscores_column = c("cell_type", "feats"), - direction = c("both", "up", "down"), - cell_color_code = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCellProximityFeats") { +plotCellProximityFeats <- function( + gobject, + icfObject, + method = c( + "volcano", "cell_barplot", "cell-cell", "cell_sankey", + "heatmap", "dotplot" + ), + min_cells = 4, + min_cells_expr = 1, + min_int_cells = 4, + min_int_cells_expr = 1, + min_fdr = 0.1, + min_spat_diff = 0.2, + min_log2_fc = 0.2, + min_zscore = 2, + zscores_column = c("cell_type", "feats"), + direction = c("both", "up", "down"), + cell_color_code = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCellProximityFeats") { if (!"icfObject" %in% class(icfObject)) { stop("icfObject needs to be the output from findInteractionChangedFeats() or findICF()") @@ -1818,28 +1826,29 @@ plotCellProximityFeats <- function(gobject, #' save_plot = FALSE, return_plot = FALSE #' ) #' @export -plotCPF <- function(gobject, - icfObject, - method = c( - "volcano", "cell_barplot", "cell-cell", "cell_sankey", - "heatmap", "dotplot" - ), - min_cells = 5, - min_cells_expr = 1, - min_int_cells = 3, - min_int_cells_expr = 1, - min_fdr = 0.05, - min_spat_diff = 0.2, - min_log2_fc = 0.2, - min_zscore = 2, - zscores_column = c("cell_type", "feats"), - direction = c("both", "up", "down"), - cell_color_code = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCPG") { +plotCPF <- function( + gobject, + icfObject, + method = c( + "volcano", "cell_barplot", "cell-cell", "cell_sankey", + "heatmap", "dotplot" + ), + min_cells = 5, + min_cells_expr = 1, + min_int_cells = 3, + min_int_cells_expr = 1, + min_fdr = 0.05, + min_spat_diff = 0.2, + min_log2_fc = 0.2, + min_zscore = 2, + zscores_column = c("cell_type", "feats"), + direction = c("both", "up", "down"), + cell_color_code = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCPG") { plotCellProximityFeats( gobject = gobject, icfObject = icfObject, @@ -1889,17 +1898,18 @@ plotCPF <- function(gobject, #' ICF_feats = c("3" = "Gna12", "1" = "Ccnd2", "8" = "Btbd17") #' ) #' @export -plotInteractionChangedFeats <- function(gobject, - icfObject, - source_type, - source_markers, - ICF_feats, - cell_color_code = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotInteractionChangedFeats") { +plotInteractionChangedFeats <- function( + gobject, + icfObject, + source_type, + source_markers, + ICF_feats, + cell_color_code = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotInteractionChangedFeats") { # data.table variables cell_type <- int_cell_type <- log2fc <- NULL @@ -2011,17 +2021,18 @@ plotInteractionChangedFeats <- function(gobject, #' ICF_feats = c("3" = "Gna12", "1" = "Ccnd2", "8" = "Btbd17") #' ) #' @export -plotICF <- function(gobject, - icfObject, - source_type, - source_markers, - ICF_feats, - cell_color_code = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotICF") { +plotICF <- function( + gobject, + icfObject, + source_type, + source_markers, + ICF_feats, + cell_color_code = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotICF") { plotInteractionChangedFeats( gobject = gobject, icfObject = icfObject, @@ -2077,22 +2088,23 @@ plotICF <- function(gobject, #' selected_interactions = "1--8" #' ) #' @export -plotCombineInteractionChangedFeats <- function(gobject, - combIcfObject, - selected_interactions = NULL, - selected_feat_to_feat = NULL, - detail_plot = TRUE, - simple_plot = FALSE, - simple_plot_facet = c("interaction", "feats"), - facet_scales = "fixed", - facet_ncol = length(selected_feat_to_feat), - facet_nrow = length(selected_interactions), - colors = c("#9932CC", "#FF8C00"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCombineICF") { +plotCombineInteractionChangedFeats <- function( + gobject, + combIcfObject, + selected_interactions = NULL, + selected_feat_to_feat = NULL, + detail_plot = TRUE, + simple_plot = FALSE, + simple_plot_facet = c("interaction", "feats"), + facet_scales = "fixed", + facet_ncol = length(selected_feat_to_feat), + facet_nrow = length(selected_interactions), + colors = c("#9932CC", "#FF8C00"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCombineICF") { ## check validity if (!"combIcfObject" %in% class(combIcfObject)) { stop("combIcfObject needs to be the output from @@ -2287,22 +2299,23 @@ plotCombineInteractionChangedFeats <- function(gobject, #' selected_interactions = "1--8" #' ) #' @export -plotCombineICF <- function(gobject, - combIcfObject, - selected_interactions = NULL, - selected_feat_to_feat = NULL, - detail_plot = TRUE, - simple_plot = FALSE, - simple_plot_facet = c("interaction", "feats"), - facet_scales = "fixed", - facet_ncol = length(selected_feat_to_feat), - facet_nrow = length(selected_interactions), - colors = c("#9932CC", "#FF8C00"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCombineICF") { +plotCombineICF <- function( + gobject, + combIcfObject, + selected_interactions = NULL, + selected_feat_to_feat = NULL, + detail_plot = TRUE, + simple_plot = FALSE, + simple_plot_facet = c("interaction", "feats"), + facet_scales = "fixed", + facet_ncol = length(selected_feat_to_feat), + facet_nrow = length(selected_interactions), + colors = c("#9932CC", "#FF8C00"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCombineICF") { plotCombineInteractionChangedFeats( gobject = gobject, combIcfObject = combIcfObject, @@ -2380,22 +2393,23 @@ plotCombineICF <- function(gobject, #' selected_LR = c("Gm19935-9630013A20Rik"), selected_cell_LR = c("1--1") #' ) #' @export -plotCombineCellCellCommunication <- function(gobject, - combCCcom, - selected_LR = NULL, - selected_cell_LR = NULL, - detail_plot = TRUE, - simple_plot = FALSE, - simple_plot_facet = c("interaction", "genes"), - facet_scales = "fixed", - facet_ncol = length(selected_LR), - facet_nrow = length(selected_cell_LR), - colors = c("#9932CC", "#FF8C00"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCombineCellCellCommunication") { +plotCombineCellCellCommunication <- function( + gobject, + combCCcom, + selected_LR = NULL, + selected_cell_LR = NULL, + detail_plot = TRUE, + simple_plot = FALSE, + simple_plot_facet = c("interaction", "genes"), + facet_scales = "fixed", + facet_ncol = length(selected_LR), + facet_nrow = length(selected_cell_LR), + colors = c("#9932CC", "#FF8C00"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCombineCellCellCommunication") { # data.table variables LR_comb <- LR_cell_comb <- lig_expr <- lig_expr_spat <- rec_expr <- rec_expr_spat <- LR_expr <- LR_expr_spat <- NULL @@ -2591,22 +2605,23 @@ plotCombineCellCellCommunication <- function(gobject, #' selected_LR = c("Gm19935-9630013A20Rik"), selected_cell_LR = c("1--1") #' ) #' @export -plotCombineCCcom <- function(gobject, - combCCcom, - selected_LR = NULL, - selected_cell_LR = NULL, - detail_plot = TRUE, - simple_plot = FALSE, - simple_plot_facet = c("interaction", "genes"), - facet_scales = "fixed", - facet_ncol = length(selected_LR), - facet_nrow = length(selected_cell_LR), - colors = c("#9932CC", "#FF8C00"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCombineCCcom") { +plotCombineCCcom <- function( + gobject, + combCCcom, + selected_LR = NULL, + selected_cell_LR = NULL, + detail_plot = TRUE, + simple_plot = FALSE, + simple_plot_facet = c("interaction", "genes"), + facet_scales = "fixed", + facet_ncol = length(selected_LR), + facet_nrow = length(selected_cell_LR), + colors = c("#9932CC", "#FF8C00"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCombineCCcom") { plotCombineCellCellCommunication( gobject = gobject, combCCcom = combCCcom, @@ -2658,25 +2673,26 @@ plotCombineCCcom <- function(gobject, #' #' plotCCcomHeatmap(gobject = g, comScores = comScores, show_plot = TRUE) #' @export -plotCCcomHeatmap <- function(gobject, - comScores, - selected_LR = NULL, - selected_cell_LR = NULL, - show_LR_names = TRUE, - show_cell_LR_names = TRUE, - show = c("PI", "LR_expr", "log2fc"), - cor_method = c("pearson", "kendall", "spearman"), - aggl_method = c( - "ward.D", "ward.D2", "single", "complete", "average", - "mcquitty", "median", "centroid" - ), - gradient_color = NULL, - gradient_style = c("divergent", "sequential"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCCcomHeatmap") { +plotCCcomHeatmap <- function( + gobject, + comScores, + selected_LR = NULL, + selected_cell_LR = NULL, + show_LR_names = TRUE, + show_cell_LR_names = TRUE, + show = c("PI", "LR_expr", "log2fc"), + cor_method = c("pearson", "kendall", "spearman"), + aggl_method = c( + "ward.D", "ward.D2", "single", "complete", "average", + "mcquitty", "median", "centroid" + ), + gradient_color = NULL, + gradient_style = c("divergent", "sequential"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCCcomHeatmap") { # get parameters cor_method <- match.arg( cor_method, @@ -2813,25 +2829,26 @@ plotCCcomHeatmap <- function(gobject, #' #' plotCCcomDotplot(gobject = g, comScores = comScores, show_plot = TRUE) #' @export -plotCCcomDotplot <- function(gobject, - comScores, - selected_LR = NULL, - selected_cell_LR = NULL, - show_LR_names = TRUE, - show_cell_LR_names = TRUE, - cluster_on = c("PI", "LR_expr", "log2fc"), - cor_method = c("pearson", "kendall", "spearman"), - aggl_method = c( - "ward.D", "ward.D2", "single", "complete", "average", - "mcquitty", "median", "centroid" - ), - dot_color_gradient = NULL, - gradient_style = c("divergent", "sequential"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotCCcomDotplot") { +plotCCcomDotplot <- function( + gobject, + comScores, + selected_LR = NULL, + selected_cell_LR = NULL, + show_LR_names = TRUE, + show_cell_LR_names = TRUE, + cluster_on = c("PI", "LR_expr", "log2fc"), + cor_method = c("pearson", "kendall", "spearman"), + aggl_method = c( + "ward.D", "ward.D2", "single", "complete", "average", + "mcquitty", "median", "centroid" + ), + dot_color_gradient = NULL, + gradient_style = c("divergent", "sequential"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotCCcomDotplot") { # get parameters cor_method <- match.arg( cor_method, @@ -2999,23 +3016,24 @@ plotCCcomDotplot <- function(gobject, #' #' plotRankSpatvsExpr(gobject = g, combCC = combCC) #' @export -plotRankSpatvsExpr <- function(gobject, - combCC, - expr_rnk_column = "LR_expr_rnk", - spat_rnk_column = "LR_spat_rnk", - dot_color_gradient = NULL, - midpoint = deprecated(), - gradient_midpoint = 10, - gradient_style = c("divergent", "sequential"), - size_range = c(0.01, 1.5), - xlims = NULL, - ylims = NULL, - selected_ranks = c(1, 10, 20), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotRankSpatvsExpr") { +plotRankSpatvsExpr <- function( + gobject, + combCC, + expr_rnk_column = "LR_expr_rnk", + spat_rnk_column = "LR_spat_rnk", + dot_color_gradient = NULL, + midpoint = deprecated(), + gradient_midpoint = 10, + gradient_style = c("divergent", "sequential"), + size_range = c(0.01, 1.5), + xlims = NULL, + ylims = NULL, + selected_ranks = c(1, 10, 20), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotRankSpatvsExpr") { # deprecate if (GiottoUtils::is_present(midpoint)) { deprecate_warn( @@ -3119,9 +3137,10 @@ plotRankSpatvsExpr <- function(gobject, #' @param second_col second column to use #' @returns ggplot #' @keywords internal -.plotRecovery_sub <- function(combCC, - first_col = "LR_expr_rnk", - second_col = "LR_spat_rnk") { +.plotRecovery_sub <- function( + combCC, + first_col = "LR_expr_rnk", + second_col = "LR_spat_rnk") { # data.table variables concord <- perc <- not_concord <- secondrank <- secondrank_perc <- NULL @@ -3197,16 +3216,17 @@ plotRankSpatvsExpr <- function(gobject, #' #' plotRecovery(gobject = g, combCC = combCC) #' @export -plotRecovery <- function(gobject, - combCC, - expr_rnk_column = "exprPI_rnk", - spat_rnk_column = "spatPI_rnk", - ground_truth = c("spatial", "expression"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotRecovery") { +plotRecovery <- function( + gobject, + combCC, + expr_rnk_column = "exprPI_rnk", + spat_rnk_column = "spatPI_rnk", + ground_truth = c("spatial", "expression"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotRecovery") { ground_truth <- match.arg( ground_truth, choices = c("spatial", "expression") @@ -3299,39 +3319,40 @@ plotRecovery <- function(gobject, #' interaction_name = x #' ) #' @export -cellProximitySpatPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = NULL, - interaction_name = NULL, - cluster_column = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - cell_color = NULL, - cell_color_code = NULL, - color_as_factor = TRUE, - show_other_cells = FALSE, - show_network = FALSE, - show_other_network = FALSE, - network_color = NULL, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - coord_fix_ratio = 1, - show_legend = TRUE, - point_size_select = 2, - point_select_border_col = "black", - point_select_border_stroke = 0.05, - point_size_other = 1, - point_alpha_other = 0.3, - point_other_border_col = "lightgrey", - point_other_border_stroke = 0.01, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "cellProximitySpatPlot2D") { +cellProximitySpatPlot2D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = NULL, + interaction_name = NULL, + cluster_column = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + cell_color = NULL, + cell_color_code = NULL, + color_as_factor = TRUE, + show_other_cells = FALSE, + show_network = FALSE, + show_other_network = FALSE, + network_color = NULL, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + coord_fix_ratio = 1, + show_legend = TRUE, + point_size_select = 2, + point_select_border_col = "black", + point_select_border_stroke = 0.05, + point_size_other = 1, + point_alpha_other = 0.3, + point_other_border_col = "lightgrey", + point_other_border_stroke = 0.01, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "cellProximitySpatPlot2D") { if (is.null(interaction_name)) { stop("you need to specific at least one interaction name, run cellProximityEnrichment") @@ -3627,38 +3648,39 @@ cellProximitySpatPlot <- function(gobject, ...) { #' @returns plotly #' @details Description of parameters. #' @export -cellProximitySpatPlot3D <- function(gobject, - interaction_name = NULL, - cluster_column = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - cell_color = NULL, - cell_color_code = NULL, - color_as_factor = TRUE, - show_other_cells = TRUE, - show_network = TRUE, - show_other_network = FALSE, - network_color = NULL, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - show_legend = TRUE, - point_size_select = 4, - point_size_other = 2, - point_alpha_other = 0.5, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "cellProximitySpatPlot3D", - ...) { +cellProximitySpatPlot3D <- function( + gobject, + interaction_name = NULL, + cluster_column = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + cell_color = NULL, + cell_color_code = NULL, + color_as_factor = TRUE, + show_other_cells = TRUE, + show_network = TRUE, + show_other_network = FALSE, + network_color = NULL, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + show_legend = TRUE, + point_size_select = 4, + point_size_other = 2, + point_alpha_other = 0.5, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "cellProximitySpatPlot3D", + ...) { if (is.null(sdimz)) { pl <- .cellProximityVisPlot_2D_plotly( gobject = gobject, diff --git a/R/spdep.R b/R/spdep.R index fe924fa9f..84b1b9ed9 100644 --- a/R/spdep.R +++ b/R/spdep.R @@ -18,14 +18,15 @@ #' #' spdepAutoCorr(g) #' @export -spdepAutoCorr <- function(gobject, - method = c("geary.test", "lee.test", "lm.morantest", "moran.test"), - spat_unit = NULL, - feat_type = NULL, - expression_values = "normalized", - spatial_network_to_use = "spatial_network", - return_gobject = FALSE, - verbose = FALSE) { +spdepAutoCorr <- function( + gobject, + method = c("geary.test", "lee.test", "lm.morantest", "moran.test"), + spat_unit = NULL, + feat_type = NULL, + expression_values = "normalized", + spatial_network_to_use = "spatial_network", + return_gobject = FALSE, + verbose = FALSE) { # Check and match the specified method argument method <- match.arg(method) diff --git a/R/variable_genes.R b/R/variable_genes.R index bc65fcc60..a29ae5247 100644 --- a/R/variable_genes.R +++ b/R/variable_genes.R @@ -1,9 +1,10 @@ -.calc_cov_group_hvf <- function(feat_in_cells_detected, - nr_expression_groups = 20, - zscore_threshold = 1, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL) { +.calc_cov_group_hvf <- function( + feat_in_cells_detected, + nr_expression_groups = 20, + zscore_threshold = 1, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL) { # NSE vars cov_group_zscore <- cov <- selected <- mean_expr <- NULL @@ -54,11 +55,12 @@ -.calc_cov_loess_hvf <- function(feat_in_cells_detected, - difference_in_cov = 0.1, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL) { +.calc_cov_loess_hvf <- function( + feat_in_cells_detected, + difference_in_cov = 0.1, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL) { # NSE vars cov_diff <- pred_cov_feats <- selected <- NULL @@ -95,13 +97,14 @@ -.calc_var_hvf <- function(scaled_matrix, - var_threshold = 1.5, - var_number = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - use_parallel = FALSE) { +.calc_var_hvf <- function( + scaled_matrix, + var_threshold = 1.5, + var_number = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + use_parallel = FALSE) { # NSE vars var <- selected <- NULL @@ -180,10 +183,9 @@ } -.calc_expr_cov_stats_parallel <- function( - expr_values, - expression_threshold, - cores = GiottoUtils::determine_cores()) { +.calc_expr_cov_stats_parallel <- function(expr_values, + expression_threshold, + cores = GiottoUtils::determine_cores()) { # NSE vars cov <- sd <- mean_expr <- NULL @@ -282,30 +284,31 @@ #' #' calculateHVF(g) #' @export -calculateHVF <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - method = c("cov_groups", "cov_loess", "var_p_resid"), - reverse_log_scale = FALSE, - logbase = 2, - expression_threshold = 0, - nr_expression_groups = 20, - zscore_threshold = 1.5, - HVFname = "hvf", - difference_in_cov = 0.1, - var_threshold = 1.5, - var_number = NULL, - random_subset = NULL, - set_seed = TRUE, - seed_number = 1234, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "HVFplot", - return_gobject = TRUE, - verbose = TRUE) { +calculateHVF <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + method = c("cov_groups", "cov_loess", "var_p_resid"), + reverse_log_scale = FALSE, + logbase = 2, + expression_threshold = 0, + nr_expression_groups = 20, + zscore_threshold = 1.5, + HVFname = "hvf", + difference_in_cov = 0.1, + var_threshold = 1.5, + var_number = NULL, + random_subset = NULL, + set_seed = TRUE, + seed_number = 1234, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "HVFplot", + return_gobject = TRUE, + verbose = TRUE) { # NSE vars selected <- feats <- var <- NULL @@ -519,8 +522,8 @@ calculateHVF <- function(gobject, # plot generation #### -.create_cov_group_hvf_plot <- function(feat_in_cells_detected, - nr_expression_groups) { +.create_cov_group_hvf_plot <- function(feat_in_cells_detected, + nr_expression_groups) { pl <- ggplot2::ggplot() pl <- pl + ggplot2::theme_classic() + ggplot2::theme( @@ -551,8 +554,8 @@ calculateHVF <- function(gobject, } -.create_cov_loess_hvf_plot <- function(feat_in_cells_detected, - difference_in_cov, var_col) { +.create_cov_loess_hvf_plot <- function(feat_in_cells_detected, + difference_in_cov, var_col) { pl <- ggplot2::ggplot() pl <- pl + ggplot2::theme_classic() + ggplot2::theme( diff --git a/R/wnn.R b/R/wnn.R index b8578f5c5..4c119f6d1 100644 --- a/R/wnn.R +++ b/R/wnn.R @@ -13,16 +13,17 @@ #' #' @returns A Giotto object with a new multiomics slot containing the theta_weighted_matrix and individual weight matrices. #' @export -runWNN <- function(gobject, - spat_unit = "cell", - feat_types = c("rna", "protein"), - reduction_methods = c("pca", "pca"), - reduction_names = c("rna.pca", "protein.pca"), - k = 20, - integrated_feat_type = NULL, - matrix_result_name = NULL, - w_names = c(NULL, NULL), - verbose = FALSE) { +runWNN <- function( + gobject, + spat_unit = "cell", + feat_types = c("rna", "protein"), + reduction_methods = c("pca", "pca"), + reduction_names = c("rna.pca", "protein.pca"), + k = 20, + integrated_feat_type = NULL, + matrix_result_name = NULL, + w_names = c(NULL, NULL), + verbose = FALSE) { # validate Giotto object if (!inherits(gobject, "giotto")) { stop("gobject needs to be a giotto object") @@ -436,17 +437,18 @@ runWNN <- function(gobject, #' #' @returns A Giotto object with integrated UMAP #' @export -runIntegratedUMAP <- function(gobject, - spat_unit = "cell", - feat_types = c("rna", "protein"), - integrated_feat_type = NULL, - integration_method = "WNN", - matrix_result_name = "theta_weighted_matrix", - k = 20, - spread = 5, - min_dist = 0.01, - force = FALSE, - ...) { +runIntegratedUMAP <- function( + gobject, + spat_unit = "cell", + feat_types = c("rna", "protein"), + integrated_feat_type = NULL, + integration_method = "WNN", + matrix_result_name = "theta_weighted_matrix", + k = 20, + spread = 5, + min_dist = 0.01, + force = FALSE, + ...) { # validate feat_types for (feat_type in feat_types) { if (!feat_type %in% names( From dad552b4a574b198d04a4ca19b40b2c25f45b19a Mon Sep 17 00:00:00 2001 From: josschavezf Date: Fri, 15 Nov 2024 22:14:17 -0500 Subject: [PATCH 2/2] run devtools::document --- man/calculateAffineMatrixFromLandmarks.Rd | 6 ++-- man/cellProximityBarplot.Rd | 4 +-- man/cellProximityHeatmap.Rd | 4 +-- man/cellProximityNetwork.Rd | 4 +-- man/cellProximitySpatPlot.Rd | 6 ++-- man/cellProximitySpatPlot2D.Rd | 6 ++-- man/cellProximitySpatPlot3D.Rd | 6 ++-- man/createArchRProj.Rd | 2 +- man/createGiottoCosMxObject.Rd | 2 +- man/createGiottoMerscopeObject.Rd | 2 +- man/createGiottoVisiumHDObject.Rd | 4 +-- man/createGiottoVisiumObject.Rd | 14 +++++----- man/crossSectionFeatPlot3D.Rd | 2 +- man/data_access_params.Rd | 6 ++-- man/doCellposeSegmentation.Rd | 26 +++++++++-------- ...imate_transform_from_matched_descriptor.Rd | 2 +- man/dot-plot_matched_descriptors.Rd | 4 +-- man/dot-sift_detect.Rd | 4 +-- man/dot-warp_transformed_image.Rd | 2 +- ...imateAutomatedImageRegistrationWithSIFT.Rd | 13 +++++---- man/exportGiottoViewer.Rd | 10 +++---- man/filterCombinations.Rd | 4 +-- man/giottoToAnndataZarr.Rd | 2 +- man/importVisiumHD.Rd | 28 ++++++++++--------- man/interactiveLandmarkSelection.Rd | 8 +++--- man/jackstrawPlot.Rd | 4 +-- man/pieCellTypesFromEnrichment.Rd | 4 +-- man/plotCCcomDotplot.Rd | 4 +-- man/plotCCcomHeatmap.Rd | 4 +-- man/plotCPF.Rd | 4 +-- man/plotCTCompositionInNicheCluster.Rd | 4 +-- man/plotCellProximityFeatSpot.Rd | 4 +-- man/plotCellProximityFeats.Rd | 4 +-- man/plotCellTypeNTScore.Rd | 4 +-- man/plotCellTypesFromEnrichment.Rd | 4 +-- man/plotCombineCCcom.Rd | 4 +-- man/plotCombineCellCellCommunication.Rd | 4 +-- man/plotCombineICF.Rd | 4 +-- man/plotCombineInteractionChangedFeats.Rd | 4 +-- man/plotICF.Rd | 4 +-- man/plotICFSpot.Rd | 4 +-- man/plotInteractionChangedFeats.Rd | 4 +-- man/plotNicheClusterConnectivity.Rd | 4 +-- man/plotRankSpatvsExpr.Rd | 4 +-- man/plotRecovery.Rd | 4 +-- man/plotSpatNicheClusterBin.Rd | 2 +- man/plotSpatNicheClusterProb.Rd | 2 +- man/plot_cell_params.Rd | 2 +- man/plot_dimred_params.Rd | 2 +- man/plot_image_params.Rd | 2 +- man/plot_nn_net_params.Rd | 4 +-- man/plot_output_params.Rd | 4 +-- man/plot_params.Rd | 4 +-- man/plot_poly_params.Rd | 8 +++--- man/plot_spatenr_params.Rd | 2 +- man/preprocessImageToMatrix.Rd | 14 +++++----- man/runPatternSimulation.Rd | 2 +- man/screePlot.Rd | 4 +-- man/signPCA.Rd | 4 +-- man/writeChatGPTqueryDEG.Rd | 10 +++---- man/write_giotto_viewer_dim_reduction.Rd | 2 +- man/write_giotto_viewer_numeric_annotation.Rd | 2 +- 62 files changed, 163 insertions(+), 158 deletions(-) diff --git a/man/calculateAffineMatrixFromLandmarks.Rd b/man/calculateAffineMatrixFromLandmarks.Rd index 7edcbbd8a..268b6a0d1 100644 --- a/man/calculateAffineMatrixFromLandmarks.Rd +++ b/man/calculateAffineMatrixFromLandmarks.Rd @@ -7,16 +7,16 @@ calculateAffineMatrixFromLandmarks(source_df, target_df) } \arguments{ -\item{source_df}{source landmarks, two columns, first column represent +\item{source_df}{source landmarks, two columns, first column represent x coordinate and second column represent y coordinate.} -\item{target_df}{target landmarks, two columns, first column represent +\item{target_df}{target landmarks, two columns, first column represent x coordinate and second column represent y coordinate.} } \value{ a 3 by 3 matrix with the third row close to (0,0,1) } \description{ -calculate a affine transformation matrix from two set of +calculate a affine transformation matrix from two set of landmarks } diff --git a/man/cellProximityBarplot.Rd b/man/cellProximityBarplot.Rd index 06b577cf4..984240fd4 100644 --- a/man/cellProximityBarplot.Rd +++ b/man/cellProximityBarplot.Rd @@ -34,10 +34,10 @@ cellProximityBarplot( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/cellProximityHeatmap.Rd b/man/cellProximityHeatmap.Rd index 6b64cef90..bb6663b3b 100644 --- a/man/cellProximityHeatmap.Rd +++ b/man/cellProximityHeatmap.Rd @@ -38,10 +38,10 @@ and maximum} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/cellProximityNetwork.Rd b/man/cellProximityNetwork.Rd index 6da55ef13..4a3591c27 100644 --- a/man/cellProximityNetwork.Rd +++ b/man/cellProximityNetwork.Rd @@ -66,10 +66,10 @@ enriched edge weights} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/cellProximitySpatPlot.Rd b/man/cellProximitySpatPlot.Rd index 6c906506b..ff159d1e0 100644 --- a/man/cellProximitySpatPlot.Rd +++ b/man/cellProximitySpatPlot.Rd @@ -37,13 +37,13 @@ cellProximitySpatPlot(gobject, ...) \item{\code{show_plot}}{logical. show plot} \item{\code{return_plot}}{logical. return ggplot object} \item{\code{save_plot}}{logical. save the plot} - \item{\code{save_param}}{list of saving parameters, see + \item{\code{save_param}}{list of saving parameters, see \code{\link{showSaveParameters}}} - \item{\code{default_save_name}}{default save name for saving, don't change, + \item{\code{default_save_name}}{default save name for saving, don't change, change save_name in save_param} \item{\code{cell_color}}{character. what to color cells by (e.g. metadata col or spatial enrichment col)} - \item{\code{color_as_factor}}{logical. convert color column to factor. discrete + \item{\code{color_as_factor}}{logical. convert color column to factor. discrete colors are used when this is TRUE. continuous colors when FALSE.} \item{\code{cell_color_code}}{character. discrete colors to use. palette to use or named vector of colors} diff --git a/man/cellProximitySpatPlot2D.Rd b/man/cellProximitySpatPlot2D.Rd index 1d05af9e5..a950726b4 100644 --- a/man/cellProximitySpatPlot2D.Rd +++ b/man/cellProximitySpatPlot2D.Rd @@ -63,7 +63,7 @@ spatial enrichment col)} \item{cell_color_code}{character. discrete colors to use. palette to use or named vector of colors} -\item{color_as_factor}{logical. convert color column to factor. discrete +\item{color_as_factor}{logical. convert color column to factor. discrete colors are used when this is TRUE. continuous colors when FALSE.} \item{show_other_cells}{decide if show cells not in network} @@ -106,10 +106,10 @@ colors are used when this is TRUE. continuous colors when FALSE.} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/cellProximitySpatPlot3D.Rd b/man/cellProximitySpatPlot3D.Rd index a829a4154..6787116c4 100644 --- a/man/cellProximitySpatPlot3D.Rd +++ b/man/cellProximitySpatPlot3D.Rd @@ -58,7 +58,7 @@ spatial enrichment col)} \item{cell_color_code}{character. discrete colors to use. palette to use or named vector of colors} -\item{color_as_factor}{logical. convert color column to factor. discrete +\item{color_as_factor}{logical. convert color column to factor. discrete colors are used when this is TRUE. continuous colors when FALSE.} \item{show_other_cells}{decide if show cells not in network} @@ -101,10 +101,10 @@ colors are used when this is TRUE. continuous colors when FALSE.} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} \item{\dots}{additional parameters} diff --git a/man/createArchRProj.Rd b/man/createArchRProj.Rd index 70a312647..9c0189c5f 100644 --- a/man/createArchRProj.Rd +++ b/man/createArchRProj.Rd @@ -24,7 +24,7 @@ These files can be in one of the following formats: (i) scATAC tabix files, (ii) fragment files, or (iii) bam files.} \item{genome}{A string indicating the default genome to be used for all ArchR -functions. Currently supported values include "hg19","hg38","mm9", and +functions. Currently supported values include "hg19","hg38","mm9", and "mm10". This value is stored as a global environment variable, not part of the ArchRProject. diff --git a/man/createGiottoCosMxObject.Rd b/man/createGiottoCosMxObject.Rd index 6b0a98861..324bfc640 100644 --- a/man/createGiottoCosMxObject.Rd +++ b/man/createGiottoCosMxObject.Rd @@ -64,7 +64,7 @@ function matches against: \item{experimentname_\strong{tx_file}.csv (file)} } -[\strong{Workflows}] Workflow to use is accessed through the data_to_use +[\strong{Workflows}] Workflow to use is accessed through the data_to_use param \itemize{ \item{'all' - loads and requires subcellular information from tx_file and diff --git a/man/createGiottoMerscopeObject.Rd b/man/createGiottoMerscopeObject.Rd index 269988444..fa4f6159c 100644 --- a/man/createGiottoMerscopeObject.Rd +++ b/man/createGiottoMerscopeObject.Rd @@ -76,7 +76,7 @@ within the directory where the \strong{bolded} portions are what this function matches against: \itemize{ \item{\strong{cell_boundaries} (folder .hdf5 files)} - \item{\strong{images} (folder of .tif images and a + \item{\strong{images} (folder of .tif images and a scalefactor/transfrom table)} \item{\strong{cell_by_gene}.csv (file)} \item{cell_metadata\strong{fov_positions_file}.csv (file)} diff --git a/man/createGiottoVisiumHDObject.Rd b/man/createGiottoVisiumHDObject.Rd index a903e504b..d0e0c06e0 100644 --- a/man/createGiottoVisiumHDObject.Rd +++ b/man/createGiottoVisiumHDObject.Rd @@ -38,9 +38,9 @@ Giotto object } \details{ \itemize{ - \item{expr_data: raw will take expression data from raw_feature_bc_matrix + \item{expr_data: raw will take expression data from raw_feature_bc_matrix and filter from filtered_feature_bc_matrix} - \item{gene_column_index: which gene identifiers (names) to use if there + \item{gene_column_index: which gene identifiers (names) to use if there are multiple columns (e.g. ensemble and gene symbol)} } } diff --git a/man/createGiottoVisiumObject.Rd b/man/createGiottoVisiumObject.Rd index af34c70be..37d3a345b 100644 --- a/man/createGiottoVisiumObject.Rd +++ b/man/createGiottoVisiumObject.Rd @@ -79,24 +79,24 @@ accepts visium H5 outputs. \details{ If starting from a Visium 10X directory: \itemize{ - \item{expr_data: raw will take expression data from + \item{expr_data: raw will take expression data from raw_feature_bc_matrix and filter from filtered_feature_bc_matrix} - \item{gene_column_index: which gene identifiers (names) to use if there + \item{gene_column_index: which gene identifiers (names) to use if there are multiple columns (e.g. ensemble and gene symbol)} - \item{png_name: by default the first png will be selected, provide the png + \item{png_name: by default the first png will be selected, provide the png name to override this (e.g. myimage.png)} - \item{the file scalefactors_json.json will be detected automatically and + \item{the file scalefactors_json.json will be detected automatically and used to attempt to align the data} } If starting from a Visium 10X .h5 file \itemize{ \item{h5_visium_path: full path to .h5 file: /your/path/to/visium_file.h5} - \item{h5_tissue_positions_path: full path to spatial locations file: + \item{h5_tissue_positions_path: full path to spatial locations file: /you/path/to/tissue_positions_list.csv} - \item{h5_image_png_path: full path to png: + \item{h5_image_png_path: full path to png: /your/path/to/images/tissue_lowres_image.png} - \item{h5_json_scalefactors_path: full path to .json file: + \item{h5_json_scalefactors_path: full path to .json file: /your/path/to/scalefactors_json.json} } } diff --git a/man/crossSectionFeatPlot3D.Rd b/man/crossSectionFeatPlot3D.Rd index 8fed2910f..de82d838d 100644 --- a/man/crossSectionFeatPlot3D.Rd +++ b/man/crossSectionFeatPlot3D.Rd @@ -24,7 +24,7 @@ crossSectionFeatPlot3D( \item{feat_type}{feature type} -\item{crossSection_obj}{cross section object as alternative input. +\item{crossSection_obj}{cross section object as alternative input. default = NULL.} \item{name}{name of virtual cross section to use} diff --git a/man/data_access_params.Rd b/man/data_access_params.Rd index 4a44a7274..8c04d21b8 100644 --- a/man/data_access_params.Rd +++ b/man/data_access_params.Rd @@ -10,16 +10,16 @@ \item{feat_type}{feature type (e.g. "rna", "dna", "protein")} -\item{return_uniques}{return unique nesting names (ignores if final object +\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} \item{output}{what format in which to get information (e.g. "data.table")} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when expression and spat_info are not expected to exist.} -\item{copy_obj}{whether to deep copy/duplicate when getting the object +\item{copy_obj}{whether to deep copy/duplicate when getting the object (default = TRUE)} \item{initialize}{(default = FALSE) whether to initialize the gobject before diff --git a/man/doCellposeSegmentation.Rd b/man/doCellposeSegmentation.Rd index 1bd919987..f7cd9e0e3 100644 --- a/man/doCellposeSegmentation.Rd +++ b/man/doCellposeSegmentation.Rd @@ -38,7 +38,7 @@ doCellposeSegmentation( ) } \arguments{ -\item{image_dir}{character, required. Provide a path to a gray scale or a +\item{image_dir}{character, required. Provide a path to a gray scale or a three channel image.} \item{mask_output}{required. Provide a path to the output mask file.} @@ -47,12 +47,12 @@ three channel image.} \item{channel_2}{channel number for Nuclei, default to 0(gray scale)} -\item{model_name}{Name of the model to run inference. Default to 'cyto3', -if you want to run cutomized trained model, place your model file in +\item{model_name}{Name of the model to run inference. Default to 'cyto3', +if you want to run cutomized trained model, place your model file in ~/.cellpose/models and specify your model name.} -\item{batch_size}{Cellpose Parameter, Number of 224x224 patches to run -simultaneously on the GPU. Can make smaller or bigger depending on GPU +\item{batch_size}{Cellpose Parameter, Number of 224x224 patches to run +simultaneously on the GPU. Can make smaller or bigger depending on GPU memory usage. Defaults to 8.} \item{resample}{Cellpose Parameter} @@ -97,21 +97,23 @@ memory usage. Defaults to 8.} \item{progress}{Cellpose Parameter} -\item{python_path}{python environment with cellpose installed. +\item{python_path}{python environment with cellpose installed. default = "giotto_cellpose".} } \value{ -No return variable, as this will write directly to output path +No return variable, as this will write directly to output path provided. } \description{ -perform the Giotto Wrapper of cellpose segmentation. This is for a model -inference to generate segmentation mask file from input image. +perform the Giotto Wrapper of cellpose segmentation. This is for a model +inference to generate segmentation mask file from input image. main parameters needed } \examples{ # example code -doCellposeSegmentation(image_dir = input_image, -mask_output = output, channel_1 = 2, -channel_2 = 1, model_name = "cyto3", batch_size = 4) +doCellposeSegmentation( + image_dir = input_image, + mask_output = output, channel_1 = 2, + channel_2 = 1, model_name = "cyto3", batch_size = 4 +) } diff --git a/man/dot-estimate_transform_from_matched_descriptor.Rd b/man/dot-estimate_transform_from_matched_descriptor.Rd index 4a5cbc0ad..4cc5b6df8 100644 --- a/man/dot-estimate_transform_from_matched_descriptor.Rd +++ b/man/dot-estimate_transform_from_matched_descriptor.Rd @@ -16,7 +16,7 @@ \arguments{ \item{keypoints1}{keypoints extracted from target image via .sift_detect} -\item{match}{a 2 col matrix of x to y index matched descriptors via +\item{match}{a 2 col matrix of x to y index matched descriptors via .match_descriptor_single} } \value{ diff --git a/man/dot-plot_matched_descriptors.Rd b/man/dot-plot_matched_descriptors.Rd index 9a7de1c3f..5aa7f0b53 100644 --- a/man/dot-plot_matched_descriptors.Rd +++ b/man/dot-plot_matched_descriptors.Rd @@ -13,13 +13,13 @@ \item{keypoints1}{keypoints extracted from target image via .sift_detect} -\item{match}{a 2 col matrix of x to y index matched descriptors via +\item{match}{a 2 col matrix of x to y index matched descriptors via .match_descriptor_single} } \value{ None } \description{ -A wrapper function for the plot_matches for the SIFT feature extractor and +A wrapper function for the plot_matches for the SIFT feature extractor and descriptor pipeline } diff --git a/man/dot-sift_detect.Rd b/man/dot-sift_detect.Rd index dc2480fde..6c1e23c46 100644 --- a/man/dot-sift_detect.Rd +++ b/man/dot-sift_detect.Rd @@ -7,7 +7,7 @@ .sift_detect(x, ..., pkg_ptr) } \arguments{ -\item{x}{input matrix or preprocessed image to extract feature and +\item{x}{input matrix or preprocessed image to extract feature and descriptor from} \item{...}{additional params to pass to `skimage.feature.SIFT()`} @@ -16,6 +16,6 @@ descriptor from} list of keypoints and descriptors } \description{ -Perform feature detector and descriptor extractor on a matrix object or +Perform feature detector and descriptor extractor on a matrix object or preprocessed image object } diff --git a/man/dot-warp_transformed_image.Rd b/man/dot-warp_transformed_image.Rd index 1c2e0756a..0c3f4cb5f 100644 --- a/man/dot-warp_transformed_image.Rd +++ b/man/dot-warp_transformed_image.Rd @@ -11,7 +11,7 @@ \item{y}{target image from .sift_preprocess} -\item{model}{estimated transformation object from +\item{model}{estimated transformation object from .estimate_transform_from_matched_descriptor} } \value{ diff --git a/man/estimateAutomatedImageRegistrationWithSIFT.Rd b/man/estimateAutomatedImageRegistrationWithSIFT.Rd index ee7346a15..cfcc61322 100644 --- a/man/estimateAutomatedImageRegistrationWithSIFT.Rd +++ b/man/estimateAutomatedImageRegistrationWithSIFT.Rd @@ -15,10 +15,10 @@ estimateAutomatedImageRegistrationWithSIFT( ) } \arguments{ -\item{x}{required. Source matrix input, could be generated from +\item{x}{required. Source matrix input, could be generated from preprocessImageToMatrix} -\item{y}{required. Source matrix input, could be generated from +\item{y}{required. Source matrix input, could be generated from preprocessImageToMatrix} \item{plot_match}{whether or not to plot the matching descriptors. @@ -26,20 +26,21 @@ Default False} \item{max_ratio}{max_ratio parameter for matching descriptors, default 0.6} -\item{estimate_fun}{default Affine. The transformation model to use +\item{estimate_fun}{default Affine. The transformation model to use estimation} -\item{save_warp}{default NULL, if not NULL, please provide an output image +\item{save_warp}{default NULL, if not NULL, please provide an output image path to save the warpped image.} } \value{ a list of the estimated transformation object } \description{ -Automatically estimate a transform with SIFT feature detection, descriptor +Automatically estimate a transform with SIFT feature detection, descriptor match and returns a transformation object to use } \examples{ estimation <- estimateAutomatedImageRegistrationWithSIFT( -x = image_mtx1, y = image_mtx2) + x = image_mtx1, y = image_mtx2 +) } diff --git a/man/exportGiottoViewer.Rd b/man/exportGiottoViewer.Rd index 6b6b0e139..d9563a072 100644 --- a/man/exportGiottoViewer.Rd +++ b/man/exportGiottoViewer.Rd @@ -50,7 +50,7 @@ exportGiottoViewer( \item{dim_red_rescale}{numericals to rescale the coordinates} -\item{expression_rounding}{numerical indicating how to round the expression +\item{expression_rounding}{numerical indicating how to round the expression data} \item{overwrite_dir}{overwrite files in the directory if it already existed} @@ -64,9 +64,9 @@ writes the necessary output to use in Giotto Viewer compute highly variable genes } \details{ -Giotto Viewer expects the results from Giotto Analyzer in a -specific format, which is provided by this function. To include enrichment -results from {\code{\link{createSpatialEnrich}}} include the provided -spatial enrichment name (default PAGE or rank) and add the gene signature +Giotto Viewer expects the results from Giotto Analyzer in a +specific format, which is provided by this function. To include enrichment +results from {\code{\link{createSpatialEnrich}}} include the provided +spatial enrichment name (default PAGE or rank) and add the gene signature names (.e.g cell types) to the numeric annotations parameter. } diff --git a/man/filterCombinations.Rd b/man/filterCombinations.Rd index 8d1cd3728..17f2e966b 100644 --- a/man/filterCombinations.Rd +++ b/man/filterCombinations.Rd @@ -56,10 +56,10 @@ transformation} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/giottoToAnndataZarr.Rd b/man/giottoToAnndataZarr.Rd index d89184a62..56b094a15 100644 --- a/man/giottoToAnndataZarr.Rd +++ b/man/giottoToAnndataZarr.Rd @@ -19,7 +19,7 @@ giottoToAnndataZarr( \item{feat_type}{feature type (e.g. "rna", "dna", "protein")} -\item{expression}{expression values to extract (e.g. "raw", "normalized", +\item{expression}{expression values to extract (e.g. "raw", "normalized", "scaled")} \item{output_path}{path to create and save the anndata zarr folder} diff --git a/man/importVisiumHD.Rd b/man/importVisiumHD.Rd index 6d49f3f46..3c08d5bee 100644 --- a/man/importVisiumHD.Rd +++ b/man/importVisiumHD.Rd @@ -20,7 +20,7 @@ importVisiumHD( \arguments{ \item{visiumHD_dir}{Visium HD output directory (e.g. square_016um)} -\item{expression_source}{character. Raw or filter expression data. Defaults +\item{expression_source}{character. Raw or filter expression data. Defaults to "raw"} \item{gene_column_index}{numeric. Expression column to use for gene names @@ -29,16 +29,16 @@ to "raw"} \item{barcodes}{character vector. (optional) Use if you only want to load a subset of the pixel barcodes} -\item{array_subset_row}{numeric vector. (optional) Vector with min and max +\item{array_subset_row}{numeric vector. (optional) Vector with min and max values to subset based on array rows} -\item{array_subset_col}{numeric vector. (optional) Vector with min and max +\item{array_subset_col}{numeric vector. (optional) Vector with min and max values to subset based on array columns} -\item{pxl_subset_row}{numeric vector. (optional) Vector with min and max +\item{pxl_subset_row}{numeric vector. (optional) Vector with min and max values to subset based on row pixels} -\item{pxl_subset_col}{numeric vector. (optional) Vector with min and max +\item{pxl_subset_col}{numeric vector. (optional) Vector with min and max values to subset based on column pixels} } \value{ @@ -46,8 +46,8 @@ VisiumHDReader object } \description{ Giotto import functionalities for Visium HD datasets. This function generates -a `VisiumHDReader` instance that has convenient reader functions for -converting individual pieces of Visium HD data into Giotto-compatible +a `VisiumHDReader` instance that has convenient reader functions for +converting individual pieces of Visium HD data into Giotto-compatible representations when the param `visiumHD_dir` is provided. A function that creates the full `giotto` object is also available. These functions should have all param values provided as defaults, but @@ -58,10 +58,10 @@ directories or paths. Loading functions are generated after the `visiumHD_dir` is added. } \examples{ +\dontrun{ # Create a `VisiumHDReader` object reader <- importVisiumHD() -\dontrun{ # Set the visiumHD_dir reader$visiumHD_dir <- "path to visium HD dir" readerHD$visiumHD_dir <- visiumHD_dir @@ -70,14 +70,16 @@ readerHD$visiumHD_dir <- visiumHD_dir tissue_pos <- readerHD$load_tissue_position() metadata <- readerHD$load_metadata() -Load matrix or create expression object +# Load matrix or create expression object matrix <- readerHD$load_matrix() expression_obj <- readerHD$load_expression() -Load transcript data (cell metadata, expression object, and transcripts per -pixel) -my_transcripts <- readerHD$load_transcripts(array_subset_row = c(500, 1000), - array_subset_col = c(500, 1000)) +# Load transcript data (cell metadata, expression object, and transcripts +# per pixel) +my_transcripts <- readerHD$load_transcripts( + array_subset_row = c(500, 1000), + array_subset_col = c(500, 1000) +) # Create a `giotto` object and add the loaded data # TODO diff --git a/man/interactiveLandmarkSelection.Rd b/man/interactiveLandmarkSelection.Rd index e139cd081..416e4f28a 100644 --- a/man/interactiveLandmarkSelection.Rd +++ b/man/interactiveLandmarkSelection.Rd @@ -7,12 +7,12 @@ interactiveLandmarkSelection(source, target) } \arguments{ -\item{source_image}{the image to be plotted on the left, and landmarks will -output in the first of the list. Input can be a ggplot object, +\item{source_image}{the image to be plotted on the left, and landmarks will +output in the first of the list. Input can be a ggplot object, a GiottoImage, or a character represent a path to a image} -\item{target_image}{the image to be plotted on the right, and landmarks will -output in the second of the list. Input can be a ggplot object, a +\item{target_image}{the image to be plotted on the right, and landmarks will +output in the second of the list. Input can be a ggplot object, a GiottoImage, or a character represent a path to a image} } \value{ diff --git a/man/jackstrawPlot.Rd b/man/jackstrawPlot.Rd index 1a4778a85..988cbdde0 100644 --- a/man/jackstrawPlot.Rd +++ b/man/jackstrawPlot.Rd @@ -68,10 +68,10 @@ speed up calculation} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/pieCellTypesFromEnrichment.Rd b/man/pieCellTypesFromEnrichment.Rd index d66ddbf18..a034f5c50 100644 --- a/man/pieCellTypesFromEnrichment.Rd +++ b/man/pieCellTypesFromEnrichment.Rd @@ -32,10 +32,10 @@ Default value is "PAGE_Z_score"} \item{title}{Title of the generated plot. Default `paste0(spat_unit,"cell types (maximum", enrichment_name, ")")`} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} \item{save_plot}{logical. save the plot} diff --git a/man/plotCCcomDotplot.Rd b/man/plotCCcomDotplot.Rd index f6f115ebc..fe34da731 100644 --- a/man/plotCCcomDotplot.Rd +++ b/man/plotCCcomDotplot.Rd @@ -58,10 +58,10 @@ or 'sequential' (scaled based on data range)} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCCcomHeatmap.Rd b/man/plotCCcomHeatmap.Rd index af80a6f3f..4328623e0 100644 --- a/man/plotCCcomHeatmap.Rd +++ b/man/plotCCcomHeatmap.Rd @@ -57,10 +57,10 @@ or 'sequential' (scaled based on data range)} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCPF.Rd b/man/plotCPF.Rd index 1a7839777..1b420ae30 100644 --- a/man/plotCPF.Rd +++ b/man/plotCPF.Rd @@ -63,10 +63,10 @@ named vector of colors} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCTCompositionInNicheCluster.Rd b/man/plotCTCompositionInNicheCluster.Rd index 6e05a9db9..caba7f265 100644 --- a/man/plotCTCompositionInNicheCluster.Rd +++ b/man/plotCTCompositionInNicheCluster.Rd @@ -38,10 +38,10 @@ assigned to each niche cluster} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCellProximityFeatSpot.Rd b/man/plotCellProximityFeatSpot.Rd index 3648628a8..05cde1919 100644 --- a/man/plotCellProximityFeatSpot.Rd +++ b/man/plotCellProximityFeatSpot.Rd @@ -58,10 +58,10 @@ plotCellProximityFeatSpot( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCellProximityFeats.Rd b/man/plotCellProximityFeats.Rd index f12ab5c9c..4219264d5 100644 --- a/man/plotCellProximityFeats.Rd +++ b/man/plotCellProximityFeats.Rd @@ -63,10 +63,10 @@ named vector of colors} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCellTypeNTScore.Rd b/man/plotCellTypeNTScore.Rd index 391ef68c7..6963929e2 100644 --- a/man/plotCellTypeNTScore.Rd +++ b/man/plotCellTypeNTScore.Rd @@ -32,10 +32,10 @@ plotCellTypeNTScore( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCellTypesFromEnrichment.Rd b/man/plotCellTypesFromEnrichment.Rd index b12e39317..2828bbd6e 100644 --- a/man/plotCellTypesFromEnrichment.Rd +++ b/man/plotCellTypesFromEnrichment.Rd @@ -32,10 +32,10 @@ Default value is "PAGE_Z_score"} \item{title}{Title of the generated plot. Default `paste0(spat_unit,"cell types (maximum", enrichment_name, ")")`} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} \item{save_plot}{logical. save the plot} diff --git a/man/plotCombineCCcom.Rd b/man/plotCombineCCcom.Rd index 8f4190809..c7a228d1d 100644 --- a/man/plotCombineCCcom.Rd +++ b/man/plotCombineCCcom.Rd @@ -53,10 +53,10 @@ ligand-receptor pair} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCombineCellCellCommunication.Rd b/man/plotCombineCellCellCommunication.Rd index df01e73db..6ef7324a3 100644 --- a/man/plotCombineCellCellCommunication.Rd +++ b/man/plotCombineCellCellCommunication.Rd @@ -53,10 +53,10 @@ ligand-receptor pair} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCombineICF.Rd b/man/plotCombineICF.Rd index 00ce75d20..f0052a24a 100644 --- a/man/plotCombineICF.Rd +++ b/man/plotCombineICF.Rd @@ -52,10 +52,10 @@ plotCombineICF( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotCombineInteractionChangedFeats.Rd b/man/plotCombineInteractionChangedFeats.Rd index d572331fb..e60c9cc19 100644 --- a/man/plotCombineInteractionChangedFeats.Rd +++ b/man/plotCombineInteractionChangedFeats.Rd @@ -52,10 +52,10 @@ plotCombineInteractionChangedFeats( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotICF.Rd b/man/plotICF.Rd index 1b2c64cf9..af9ac36c3 100644 --- a/man/plotICF.Rd +++ b/man/plotICF.Rd @@ -38,10 +38,10 @@ named vector of colors} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotICFSpot.Rd b/man/plotICFSpot.Rd index 4e315a36d..bd97b24c6 100644 --- a/man/plotICFSpot.Rd +++ b/man/plotICFSpot.Rd @@ -37,10 +37,10 @@ plotICFSpot( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotInteractionChangedFeats.Rd b/man/plotInteractionChangedFeats.Rd index 24896a35c..9fbfddba0 100644 --- a/man/plotInteractionChangedFeats.Rd +++ b/man/plotInteractionChangedFeats.Rd @@ -38,10 +38,10 @@ named vector of colors} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotNicheClusterConnectivity.Rd b/man/plotNicheClusterConnectivity.Rd index e29c1c52b..df29185a1 100644 --- a/man/plotNicheClusterConnectivity.Rd +++ b/man/plotNicheClusterConnectivity.Rd @@ -31,10 +31,10 @@ plotNicheClusterConnectivity( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotRankSpatvsExpr.Rd b/man/plotRankSpatvsExpr.Rd index 12dc92595..0433445a8 100644 --- a/man/plotRankSpatvsExpr.Rd +++ b/man/plotRankSpatvsExpr.Rd @@ -58,10 +58,10 @@ percentage of top spatial ranks are recovered} \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotRecovery.Rd b/man/plotRecovery.Rd index 163c1b6d1..838a1a71e 100644 --- a/man/plotRecovery.Rd +++ b/man/plotRecovery.Rd @@ -34,10 +34,10 @@ plotRecovery( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plotSpatNicheClusterBin.Rd b/man/plotSpatNicheClusterBin.Rd index 426e3afd3..b42f122dc 100644 --- a/man/plotSpatNicheClusterBin.Rd +++ b/man/plotSpatNicheClusterBin.Rd @@ -21,7 +21,7 @@ plotSpatNicheClusterBin( \item{...}{additional arguments to be passed to the spatFeatPlot2D function} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} \item{niche_cluster_label}{name of the niche cluster label} diff --git a/man/plotSpatNicheClusterProb.Rd b/man/plotSpatNicheClusterProb.Rd index 22fec4334..25024cffd 100644 --- a/man/plotSpatNicheClusterProb.Rd +++ b/man/plotSpatNicheClusterProb.Rd @@ -25,7 +25,7 @@ values} \item{...}{additional arguments to be passed to the spatFeatPlot2D function} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plot_cell_params.Rd b/man/plot_cell_params.Rd index 05f8f67c1..997606260 100644 --- a/man/plot_cell_params.Rd +++ b/man/plot_cell_params.Rd @@ -7,7 +7,7 @@ \item{cell_color}{character. what to color cells by (e.g. metadata col or spatial enrichment col)} -\item{color_as_factor}{logical. convert color column to factor. discrete +\item{color_as_factor}{logical. convert color column to factor. discrete colors are used when this is TRUE. continuous colors when FALSE.} \item{cell_color_code}{character. discrete colors to use. palette to use or diff --git a/man/plot_dimred_params.Rd b/man/plot_dimred_params.Rd index 0552eff17..10fe42433 100644 --- a/man/plot_dimred_params.Rd +++ b/man/plot_dimred_params.Rd @@ -22,7 +22,7 @@ \item{dim_point_border_col}{border color of points in dim. reduction space} -\item{dim_point_border_stroke}{border stroke of points in dim. reduction +\item{dim_point_border_stroke}{border stroke of points in dim. reduction space} } \value{ diff --git a/man/plot_image_params.Rd b/man/plot_image_params.Rd index 5eed3e533..4942d6b66 100644 --- a/man/plot_image_params.Rd +++ b/man/plot_image_params.Rd @@ -10,7 +10,7 @@ \item{image_name}{name of a giotto image or multiple images with group_by} -\item{largeImage_name}{name of a giottoLargeImage or multiple images with +\item{largeImage_name}{name of a giottoLargeImage or multiple images with group_by} } \value{ diff --git a/man/plot_nn_net_params.Rd b/man/plot_nn_net_params.Rd index 6e53ca66b..0644694d6 100644 --- a/man/plot_nn_net_params.Rd +++ b/man/plot_nn_net_params.Rd @@ -8,10 +8,10 @@ \item{nn_network_to_use}{character. type of NN network to use (kNN vs sNN)} -\item{network_name}{character. name of NN network to use, if +\item{network_name}{character. name of NN network to use, if show_NN_network = TRUE} -\item{nn_network_name}{character. name of NN network to use, if +\item{nn_network_name}{character. name of NN network to use, if show_NN_network = TRUE} \item{network_color}{color of NN network} diff --git a/man/plot_output_params.Rd b/man/plot_output_params.Rd index 4d7f5e501..c14d597e0 100644 --- a/man/plot_output_params.Rd +++ b/man/plot_output_params.Rd @@ -10,10 +10,10 @@ \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/plot_params.Rd b/man/plot_params.Rd index 6a2a94bb1..7a68a059b 100644 --- a/man/plot_params.Rd +++ b/man/plot_params.Rd @@ -4,7 +4,7 @@ \alias{plot_params} \title{Params documentation template: plot_params} \arguments{ -\item{group_by}{character. Create multiple plots based on cell annotation +\item{group_by}{character. Create multiple plots based on cell annotation column} \item{group_by_subset}{character. subset the group_by factor column} @@ -19,7 +19,7 @@ or 'sequential' (scaled based on data range)} \item{gradient_color}{character. continuous colors to use. palette to use or vector of colors to use (minimum of 2).} -\item{select_cell_groups}{select subset of cells/clusters based on +\item{select_cell_groups}{select subset of cells/clusters based on cell_color parameter} \item{select_cells}{select subset of cells based on cell IDs} diff --git a/man/plot_poly_params.Rd b/man/plot_poly_params.Rd index da343befe..d699e688e 100644 --- a/man/plot_poly_params.Rd +++ b/man/plot_poly_params.Rd @@ -12,16 +12,16 @@ \item{polygon_color}{color for polygon border} -\item{polygon_bg_color}{color for polygon background (overruled by +\item{polygon_bg_color}{color for polygon background (overruled by polygon_fill)} -\item{polygon_fill}{character. what to color to fill polgyons by (e.g. +\item{polygon_fill}{character. what to color to fill polgyons by (e.g. metadata col or spatial enrichment col)} -\item{polygon_fill_gradient}{polygon fill gradient colors given in order +\item{polygon_fill_gradient}{polygon fill gradient colors given in order from low to high} -\item{polygon_fill_gradient_midpoint}{value to set as gradient midpoint +\item{polygon_fill_gradient_midpoint}{value to set as gradient midpoint (optional). If left as \code{NULL}, the median value detected will be chosen} \item{polygon_fill_gradient_style}{either 'divergent' (midpoint is used in diff --git a/man/plot_spatenr_params.Rd b/man/plot_spatenr_params.Rd index 8e329332a..fe38e0fe4 100644 --- a/man/plot_spatenr_params.Rd +++ b/man/plot_spatenr_params.Rd @@ -4,7 +4,7 @@ \alias{plot_spatenr_params} \title{Params documentation template: plot_spatenr_params} \arguments{ -\item{spat_enr_names}{character. names of spatial enrichment results to +\item{spat_enr_names}{character. names of spatial enrichment results to include} } \value{ diff --git a/man/preprocessImageToMatrix.Rd b/man/preprocessImageToMatrix.Rd index 1d564d2df..28d9a1e44 100644 --- a/man/preprocessImageToMatrix.Rd +++ b/man/preprocessImageToMatrix.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/image_registration.R \name{preprocessImageToMatrix} \alias{preprocessImageToMatrix} -\title{Preprocess from image directory to the required matrix format for +\title{Preprocess from image directory to the required matrix format for Image registration pipeline built on scikit-image} \usage{ preprocessImageToMatrix( @@ -20,29 +20,29 @@ preprocessImageToMatrix( \arguments{ \item{x}{input file path, required} -\item{invert}{whether or not to invert intensity to make calculation of +\item{invert}{whether or not to invert intensity to make calculation of descriptors more accurate, default FALSE} -\item{equalize_histogram}{whether or not to calculate equalized histogram of +\item{equalize_histogram}{whether or not to calculate equalized histogram of the image,default TRUE} \item{flip_vertical}{whether or not to flip vertical, default FALSE} \item{flip_horizontal}{whether or not to flip horizontal, default FALSE} -\item{rotate_90}{whether or not to rotates the image 90 degrees +\item{rotate_90}{whether or not to rotates the image 90 degrees counter-clockwise, default FALSE} -\item{use_single_channel}{If input is a multichannel image, whether or not +\item{use_single_channel}{If input is a multichannel image, whether or not to extract single channel, default FALSE} -\item{single_channel_number}{Channel number in the multichannel image, +\item{single_channel_number}{Channel number in the multichannel image, required if use_single_channel = TRUE} } \value{ a matrix array to input to .sift_detect } \description{ -Preprocess a image path to the required matrix format for Image +Preprocess a image path to the required matrix format for Image registration pipeline built on scikit-image } diff --git a/man/runPatternSimulation.Rd b/man/runPatternSimulation.Rd index cdcd2d6ca..4a630fde0 100644 --- a/man/runPatternSimulation.Rd +++ b/man/runPatternSimulation.Rd @@ -91,7 +91,7 @@ runPatternSimulation( "AAAGGGATGTAGCAAG-1", "TCAAACAACCGCGTCG-1", "ACGATCATACATAGAG-1", "TATGCTCCCTACTTAC-1" ), - spatial_network_name = "spatial_network", + spatial_network_name = "spatial_network", gene_names = c("Gna12", "Ccnd2") ) } diff --git a/man/screePlot.Rd b/man/screePlot.Rd index 04bf2f287..45aba794d 100644 --- a/man/screePlot.Rd +++ b/man/screePlot.Rd @@ -65,10 +65,10 @@ screePlot( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} \item{...}{additional arguments to pca function, see \code{\link{runPCA}}} diff --git a/man/signPCA.Rd b/man/signPCA.Rd index 93e38cc4a..620ca9aa1 100644 --- a/man/signPCA.Rd +++ b/man/signPCA.Rd @@ -73,10 +73,10 @@ signPCA( \item{save_plot}{logical. save the plot} -\item{save_param}{list of saving parameters, see +\item{save_param}{list of saving parameters, see \code{\link{showSaveParameters}}} -\item{default_save_name}{default save name for saving, don't change, +\item{default_save_name}{default save name for saving, don't change, change save_name in save_param} } \value{ diff --git a/man/writeChatGPTqueryDEG.Rd b/man/writeChatGPTqueryDEG.Rd index d51cb7230..1266a17c1 100644 --- a/man/writeChatGPTqueryDEG.Rd +++ b/man/writeChatGPTqueryDEG.Rd @@ -13,7 +13,7 @@ writeChatGPTqueryDEG( ) } \arguments{ -\item{DEG_output}{the output format from the differential expression +\item{DEG_output}{the output format from the differential expression functions} \item{top_n_genes}{number of genes for each cluster} @@ -28,12 +28,12 @@ functions} writes a .txt file to the desired location } \description{ -This function writes a query as a .txt file that can be used -with ChatGPT or a similar LLM service to find the most likely cell types -based on the top differential expressed genes (DEGs) between identified +This function writes a query as a .txt file that can be used +with ChatGPT or a similar LLM service to find the most likely cell types +based on the top differential expressed genes (DEGs) between identified clusters. } \details{ -This function does not run any LLM service. It simply creates the +This function does not run any LLM service. It simply creates the .txt file that can then be used any LLM service (e.g. OpenAI, Gemini, ...) } diff --git a/man/write_giotto_viewer_dim_reduction.Rd b/man/write_giotto_viewer_dim_reduction.Rd index f42775b91..1238455a6 100644 --- a/man/write_giotto_viewer_dim_reduction.Rd +++ b/man/write_giotto_viewer_dim_reduction.Rd @@ -30,7 +30,7 @@ write_giotto_viewer_dim_reduction( write a .txt and .annot file for the selection annotation } \description{ -write out dimensional reduction data from a giotto object for +write out dimensional reduction data from a giotto object for the Viewer } \keyword{internal} diff --git a/man/write_giotto_viewer_numeric_annotation.Rd b/man/write_giotto_viewer_numeric_annotation.Rd index e3101f756..726d28c15 100644 --- a/man/write_giotto_viewer_numeric_annotation.Rd +++ b/man/write_giotto_viewer_numeric_annotation.Rd @@ -21,7 +21,7 @@ write_giotto_viewer_numeric_annotation( write a .txt and .annot file for the selection annotation } \description{ -write out numeric annotation data from a giotto object for the +write out numeric annotation data from a giotto object for the Viewer } \keyword{internal}