Merge pull request #242 from stemangiola/dev

Dev

Author: stemangiola

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: tidybulk
 Title: Brings transcriptomics to the tidyverse 
-Version: 1.7.3
+Version: 1.7.4
 Authors@R: c(person("Stefano", "Mangiola", email = "[email protected]",
                   role = c("aut", "cre")),
             person("Maria", "Doyle", email = "[email protected]",
@@ -32,7 +32,9 @@ Imports:
     scales,
     SummarizedExperiment,
     GenomicRanges,
-    methods
+    methods,
+    S4Vectors,
+    crayon
 Suggests:
     BiocStyle,
     testthat,
@@ -53,7 +55,6 @@ Suggests:
     Seurat,
     KernSmooth,
     Rtsne,
-    S4Vectors,
     ggplot2,
     widyr,
     clusterProfiler,
@@ -82,7 +83,7 @@ Biarch: true
 biocViews: AssayDomain, Infrastructure, RNASeq, DifferentialExpression, GeneExpression, Normalization, Clustering, QualityControl, Sequencing, Transcription, Transcriptomics
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0
 LazyDataCompression: xz
 URL: https://github.com/stemangiola/tidybulk
 BugReports: https://github.com/stemangiola/tidybulk/issues

NAMESPACE

@@ -81,11 +81,13 @@ import(readr)
 import(tibble)
 import(tidyr)
 importFrom(GenomicRanges,makeGRangesListFromDataFrame)
+importFrom(S4Vectors,metadata)
 importFrom(SummarizedExperiment,SummarizedExperiment)
 importFrom(SummarizedExperiment,assays)
 importFrom(SummarizedExperiment,colData)
 importFrom(SummarizedExperiment,rowData)
 importFrom(SummarizedExperiment,rowRanges)
+importFrom(dplyr,across)
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,distinct)

R/cibersort.R

@@ -1,3 +1,5 @@
+# Public code https://rdrr.io/github/IOBR/IOBR/src/R/CIBERSORT.R
+
 # CIBERSORT R script v1.03 (last updated 07-10-2015)
 # Note: Signature matrix construction is not currently available; use java version for full functionality.
 # Author: Aaron M. Newman, Stanford University ([email protected])
@@ -172,6 +174,34 @@ doPerm <- function(perm, X, Y, cores = 3){
   newList <- list("dist" = dist)
 }
 
+# MADE BY STEFANO TO ALLOW PARALLELISM
+call_core = function(itor, Y, X, P, pval, CoreAlg){
+  ##################################
+  ## Analyze the first mixed sample
+  ##################################
+
+  y <- Y[,itor]
+
+  #standardize mixture
+  y <- (y - mean(y)) / sd(y)
+
+  #run SVR core algorithm
+  result <- CoreAlg(X, y, cores = 1)
+
+  #get results
+  w <- result$w
+  mix_r <- result$mix_r
+  mix_rmse <- result$mix_rmse
+
+  #calculate p-value
+  if(P > 0) {pval <- 1 - (which.min(abs(nulldist - mix_r)) / length(nulldist))}
+
+  #print output
+  c(colnames(Y)[itor],w,pval,mix_r,mix_rmse)
+
+}
+
+
 #' @importFrom stats sd
 #' @importFrom utils install.packages
 #'
@@ -189,9 +219,9 @@ my_CIBERSORT <- function(Y, X, perm=0, QN=TRUE, cores = 3, exp_transform = FALSE
   ###################################
   ## This is needed to make the two tables consistent in gene
   ###################################
-
-  X <- X[order(rownames(X)),,drop=FALSE]
-  Y <- Y[order(rownames(Y)),,drop=FALSE]
+  common_genes = intersect(rownames(X), rownames(Y))
+  X <- X[common_genes,,drop=FALSE]
+  Y <- Y[common_genes,,drop=FALSE]
 
   P <- perm #number of permutations
 
@@ -248,45 +278,37 @@ my_CIBERSORT <- function(Y, X, perm=0, QN=TRUE, cores = 3, exp_transform = FALSE
   #empirical null distribution of correlation coefficients
   if(P > 0) {nulldist <- sort(doPerm(P, X, Y, cores = cores)$dist)}
 
-  #print(nulldist)
 
   header <- c('Mixture',colnames(X),"P-value","Correlation","RMSE")
-  #print(header)
 
   output <- matrix()
   itor <- 1
   mix <- dim(Y)[2]
   pval <- 9999
 
-  #iterate through mix
-  while(itor <= mix){
+  # If not Windows
+  if(Sys.info()['sysname'] == 'Windows')
+  {
+    while(itor <= mix){
 
-    ##################################
-    ## Analyze the first mixed sample
-    ##################################
+      ##################################
+      ## Analyze the first mixed sample
+      ##################################
 
-    y <- Y[,itor]
 
-    #standardize mixture
-    y <- (y - mean(y)) / sd(y)
+      out <- call_core(itor, Y, X, P, pval, CoreAlg)
+      if(itor == 1) {output <- out}
+      else {output <- rbind(output, out)}
+      itor <- itor + 1
 
-    #run SVR core algorithm
-    result <- CoreAlg(X, y, cores = cores)
+    }
 
-    #get results
-    w <- result$w
-    mix_r <- result$mix_r
-    mix_rmse <- result$mix_rmse
-
-    #calculate p-value
-    if(P > 0) {pval <- 1 - (which.min(abs(nulldist - mix_r)) / length(nulldist))}
-
-    #print output
-    out <- c(colnames(Y)[itor],w,pval,mix_r,mix_rmse)
-    if(itor == 1) {output <- out}
-    else {output <- rbind(output, out)}
+  }
 
-    itor <- itor + 1
+  # If Linux of Mac
+  else {
+    output <- parallel::mclapply(1:mix, call_core, Y, X, P, pval, CoreAlg, mc.cores=cores)
+    output= matrix(unlist(output), nrow=length(output), byrow=TRUE)
 
   }
 

R/data.R

@@ -57,3 +57,8 @@
 #'
 #'
 "counts_SE"
+
+#' Needed for tests tximeta_summarizeToGene_object, It is SummarizedExperiment from tximeta
+#'
+#'
+"tximeta_summarizeToGene_object"

R/dplyr_methods.R

@@ -723,7 +723,7 @@ rowwise.tidybulk <- function(data, ...)
 #'
 #' @examples
 #'`%>%` = magrittr::`%>%`
-#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(sample) %>% mutate(source = "AU")
+#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(.sample) %>% mutate(source = "AU")
 #' tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% left_join(annotation)
 #'
 #' @rdname dplyr-methods
@@ -763,7 +763,7 @@ left_join.tidybulk <- function (x, y, by = NULL, copy = FALSE, suffix = c(".x",
 #'
 #' @examples
 #'`%>%` = magrittr::`%>%`
-#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(sample) %>% mutate(source = "AU")
+#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(.sample) %>% mutate(source = "AU")
 #' tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% inner_join(annotation)
 #'
 #' @rdname join-methods
@@ -802,7 +802,7 @@ inner_join.tidybulk <- function (x, y, by = NULL, copy = FALSE, suffix = c(".x",
 #'
 #' @examples
 #'`%>%` = magrittr::`%>%`
-#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(sample) %>% mutate(source = "AU")
+#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(.sample) %>% mutate(source = "AU")
 #' tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% right_join(annotation)
 #'
 #' @rdname join-methods
@@ -843,7 +843,7 @@ right_join.tidybulk <- function (x, y, by = NULL, copy = FALSE, suffix = c(".x",
 #'
 #' @examples
 #'`%>%` = magrittr::`%>%`
-#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(sample) %>% mutate(source = "AU")
+#' annotation = tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% distinct(.sample) %>% mutate(source = "AU")
 #' tidybulk::counts_SE %>% tidybulk() %>% as_tibble() %>% full_join(annotation)
 #'
 #' @rdname join-methods