Speed improvements

R/postProcessing.R

@@ -2,39 +2,44 @@
 
 # Collects RCTD results
 gather_results <- function(RCTD, results) {
- cell_type_names = RCTD@cell_type_info$renorm[[2]]
+
+ message('Step 4/4: Gather Results')
+ pb <- txtProgressBar(max = 3, style = 3)
+
+ cell_type_names <- RCTD@cell_type_info$renorm[[2]]
  barcodes <- colnames(RCTD@spatialRNA@counts)
  N <- length(results)
- weights = Matrix(0, nrow = N, ncol = length(cell_type_names))
- weights_doublet = Matrix(0, nrow = N, ncol = 2)
- rownames(weights) = barcodes; rownames(weights_doublet) = barcodes
- colnames(weights) = cell_type_names; colnames(weights_doublet) = c('first_type', 'second_type')
- empty_cell_types = factor(character(N),levels = cell_type_names)
+
+ empty_cell_types <- factor(character(N),levels = cell_type_names)
  spot_levels <- c("reject", "singlet", "doublet_certain", "doublet_uncertain")
- results_df <- data.frame(spot_class = factor(character(N),levels=spot_levels),
- first_type = empty_cell_types, second_type = empty_cell_types,
- first_class = logical(N), second_class = logical(N),
- min_score = numeric(N), singlet_score = numeric(N),
- conv_all = logical(N), conv_doublet = logical(N))
- score_mat <- list()
- singlet_scores <- list()
- for(i in 1:N) {
- if(i %% 1000 == 0)
- print(paste("gather_results: finished",i))
- weights_doublet[i,] = results[[i]]$doublet_weights
- weights[i,] = results[[i]]$all_weights
- results_df[i, "spot_class"] = results[[i]]$spot_class
- results_df[i, "first_type"] = results[[i]]$first_type
- results_df[i, "second_type"] = results[[i]]$second_type
- results_df[i, "first_class"] = results[[i]]$first_class
- results_df[i, "second_class"] = results[[i]]$second_class
- results_df[i, "min_score"] = results[[i]]$min_score
- results_df[i, "singlet_score"] = results[[i]]$singlet_score
- results_df[i, "conv_all"] = results[[i]]$conv_all
- results_df[i, "conv_doublet"] = results[[i]]$conv_doublet
- score_mat[[i]] <- results[[i]]$score_mat
- singlet_scores[[i]] <- results[[i]]$singlet_scores
- }
+
+ setTxtProgressBar(pb, 1)
+
+ results_df <- data.frame(spot_class = factor(sapply(results,function(X){return(X$spot_class)}),levels=spot_levels),
+ first_type = sapply(results,function(X){return(X$first_type)}),
+ scond_type = sapply(results,function(X){return(X$second_type)}),
+ first_class = sapply(results,function(X){return(X$first_class)}),
+ second_class = sapply(results,function(X){return(X$second_class)}),
+ min_score = sapply(results,function(X){return(X$min_score)}),
+ singlet_score = sapply(results,function(X){return(X$singlet_score)}),
+ conv_all = sapply(results,function(X){return(X$conv_all)}),
+ conv_doublet = sapply(results,function(X){return(X$conv_doublet)}))
+
+ setTxtProgressBar(pb, 2)
+
+ weights_doublet <- do.call(rbind,lapply(results,function(X){return(X$doublet_weights)}))
+ weights <- do.call(rbind,lapply(results,function(X){return(X$all_weights)}))
+
+ rownames(weights) <- barcodes
+ rownames(weights_doublet) <- barcodes
+ colnames(weights) <- cell_type_names
+ colnames(weights_doublet) <- c('first_type', 'second_type')
+
+ score_mat <- lapply(results,function(X){return(X$score_mat)})
+ singlet_scores <- lapply(results,function(X){return(X$singlet_scores)})
+
+ setTxtProgressBar(pb, 3)
+
  rownames(results_df) = barcodes
  RCTD@results <- list(results_df = results_df, weights = weights, weights_doublet = weights_doublet,
  score_mat = score_mat, singlet_scores = singlet_scores)