Replace FNN with RANN

DESCRIPTION

@@ -34,7 +34,6 @@ Imports:
     VGAM,
     pbapply,
     igraph,
-    FNN,
     RANN,
     caret,
     dplyr,

NAMESPACE

@@ -286,7 +286,6 @@ import(lars)
 import(metap)
 import(parallel)
 import(pbapply)
-importFrom(FNN,get.knn)
 importFrom(Hmisc,cut2)
 importFrom(MASS,glm.nb)
 importFrom(MASS,kde2d)

R/alignment.R

@@ -275,8 +275,10 @@ AlignSubspace <- function(
 #' @param dims.use Dimensions to use in building the NN graph
 #' @param grouping.var Grouping variable used in the alignment.
 #' @param nn Number of neighbors to calculate in the NN graph construction
+#' @param nn.eps Error bound when performing nearest neighbor seach using RANN;
+#' default of 0.0 implies exact nearest neighbor search
 #'
-#' @importFrom FNN get.knn
+#' @importFrom RANN nn2
 #' @export
 #'
 #' @examples
@@ -294,22 +296,41 @@ AlignSubspace <- function(
 #'                     dims.use = 1:5, grouping.var =  "group")
 #' }
 #'
-CalcAlignmentMetric <- function(object, reduction.use = "cca.aligned", dims.use,
-                                grouping.var, nn){
-  object <- SetAllIdent(object, grouping.var)
-  object <- SubsetData(object, max.cells.per.ident = min(table(object@ident)))
-  num.groups <- length(unique(object@ident))
-  if(missing(nn)){
-    nn <- ceiling(table(object@ident)[1] * 0.01 * num.groups)
+CalcAlignmentMetric <- function(
+  object,
+  reduction.use = "cca.aligned",
+  dims.use,
+  grouping.var,
+  nn,
+  nn.eps = 0
+) {
+  object <- SetAllIdent(object = object, id = grouping.var)
+  object <- SubsetData(object = object, max.cells.per.ident = min(table(object@ident)))
+  num.groups <- length(x = unique(x = object@ident))
+  if (missing(x = nn)) {
+    nn <- ceiling(x = table(object@ident)[1] * 0.01 * num.groups)
   }
-  dist.mat <- GetCellEmbeddings(object, reduction.type = reduction.use, dims.use = dims.use)
-  object.fnn <- get.knn(dist.mat, k = nn)
-  alignment.score <- sapply(1:length(object@cell.names), function(x) {
-    cell.id <- object@ident[x]
-    num.same.id <- length(which(object@ident[object.fnn$nn.index[x, ]] == cell.id))
-  })
-  alignment.score <- 1 - ((mean(alignment.score) - nn /num.groups) / (nn - nn/num.groups))
-  return(unname(alignment.score))
+  dist.mat <- GetCellEmbeddings(
+    object = object,
+    reduction.type = reduction.use,
+    dims.use = dims.use
+  )
+  # object.fnn <- get.knn(dist.mat, k = nn)
+  object.fnn <- nn2(
+    data = dist.mat,
+    k = nn,
+    searchtype = 'standard',
+    eps = nn.eps
+  )
+  alignment.score <- sapply(
+    X = 1:length(x = object@cell.names),
+    FUN = function(x) {
+      cell.id <- object@ident[x]
+      num.same.id <- length(x = which(x = object@ident[object.fnn$nn.idx[x, ]] == cell.id))
+    }
+  )
+  alignment.score <- 1 - ((mean(x = alignment.score) - nn / num.groups) / (nn - nn / num.groups))
+  return(unname(obj = alignment.score))
 }
 
 #' Calculate the ratio of variance explained by ICA or PCA to CCA

R/utilities.R

@@ -710,8 +710,10 @@ MergeNode <- function(object, node.use, rebuild.tree = FALSE, ...) {
 #' @param reduction.use Dimensional reduction to use
 #' @param k k-param for k-nearest neighbor calculation. 30 by default
 #' @param do.log Whether to perform smoothing in log space. Default is false.
+#' @param nn.eps Error bound when performing nearest neighbor seach using RANN;
+#' default of 0.0 implies exact nearest neighbor search
 #'
-#' @importFrom FNN get.knn
+#' @importFrom RANN nn2
 #'
 #' @export
 #'
@@ -726,7 +728,8 @@ AddSmoothedScore <- function(
   reduction.use = "tsne",
   k = 30,
   do.log = FALSE,
-  do.print = FALSE
+  do.print = FALSE,
+  nn.eps = 0
 ) {
   genes.fit <- SetIfNull(x = genes.fit, default = object@var.genes)
   genes.fit <- genes.fit[genes.fit %in% rownames(x = object@data)]
@@ -737,31 +740,23 @@ AddSmoothedScore <- function(
   )
   dim.codes <- paste0(dim.code, c(dim.1, dim.2))
   data.plot <- FetchData(object = object, vars.all = dim.codes)
-  knn.smooth <- get.knn(data = data.plot, k = k)$nn.index
-  avg.fxn <- mean
-  if (! do.log) {
-    avg.fxn <- ExpMean
-  }
-  lasso.fits <- data.frame(
-    t(
-      x = sapply(
-        X = genes.fit,
-        FUN = function(g) {
-          return(unlist(
-            x = lapply(
-              X = 1:nrow(x = data.plot),
-              FUN = function(y) {
-                avg.fxn(as.numeric(x = object@data[g, knn.smooth[y, ]]))
-              }
-            )
-          ))
+  # knn.smooth <- get.knn(data = data.plot, k = k)$nn.index
+  knn.smooth <- nn2(data = data.plot, k = k, searchtype = 'standard', eps = nn.eps)$nn.idx
+  avg.fxn <- ifelse(test = do.log, yes = mean, no = ExpMean)
+  lasso.fits <- data.frame(t(x = sapply(
+    X = genes.fit,
+    FUN = function(g) {
+      return(unlist(x = lapply(
+        X = 1:nrow(x = data.plot),
+        FUN = function(y) {
+          avg.fxn(as.numeric(x = object@data[g, knn.smooth[y, ]]))
         }
-      )
-    )
-  )
+      )))
+    }
+  )))
   colnames(x = lasso.fits) <- rownames(x = data.plot)
   genes.old <- genes.fit[genes.fit %in% rownames(x = object@imputed)]
-  genes.new <- genes.fit[! (genes.fit %in% rownames(x = object@imputed))]
+  genes.new <- genes.fit[!genes.fit %in% rownames(x = object@imputed)]
   if (length(x = genes.old) > 0) {
     object@imputed[genes.old, ] <- lasso.fits[genes.old, ]
   }

tests/testthat/test_alignment.R

@@ -21,7 +21,7 @@ test_that("Alignment returns expected values", {
 })
 
 test_that("Alignment score calculated correctly", {
-  expect_equal(CalcAlignmentMetric(pbmc_cca, reduction.use = "cca.aligned", dims.use = 1:5, grouping.var = "group"), 0.625)
+  expect_equal(CalcAlignmentMetric(pbmc_cca, reduction.use = "cca.aligned", dims.use = 1:5, grouping.var = "group", nn = 5), 0.655)
 })
 
 pbmc_cca <- CalcVarExpRatio(pbmc_cca, reduction.type = "pca", grouping.var = "group", dims.use = 1:5)