Merge pull request #144 from MacoskoLab/new_functions

Adding several new functionalities

Author: vkozareva

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: liger
 Type: Package
 Title: Linked Inference of Genomic Experimental Relationships
-Version: 0.4.2
+Version: 0.5.0.9000
 Date: 2018-04-09
 Author: Joshua Welch
 Maintainer: Joshua Welch <jwelch@broadinstitute.org>,
@@ -15,7 +15,6 @@ Imports: Rcpp (>= 0.12.10),
      cowplot,
      FNN,
      dplyr,
-     RANN.L1,
      grid,
      ggrepel,
      irlba,
@@ -29,21 +28,32 @@ Imports: Rcpp (>= 0.12.10),
      doSNOW,
      mclust,
      patchwork,
-     stats
-Remotes: thomasp85/patchwork
-LinkingTo: Rcpp, RcppArmadillo
+     stats,
+     psych,
+     RcppEigen,
+     RANN
+Remotes: thomasp85/patchwork,
+     jefferis/RANN@master-L1,
+     linxihui/NNLM
+biocViews:
+LazyData: true
+LinkingTo: Rcpp, RcppArmadillo, RcppEigen
 Depends:
     cowplot,
     Matrix,
     methods,
     patchwork
-RoxygenNote: 6.1.1
+RoxygenNote: 7.0.2
 Encoding: UTF-8
 Suggests:
     Seurat,
     knitr,
     reticulate,
     rmarkdown,
     NNLM,
-    testthat
+    testthat,
+    GenomicRanges,
+    S4Vectors,
+    IRanges,
+    RANN.L1
 VignetteBuilder: knitr

NAMESPACE

@@ -23,6 +23,9 @@ export(getGeneValues)
 export(getProportionMito)
 export(imputeKNN)
 export(ligerToSeurat)
+export(linkGenesAndPeaks)
+export(louvainCluster)
+export(makeInteractTrack)
 export(makeRiverplot)
 export(normalize)
 export(optimizeALS)
@@ -47,6 +50,7 @@ export(removeMissingObs)
 export(reorganizeLiger)
 export(runTSNE)
 export(runUMAP)
+export(runWilcoxon)
 export(scaleNotCenter)
 export(scaleNotCenter_sparse)
 export(selectGenes)
@@ -64,7 +68,6 @@ importFrom(Matrix,rowMeans)
 importFrom(Matrix,rowSums)
 importFrom(Matrix,sparseMatrix)
 importFrom(Matrix,t)
-importFrom(RANN.L1,nn2)
 importFrom(Rcpp,evalCpp)
 importFrom(Rtsne,Rtsne)
 importFrom(cowplot,plot_grid)

R/RcppExports.R

@@ -13,10 +13,66 @@ rowVarsFast <- function(x, means) {
     .Call('_liger_rowVarsFast', PACKAGE = 'liger', x, means)
 }
 
+cpp_sumGroups_dgc <- function(x, p, i, ncol, groups, ngroups) {
+    .Call('_liger_cpp_sumGroups_dgc', PACKAGE = 'liger', x, p, i, ncol, groups, ngroups)
+}
+
+cpp_sumGroups_dgc_T <- function(x, p, i, ncol, nrow, groups, ngroups) {
+    .Call('_liger_cpp_sumGroups_dgc_T', PACKAGE = 'liger', x, p, i, ncol, nrow, groups, ngroups)
+}
+
+cpp_sumGroups_dense <- function(X, groups, ngroups) {
+    .Call('_liger_cpp_sumGroups_dense', PACKAGE = 'liger', X, groups, ngroups)
+}
+
+cpp_sumGroups_dense_T <- function(X, groups, ngroups) {
+    .Call('_liger_cpp_sumGroups_dense_T', PACKAGE = 'liger', X, groups, ngroups)
+}
+
+cpp_nnzeroGroups_dense <- function(X, groups, ngroups) {
+    .Call('_liger_cpp_nnzeroGroups_dense', PACKAGE = 'liger', X, groups, ngroups)
+}
+
+cpp_nnzeroGroups_dense_T <- function(X, groups, ngroups) {
+    .Call('_liger_cpp_nnzeroGroups_dense_T', PACKAGE = 'liger', X, groups, ngroups)
+}
+
+cpp_nnzeroGroups_dgc <- function(p, i, ncol, groups, ngroups) {
+    .Call('_liger_cpp_nnzeroGroups_dgc', PACKAGE = 'liger', p, i, ncol, groups, ngroups)
+}
+
+cpp_in_place_rank_mean <- function(v_temp, idx_begin, idx_end) {
+    .Call('_liger_cpp_in_place_rank_mean', PACKAGE = 'liger', v_temp, idx_begin, idx_end)
+}
+
+cpp_rank_matrix_dgc <- function(x, p, nrow, ncol) {
+    .Call('_liger_cpp_rank_matrix_dgc', PACKAGE = 'liger', x, p, nrow, ncol)
+}
+
+cpp_rank_matrix_dense <- function(X) {
+    .Call('_liger_cpp_rank_matrix_dense', PACKAGE = 'liger', X)
+}
+
+cpp_nnzeroGroups_dgc_T <- function(p, i, ncol, nrow, groups, ngroups) {
+    .Call('_liger_cpp_nnzeroGroups_dgc_T', PACKAGE = 'liger', p, i, ncol, nrow, groups, ngroups)
+}
+
 makeFeatureMatrix <- function(bedmat, barcodes) {
     .Call('_liger_makeFeatureMatrix', PACKAGE = 'liger', bedmat, barcodes)
 }
 
+cluster_vote <- function(nn_ranked, clusts) {
+    .Call('_liger_cluster_vote', PACKAGE = 'liger', nn_ranked, clusts)
+}
+
+scale_columns_fast <- function(mat, scale = TRUE, center = TRUE) {
+    .Call('_liger_scale_columns_fast', PACKAGE = 'liger', mat, scale, center)
+}
+
+max_factor <- function(H, dims_use, center_cols = FALSE) {
+    .Call('_liger_max_factor', PACKAGE = 'liger', H, dims_use, center_cols)
+}
+
 solveNNLS <- function(C, B) {
     .Call('_liger_solveNNLS', PACKAGE = 'liger', C, B)
 }

R/deprecated.R

@@ -4,97 +4,6 @@ NULL
 # These are deprecated functions likely to be removed in future versions. 
 # Documentation for these functions is incomplete.
 
-#' Quantile normalizes cell factors
-#'
-#' @param object analogizer object. Should run optimizeALS before calling.
-#' @param quantiles Number of quantiles to use for quantile normalization
-#' @param ref_dataset Name of dataset to use as a "reference" for normalization. By default,
-#' the dataset with the largest number of cells is used.
-#'
-#' @return analogizer object
-#' @importFrom FNN get.knn
-#' @export
-#' @examples
-#' \dontrun{
-#' Y = matrix(c(1,2,3,4,5,6,7,8,9,10,11,12),nrow=4,byrow=T)
-#' Z = matrix(c(1,2,3,4,5,6,7,6,5,4,3,2),nrow=4,byrow=T)
-#' analogy = Analogizer(list(Y,Z))
-#' analogy@var.genes = c(1,2,3,4)
-#' analogy = scaleNotCenter(analogy)
-#' }
-quantile_norm = function(object,quantiles=50,ref_dataset=NULL,min_cells=2)
-{
-  if (is.null(ref_dataset))
-  {
-    ns = sapply(object@scale.data,nrow)
-    ref_dataset = names(object@scale.data)[which.max(ns)]
-  }
-  
-  Hs_scaled = object@H
-  for (i in 1:ncol(Hs_scaled[[1]]))
-  {
-    for (j in 1:length(Hs_scaled)){
-      #Hs_scaled[[j]][,i] = object@H[[j]][,i]/sqrt(sum(object@H[[j]][,i]^2))
-      Hs_scaled[[j]] = scale(Hs_scaled[[j]],scale=T,center=T)
-    }
-  }
-  labels = list()
-  for(i in 1:length(Hs_scaled)){
-    #knn_k=15
-    #knn = get.knn(object@H[[i]],knn_k)
-    pct1 = apply(object@H[[i]],2,sum)/sum(apply(object@H[[i]],2,sum))
-    pct2 = apply(object@H[[ref_dataset]],2,sum)/sum(apply(object@H[[ref_dataset]],2,sum))
-    if (names(object@H)[i]==ref_dataset)
-    {
-      pct1 = apply(object@H[[i]],2,sum)/sum(apply(object@H[[i]],2,sum))
-      pct2 = apply(object@H[[2]],2,sum)/sum(apply(object@H[[2]],2,sum))
-    }
-    use_these_factors = 1:ncol(object@H[[i]])#which(log(pct1/pct2) > -2)
-    
-    labels[[i]] = as.factor(use_these_factors[apply(Hs_scaled[[i]][,use_these_factors],1,which.max)])
-    #labels[[i]] = as.factor(t(apply(knn$nn.index,1,function(x){which.max(table(labels[[i]][x]))}))[1,])
-  }
-  
-  object@clusters = as.factor(unlist(lapply(labels,as.character)))
-  names(object@clusters)=unlist(lapply(object@scale.data,rownames))
-  
-  clusters = labels
-  names(clusters)=names(object@H)
-  dims = ncol(object@H[[ref_dataset]])
-  
-  Hs = object@H
-  num_clusters = dims
-  for (k in 1:length(Hs))
-  {
-    for (i in 1:dims)
-    {
-      for (j in 1:num_clusters)
-      {
-        if (sum(clusters[[ref_dataset]]==j) < min_cells | sum(clusters[[k]]==j) < min_cells){next}
-        if (sum(clusters[[k]]==j)==1){
-          Hs[[k]][clusters[[k]]==j,i] = mean(Hs[[ref_dataset]][clusters[[ref_dataset]]==j,i])
-          next
-        }
-        q2 = quantile(Hs[[k]][clusters[[k]]==j,i],seq(0,1,by=1/quantiles))
-        q1 = quantile(Hs[[ref_dataset]][clusters[[ref_dataset]]==j,i],seq(0,1,by=1/quantiles))
-        if (sum(q1)==0 | sum(q2)==0 | length(unique(q1)) < 2 | length(unique(q2)) < 2)
-        {
-          new_vals = rep(0,sum(clusters[[k]]==j))
-        }
-        else
-        {
-          warp_func = approxfun(q2,q1)
-          new_vals = warp_func(Hs[[k]][clusters[[k]]==j,i])
-        }
-        
-        Hs[[k]][clusters[[k]]==j,i] = new_vals
-      }
-    }
-  }
-  object@H.norm = Reduce(rbind,Hs)
-  return(object)
-}
-
 #' Calculate alignment metric per factor.
 #' 
 #' @param object Analogizer object. Should run quantile_align_SNF before calling.