Merge pull request #400 from cole-trapnell-lab/develop

Develop

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: monocle3
 Title: Clustering, differential expression, and trajectory analysis for single-
     cell RNA-Seq
-Version: 0.2.2
+Version: 0.2.3.0
 Authors@R: 
     person(given = "Hannah",
            family = "Pliner",
@@ -27,7 +27,7 @@ License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 LinkingTo: 
     Rcpp
 Depends:

NEWS.md

@@ -1,3 +1,13 @@
+# monocle3 0.2.3
+
+### Changes
+* Added clear_cds parameter to choose_cells().
+
+### Bug fixes
+* Documentation and error reports improvements.
+* Fixed issue #316, top_marker()
+* Fixed issue #346, find_gene_modules()
+
 # monocle3 0.2.2
 
 ### Changes

R/cluster_genes.R

@@ -68,9 +68,9 @@ find_gene_modules <- function(cds,
 
   preprocess_mat <- cds@preprocess_aux$gene_loadings
   if (is.null(cds@preprocess_aux$beta) == FALSE){
-    preprocess_mat = preprocess_mat %*% (-cds@preprocess_aux$beta)
+    preprocess_mat <- sweep( preprocess_mat, 2, cds@preprocess_aux$beta[,1], '*')
   }
-  preprocess_mat = preprocess_mat[intersect(rownames(cds), row.names(preprocess_mat)),]
+  preprocess_mat <- preprocess_mat[intersect(rownames(cds), row.names(preprocess_mat)),]
 
   # uwot::umap uses a random number generator
   if( random_seed != 0L )
@@ -218,14 +218,14 @@ aggregate_gene_expression <- function(cds,
 
   if (is.null(cell_group_df) == FALSE){
 
-    cell_group_df = as.data.frame(cell_group_df)
-    cell_group_df = cell_group_df[cell_group_df[,1] %in% row.names(pData(cds)),,
+    cell_group_df <- as.data.frame(cell_group_df)
+    cell_group_df <- cell_group_df[cell_group_df[,1] %in% row.names(pData(cds)),,
                                   drop=FALSE]
-    agg_mat = agg_mat[,cell_group_df[,1]]
-    agg_mat = my.aggregate.Matrix(Matrix::t(agg_mat),
+    agg_mat <- agg_mat[,cell_group_df[,1]]
+    agg_mat <- my.aggregate.Matrix(Matrix::t(agg_mat),
                                   as.factor(cell_group_df[,2]),
                                   fun="mean")
-    agg_mat = Matrix::t(agg_mat)
+    agg_mat <- Matrix::t(agg_mat)
   }
 
   if (exclude.na){

R/find_markers.R

@@ -179,24 +179,26 @@ top_markers <- function(cds,
                                                         pseudo_R2,
                                                         lrtest_p_value,
                                                         lrtest_q_value)
+
     marker_test_res = marker_test_res %>% dplyr::rename(gene_id=rowname, marker_test_p_value=lrtest_p_value,  marker_test_q_value=lrtest_q_value)
     marker_test_res$pseudo_R2 = unlist(marker_test_res$pseudo_R2)
     marker_test_res$marker_test_p_value = unlist(marker_test_res$marker_test_p_value)
-
-    if ("gene_short_name" %in% colnames(rowData(cds)))
+    if ("gene_short_name" %in% colnames(rowData(cds))){
       marker_test_res = rowData(cds) %>%
       as.data.frame %>%
       tibble::rownames_to_column() %>%
       dplyr::select(rowname, gene_short_name) %>%
       dplyr::inner_join(marker_test_res, by=c("rowname"="gene_id"))
+      marker_test_res = marker_test_res %>% dplyr::rename(gene_id=rowname)
+    }
   } else {
     marker_test_res = cluster_marker_score_table
+    marker_test_res = marker_test_res %>% dplyr::rename(gene_id=rowname)
   }
 
-
   if (verbose)
     message("Done")
-  marker_test_res = marker_test_res %>% dplyr::rename(gene_id=rowname)
+
   return(marker_test_res)
 }
 

R/select_cells.R

@@ -4,12 +4,16 @@
 #' @param reduction_method The reduction method to plot while choosing cells.
 #' @param return_list Logical, return a list of cells instead of a subsetted
 #'   CDS object.
+#' @param clear_cds Logical, clear CDS slots before returning.
+#'   After clearing the cds, re-run processing from preprocess_cds(), ...
+#'   Default is FALSE.
 #'
 #' @return A subset CDS object. If return_list = FALSE, a list of cell names.
 #' @export
 #'
 choose_cells <- function(cds,
                          reduction_method = c("UMAP", "tSNE", "PCA", "Aligned"),
+                         clear_cds = FALSE,
                          return_list = FALSE) {
   reduction_method <- match.arg(reduction_method)
   assertthat::assert_that(methods::is(cds, "cell_data_set"))
@@ -116,6 +120,8 @@ choose_cells <- function(cds,
   if(return_list) {
     return(row.names(colData(cds)[sel,]))
   } else {
+    if( clear_cds )
+      return(clear_cds_slots(cds[,sel]))
     return(cds[,sel])
   }
 }

R/utils.R

@@ -544,7 +544,16 @@ is_matrix_market_file <- function( matpath )
 load_annotations_data <- function( anno_path, metadata_column_names=NULL, header=FALSE, sep="", quote="\"'", annotation_type=NULL )
 {
   assertthat::assert_that( ! is.null( annotation_type ) )
-  annotations <- read.table( anno_path, header=header, sep=sep, quote=quote, stringsAsFactors=FALSE )
+  tryCatch(
+  {
+    annotations <- read.table( anno_path, header=header, sep=sep, quote=quote, stringsAsFactors=FALSE )
+  }, error = function( emsg )
+  {
+    stop( 'load_mm_data: bad status reading ', annotation_type, ' file \'', anno_path, '\'\n  ',
+          emsg, '\n',
+          '  note: possible problems include the wrong filename, a missing file,\n',
+          '  and incorrect file format parameters, for example \'header\', \'sep\', and \'quote\'' )
+  })
 
   metadata = NULL
   if( .row_names_info( annotations ) < 0 )
@@ -622,8 +631,10 @@ load_annotations_data <- function( anno_path, metadata_column_names=NULL, header
 #' @param umi_cutoff UMI per cell cutoff. Columns (cells) with less
 #' than umi_cutoff total counts are removed from the matrix. The
 #' default is 100.
-#' @param sep field separator character in the annotation files. The
-#' default is the tab character for tab-separated-value files.
+#' @param sep field separator character in the annotation files. If
+#' sep = "", the separator is white space, that is, one or more spaces,
+#' tabs, newlines, or carriage returns. The default is the tab
+#' character for tab-separated-value files.
 #'
 #' @return cds object
 #'
@@ -654,7 +665,7 @@ load_mm_data <- function( mat_path,
                           feature_metadata_column_names = NULL,
                           cell_metadata_column_names = NULL,
                           umi_cutoff = 100,
-			  quote="\"'",
+                          quote="\"'",
                           sep="\t") {
   assertthat::assert_that(assertthat::is.readable(mat_path), msg='unable to read matrix file')
   assertthat::assert_that(assertthat::is.readable(feature_anno_path), msg='unable to read feature annotation file')