Merge pull request #40 from lorenzobonaguro/dev_lb

Push changes for version 0.3.1 to Dev

Author: lorenzobonaguro

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: cyCONDOR
 Type: Package
 Title: Flow Cytometry data analysis toolbox
-Version: 0.3.0
+Version: 0.3.1
 Authors@R: c(
   person(given = "Lorenzo", family = "Bonaguro", email = "lorenzo.bonaguro@dzne.de", role = c("aut", "cre")),
   person(given = "Charlotte", family = "Kroeger", email = "charlotte.kroeger@dzne.de", role = "aut"),
@@ -13,7 +13,8 @@ Authors@R: c(
   )
 Description: Flow cytometry analysis workflow. The aim of this project is to 
     provide an intuitive workflow for the analysis of high-dimensionality cytometry data in R.
-URL: https://lorenzobonaguro.github.io/cyCONDOR
+URL: https://lorenzobonaguro.github.io/cyCONDOR, https://github.com/lorenzobonaguro/cyCONDOR
+template:
 License: GPL-3 + file LICENSE
 Encoding: UTF-8
 biocViews:

NEWS.md

@@ -1,3 +1,14 @@
+# cyCONDOR 0.3.1
+* Added function `condor_info` to easily explore the content of a condor object.
+* Solved Issue #31, color pallette is reversed in `plot_marker_ridgeplot()` function.
+* Solved Issue #30, the pseudotime function can now use a `prefix` argument.
+* Improved documentation regarding the use of different co-factors when using the archsin data transformation.
+* Solved Issue #33, the `plot_marker_dotplot` function have now an `alpha` argument to control the transparency of the dots.
+* Solved Issue #34, the `plot_marker_ridgeplot` now have a `title` argument.
+* Solved Issue #19, if an empty `fcs` or `csv` file is provided the `prep_fcd` function will stop and point to the corrupted file.
+* Added function `order_param` to allow manual ordering of an annotation or clustering variable.
+* Added `prefix` argument to `astir` functions.
+
 # cyCONDOR 0.3.0
 * Bug fix with data projection where specific parameters were removed in UMAP calculation
 * Updated official Docker image to the latest Bioconductor version (Bioconductor 3.20, R 4.4.2)

R/astir.R

@@ -22,7 +22,8 @@ runAstir_celltype <- function(fcd,
                               manifest_name,
                               max_epochs,
                               learning_rate,
-                              initial_epochs) {
+                              initial_epochs,
+                              prefix = "") {
 
   # Save the expression matrix as csv
   write.csv(x = fcd$expr[[data_slot]], file = paste0(analysis_path, "expr.csv"))
@@ -67,7 +68,7 @@ runAstir_celltype <- function(fcd,
                                         "Learning_Rate_", learning_rate,
                                         "_Initial_Epochs_", initial_epochs))
 
-  fcd[["astir"]][[paste0("Astir_cell_type_", data_slot)]] <- df
+  fcd[["astir"]][[paste(prefix, "Astir_cell_type", data_slot, sep = "_")]] <- df
 
   return(fcd)
 
@@ -96,7 +97,8 @@ runAstir_cellstates <- function(fcd,
                                 manifest_name,
                                 max_epochs,
                                 learning_rate,
-                                initial_epochs) {
+                                initial_epochs,
+                                prefix = "") {
 
   # Save the expression matrix as csv
   write.csv(x = fcd$expr[[data_slot]], file = paste0(analysis_path, "expr.csv"))
@@ -136,7 +138,7 @@ runAstir_cellstates <- function(fcd,
                                         "Learning_Rate_", learning_rate,
                                         "_Initial_Epochs_", initial_epochs))
 
-  fcd[["astir"]][[paste0("Astir_cell_state_", data_slot)]] <- df
+  fcd[["astir"]][[paste(prefix, "Astir_cell_state", data_slot, sep = "_")]] <- df
 
   return(fcd)
 

R/data_load_and_transform.R

@@ -79,6 +79,12 @@ read_data <- function(data_path,
 
       single_file_red <- exprs(flow_frame_single)
 
+      if (dim(single_file_red)[1] == 0) {
+
+        stop(paste0("File: ", data_files[FileNum], " contains no valid event"))
+
+      }
+
       ## Downsample if needed
       if (nrow(single_file_red) <= max_cells) {
         single_file_red <- single_file_red
@@ -133,6 +139,12 @@ read_data <- function(data_path,
 
       single_file_red <- read.delim(paste0(data_path,"/",data_files[FileNum]), check.names = F, sep = separator)
 
+      if (dim(single_file_red)[1] == 0) {
+
+        stop(paste0("File: ", data_files[FileNum], " contains no valid event"))
+
+      }
+
       ## Downsample if needed
       if (nrow(single_file_red) <= max_cells){
         single_file_red <- single_file_red

R/data_visualization.R

@@ -258,6 +258,8 @@ plot_dim_red <- function(fcd,
                          cluster_slot = NULL,
                          add_pseudotime = FALSE,
                          pseudotime_slot,
+                         add_astir = FALSE,
+                         astir_slot,
                          param,
                          order = FALSE,
                          title = "Dimensionality Reduction Plot",
@@ -327,6 +329,12 @@ plot_dim_red <- function(fcd,
 
   }
 
+  if (isTRUE(add_astir)) {
+
+    data <- cbind(data, fcd$astir[[astir_slot]])
+
+  }
+
   # Check if `param` exist
   if(!param %in% colnames(data)){
     stop('column "',param,'" is not available in the provided data')
@@ -1523,6 +1531,7 @@ plot_marker_boxplot<- function(fcd,
 #' @param seed a seed is set for reproducibility of the plotting result.
 #' @param color_palette vector of colors that should be used to color dots.
 #' @param dot_size numeric indicating the size of the dots.
+#' @param alpha transparency of the dots.
 #' @param title Title of the plot.
 #' @import ggplot2
 #' @return The function returns a scatter plot of two features available in the expression matrix. By default, dots are colored by cell population label provided in cluster_var. If coloring by a metadata is wanted instead, a group_var can be defined. Further, if only a selection of levels available in cluster_var should be included in plotting, a vector of labels of interest can be provided to cluster_to_show argument.
@@ -1540,7 +1549,8 @@ plot_marker_dotplot <- function(fcd,
                                 order = F,
                                 seed = 91,
                                 color_palette = cluster_palette,
-                                dot_size=2,
+                                dot_size = 2,
+                                alpha = 1,
                                 title ="") {
 
   #### check slots, cellIDs und varibles
@@ -1623,7 +1633,7 @@ plot_marker_dotplot <- function(fcd,
     }
 
     p <- ggplot(data, aes(x = X, y = Y)) +
-      geom_point(aes(color = group_var), size = dot_size) +
+      geom_point(aes(color = group_var), size = dot_size, alpha = alpha) +
       theme_bw()+
       theme(aspect.ratio = 1, panel.grid = element_blank())+
       ggtitle(title) +
@@ -1645,7 +1655,7 @@ plot_marker_dotplot <- function(fcd,
     }
 
     p <- ggplot(data, aes(x = X, y = Y)) +
-      geom_point(aes(color = cluster), size = dot_size) +
+      geom_point(aes(color = cluster), size = dot_size, alpha = alpha) +
       theme_bw()+
       theme(aspect.ratio = 1, panel.grid = element_blank())+
       ggtitle(title) +
@@ -1815,6 +1825,7 @@ plot_marker_density <- function(fcd,
 #' @param cluster_to_show (optional) vector of strings indicating levels in cluster_var that should be included for plotting.
 #' @param color_palette vector of colors to be used to fill density distributions.
 #' @param alpha numeric, adjust alpha to be used on fill color of density distributions.
+#' @param title Title of the plot.
 #' @import ggridges
 #' @returns \code{plot_marker_ridgeplot()} returns either one plot in case only one marker is provided via \code{marker} argument or a list of plots, if several markers are requested.
 #' @details The ridgeline plots are plotted with default parameters of ggridges's \code{\link[ggridges]{geom_density_ridges}}
@@ -1826,8 +1837,9 @@ plot_marker_ridgeplot<- function(fcd,
                                  cluster_slot,
                                  cluster_var,
                                  cluster_to_show = NULL,
-                                 color_palette = cluster_palette,
-                                 alpha = 1){
+                                 color_palette = rev(cluster_palette),
+                                 alpha = 1,
+                                 title = ""){
 
   #### check slots, cellIDs und varibles
   checkInput(fcd = fcd,
@@ -1900,6 +1912,7 @@ plot_marker_ridgeplot<- function(fcd,
       scale_y_discrete(expand = expand_scale(mult = c(0.01, 0.2))) +
       scale_fill_manual(values = color_palette) +
       theme(legend.position = "none") +
+      ggtitle(title) +
       xlab("expression") + ylab(cluster_var) + ggtitle(i)
 
     plot.list[[i]] <- p

R/misc.R

@@ -563,3 +563,127 @@ condor_session_info <- function(fcd = condor) {
   return(tmp)
 }
 
+#' condor_info
+#'
+#' @title condor_info
+#' @description This function prints an overview of the details of the condor object
+#' @param fcd flow cytometry dataset
+#'
+#' @returns Prints to the console the detail of the condor object
+#'
+#' @export
+
+condor_info <- function(fcd = condor) {
+
+  if (!class(fcd) == "flow_cytometry_dataframe") {
+
+    stop("The provided fcd is not a condor object")
+
+  }
+
+  writeLines(paste0("condor object with: ",
+               dim(fcd$expr$orig)[1],
+               " cells ",
+               dim(fcd$expr$orig)[2],
+               " parameters across ",
+               length(unique(fcd$anno$cell_anno$expfcs_filename)), " samples", "\n"))
+
+  writeLines("Available Data Slots:\n")
+
+  writeLines(names(fcd$expr))
+
+  writeLines("\nAvailable Dimensionality Reductions:\n")
+
+  available_dim_red <- names(fcd)[names(fcd) %in% c("pca", "umap", "tSNE")]
+
+  if (length(available_dim_red) == 0) {
+
+    writeLines("none")
+
+  } else {
+
+    for (dr in available_dim_red) {
+
+      writeLines(paste0(dr,": ", names(fcd[[dr]])))
+
+    }
+  }
+
+  writeLines("\nAvailable Clustering:\n")
+
+  if (length(names(fcd$clustering)) == 0) {
+
+    writeLines("none")
+
+  } else {
+
+    writeLines(names(fcd$clustering))
+
+  }
+
+}
+
+#' order_param
+#'
+#' @title order_param
+#' @description This function helps to re-oder the levels of a variable to allow a personalized order for plotting.
+#' @param fcd flow cytometry dataset.
+#' @param type This function can be used to re-order either a metadata annotation or a clustering label (metacluster).
+#' @param cluster_slot string specifying which clustering slot to use to find variable specified in param. Necessary only if type is "cluster".
+#' @param param Parameter to reorder.
+#' @param new_order A vector describing the new order asigned to the labels.
+#' @returns Returns a condor object with a reordered variable
+#'
+#' @export
+
+order_param <- function(fcd,
+                        type,
+                        cluster_slot,
+                        param,
+                        new_order) {
+
+  #First check if the fcd is a valid condor object
+  if (class(fcd) != "flow_cytometry_dataframe") {
+
+    stop("The provided object is not a valid condor object")
+
+  }
+
+  #Decide which variable need to be adjusted
+  if (type == "anno") {
+
+    # Check if the provided order covers all of the selected variable
+    if (setequal(unique(fcd$anno$cell_anno[[param]]), new_order)) {
+
+      # If the check is passed the factor is reordered
+      fcd$anno$cell_anno[[param]] <- factor(fcd$anno$cell_anno[[param]], levels = new_order)
+
+      message("The variable was reordered successfully")
+
+    }
+
+  }
+
+  if (type == "cluster") {
+
+    # Check if the provided order covers all of the selected variable
+    if (setequal(unique(fcd$clustering[[cluster_slot]][[param]]), new_order)) {
+
+      # If the check is passed the factor is reordered
+      fcd$clustering[[cluster_slot]][[param]] <- factor(fcd$clustering[[cluster_slot]][[param]], levels = new_order)
+
+      message("The variable was reordered successfully")
+
+    }
+
+  }
+
+  if (sum(type == c("anno", "cluster")) == 0) {
+
+    stop("The provided 'type' valiable is not valid, please use either 'anno' or 'cluster'")
+
+  }
+
+  return(fcd)
+
+}

R/pseudotime.R

@@ -25,6 +25,7 @@
 #' @param smoother choice of scatter plot smoother. Same as principal_curve, but "lowess" option is replaced with "loess" for additional flexibility.
 #' @param shrink.method character denoting how to determine the appropriate amount of shrinkage for a branching lineage. Accepted values are the same as for kernel in density (default is "cosine"), as well as "tricube" and "density". See 'Details' for more.
 #' @param allow.breaks logical, determines whether curves that branch very close to the origin should be allowed to have different starting points.
+#' @param prefix Optional prefix for the slot name of the output.
 #' @param seed A seed is set for reproducibility.
 #' @details `runPseudotime()` is a wrapper function around \code{\link[slingshot]{getLineages}} and \code{\link[slingshot]{getCurves}} implemented in the package *slingshot*.
 #' The function first calculated the linages and then the curves of the pseudotime and converts the result to a format compatible with the structure of the 'condor' object. The user can specify all the parameters available for the \code{\link[slingshot]{getLineages}} and  \code{\link[slingshot]{getCurves}} functions, arguments description were copied from the documentation of the *slingshot* package.
@@ -56,6 +57,7 @@ runPseudotime <- function(fcd,
                           smoother = "smooth.spline",
                           shrink.method = "cosine",
                           allow.breaks = TRUE,
+                          prefix = NULL,
                           seed = 91) {
 
 
@@ -115,15 +117,15 @@ runPseudotime <- function(fcd,
 
   if (is.null(start.clus)) {
 
-    fcd[["extras"]][[paste("slingshot", reduction_method, reduction_slot, sep = "_")]] <- pseudotime_extra
+    fcd[["extras"]][[paste("slingshot", prefix, reduction_method, reduction_slot, sep = "_")]] <- pseudotime_extra
 
-    fcd[["pseudotime"]][[paste("slingshot", reduction_method, reduction_slot, sep = "_")]] <- curve
+    fcd[["pseudotime"]][[paste("slingshot", prefix, reduction_method, reduction_slot, sep = "_")]] <- curve
 
   } else {
 
-    fcd[["extras"]][[paste("slingshot", reduction_method, reduction_slot, start.clus, sep = "_")]] <- pseudotime_extra
+    fcd[["extras"]][[paste("slingshot", prefix, reduction_method, reduction_slot, start.clus, sep = "_")]] <- pseudotime_extra
 
-    fcd[["pseudotime"]][[paste("slingshot", reduction_method, reduction_slot, start.clus, sep = "_")]] <- curve
+    fcd[["pseudotime"]][[paste("slingshot", prefix, reduction_method, reduction_slot, start.clus, sep = "_")]] <- curve
 
   }
 

_pkgdown.yml

@@ -1,4 +1,4 @@
-url: https://lorenzobonaguro.github.io/cyCONDOR
+url: https://lorenzobonaguro.github.io/cyCONDOR, https://github.com/lorenzobonaguro/cyCONDOR
 template:
   bootstrap: 5
   light-switch: true
@@ -107,6 +107,8 @@ reference:
 
 articles:
 - title: Detailed cyCONDOR workflows
+  desc: >
+    cyCONDOR tutorials
   navbar: ~
   contents:
   - Prepare_data_for_cyCONDOR_analysis
@@ -123,3 +125,9 @@ articles:
   - Machine_learning_classifier
   - Cell_type_prediction
   - Other_utilities
+
+- title: Other workflows
+  desc: >
+    Additional analytical workflows
+  contents: 
+  - Workflow_merge_panels