initial commit

Author: rcannood

.Rbuildignore

@@ -0,0 +1,6 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^\.travis
+^\.git$
+^README\.Rmd$
+cran-comments.md

.gitignore

@@ -0,0 +1,5 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+.DS_Store

.travis.yml

@@ -0,0 +1,17 @@
+language: r
+cache: packages
+matrix:
+  include:
+  - r: oldrel
+    os: linux
+  - r: release
+    os: linux
+  - r: devel
+    os: linux
+  - r: release
+    os: osx
+r_packages:
+ - covr
+ - devtools
+after_success:
+ - R -e 'covr::codecov()'

DESCRIPTION

@@ -0,0 +1,42 @@
+Package: lmds
+Type: Package
+Title: Landmark Multi-Dimensional Scaling
+Version: 0.1.0
+Authors@R: c(
+    person(
+      "Robrecht", "Cannoodt", 
+      email = "[email protected]", 
+      role = c("aut", "cre"),
+      comment = c(ORCID = "0000-0003-3641-729X", github = "rcannood")
+    ),
+    person(
+      "Wouter", "Saelens", 
+      email = "[email protected]", 
+      role = c("aut"), 
+      comment = c(ORCID = "0000-0002-7114-6248", github = "zouter")
+    )
+  )
+Description: 
+  Landmark Multi-Dimensional Scaling (LMDS) is an extension of classical 'Torgerson' MDS.
+  LMDS scales to significantly larger data sets since it only computes the distances between
+  a set of landmarks and all samples.
+  Has built-in support for sparse matrices.
+License: GPL-3
+Encoding: UTF-8
+LazyData: true
+Imports:
+  assertthat,
+  dynutils (>= 1.0.3),
+  irlba,
+  Matrix
+Suggests: 
+  testthat
+RoxygenNote: 6.1.1
+Roxygen: list(markdown = TRUE)
+URL: http://github.com/dynverse/lmds
+BugReports: https://github.com/dynverse/lmds/issues
+Collate: 
+    'cmdscale_landmarks.R'
+    'select_landmarks.R'
+    'lmds.R'
+    'package.R'

NAMESPACE

@@ -0,0 +1,10 @@
+# Generated by roxygen2: do not edit by hand
+
+export(cmdscale_landmarks)
+export(lmds)
+export(select_landmarks)
+importFrom(assertthat,assert_that)
+importFrom(dynutils,calculate_distance)
+importFrom(dynutils,is_sparse)
+importFrom(dynutils,scale_uniform)
+importFrom(irlba,partial_eigen)

NEWS.md

@@ -0,0 +1,6 @@
+# lmds 0.1.0
+
+Initial release of lmds.
+* Landmark Multi-Dimensional Scaling (LMDS) is an extension of classical 'Torgerson' MDS.
+  LMDS scales to significantly larger data sets since it only computes the distances between
+  a set of landmarks and all samples. Has built-in support for sparse matrices.

R/cmdscale_landmarks.R

@@ -0,0 +1,65 @@
+#' Perform MDS on landmarks and project other samples to the same space
+#'
+#' @param dist_2lm Distance matrix between the landmarks and all the samples in original dataset
+#' @param ndim The number of dimensions
+#' @param rescale Whether or not to rescale the final dimensionality reduction (recommended)
+#' @param ... Extra params to pass to [irlba::irlba()]
+#'
+#' @importFrom irlba partial_eigen
+#' @importFrom dynutils scale_uniform
+#'
+#' @export
+#'
+#' @examples
+#' library(Matrix)
+#' x <- Matrix::rsparsematrix(10000, 1000, .01)
+#' dist_2lm <- select_landmarks(x)
+#' cmdscale_landmarks(dist_2lm)
+cmdscale_landmarks <- function(dist_2lm, ndim = 3, rescale = TRUE, ...) {
+  assert_that(
+    !is.null(attr(dist_2lm, "landmark_ix")) || (!is.null(rownames(dist_2lm)) && !is.null(colnames(dist_2lm))),
+    is.numeric(ndim), length(ndim) == 1, ndim >= 1,
+    is.logical(rescale), length(rescale) == 1, !is.na(rescale)
+  )
+
+  ix_lm <- attr(dist_2lm, "landmark_ix")
+  if (is.null(ix_lm)) {
+    ix_lm <- match(rownames(dist_2lm), colnames(dist_2lm))
+  }
+
+  # short hand notations
+  x <- dist_2lm[, ix_lm, drop = FALSE]^2
+  n <- as.integer(nrow(x))
+  N <- as.integer(ncol(dist_2lm))
+
+  # double center data
+  mu_n <- rowMeans(x)
+  mu <- mean(x)
+  x_dc <-
+    sweep(
+      sweep(x, 1, mu_n, "-"),
+      2, mu_n, "-"
+    ) + mu
+
+  # classical MDS on landmarks
+  e <- irlba::partial_eigen(-x_dc / 2, symmetric = TRUE, n = ndim, ...)
+  ev <- e$values
+  evec <- e$vectors
+  ndim1 <- sum(ev > 0)
+  if (ndim1 < ndim) {
+    warning(gettextf("only %d of the first %d eigenvalues are > 0", ndim1, ndim), domain = NA)
+    evec <- evec[, ev > 0, drop = FALSE]
+    ev <- ev[ev > 0]
+    ndim <- ndim1
+  }
+
+  # distance-based triangulation
+  points_inv <- evec / rep(sqrt(ev), each = n)
+  dimred <- (-t(dist_2lm - rep(mu_n, each = N)) / 2) %*% points_inv
+
+  if (rescale) {
+    dimred <- dynutils::scale_uniform(dimred)
+  }
+
+  dimred
+}

R/lmds.R

@@ -0,0 +1,52 @@
+#' Landmark MDS
+#'
+#' Landmark Multi-Dimensional Scaling (LMDS) is an extension of classical 'Torgerson' MDS.
+#' LMDS scales to significantly larger data sets since it only computes the distances between
+#' a set of landmarks and all samples. Has built-in support for sparse matrices.
+#'
+#' @inheritParams select_landmarks
+#' @inheritParams cmdscale_landmarks
+#'
+#' @export
+#'
+#' @include cmdscale_landmarks.R select_landmarks.R
+#'
+#' @examples
+#' library(Matrix)
+#' x <- Matrix::rsparsematrix(10000, 1000, .01)
+#' lmds(x, ndim = 3)
+lmds <- dynutils::inherit_default_params(
+  list(select_landmarks, cmdscale_landmarks),
+  function(
+    x,
+    ndim,
+    distance_method,
+    landmark_method,
+    num_landmarks
+  ) {
+    # select the landmarks
+    dist_2lm <- select_landmarks(
+      x = x,
+      distance_method = distance_method,
+      landmark_method = landmark_method,
+      num_landmarks = num_landmarks
+    )
+
+    # reduce dimensionality for landmarks and project to non-landmarks
+    dimred <- cmdscale_landmarks(
+      dist_2lm = dist_2lm,
+      ndim = ndim,
+      rescale = TRUE
+    )
+
+    rownames(dimred) <- rownames(x)
+    colnames(dimred) <- paste0("comp_", seq_len(ndim))
+
+    dimred
+  }
+)
+
+
+
+
+

R/package.R

@@ -0,0 +1,13 @@
+#' Landmark Multi-Dimensional Scalng
+#'
+#' Landmark Multi-Dimensional Scaling (LMDS) is an extension of classical 'Torgerson' MDS.
+#' LMDS scales to significantly larger data sets since it only computes the distances between
+#' a set of landmarks and all samples.
+#' Has built-in support for sparse matrices.
+#'
+#' @importFrom assertthat assert_that
+#' @importFrom dynutils calculate_distance is_sparse
+#'
+#' @docType package
+#' @name lmds
+NULL

R/select_landmarks.R

@@ -0,0 +1,48 @@
+#' Select landmarks from dataset
+#'
+#' In addition, the distances between the landmarks and all samples are calculated.
+#'
+#' @param x A matrix, optionally sparse.
+#' @param distance_method The distance metric to use. Options are "euclidean" (default), "pearson", "spearman", "cosine", "manhattan".
+#' @param landmark_method The landmark selection method to use. Options are "sample" (default).
+#' @param num_landmarks The number of landmarks to use,
+#'
+#' @return The distance matrix between the landmarks and all samples. In addition, an attribute `"landmark_ix"`
+#'   denotes the indices of landmarks that were sampled.
+#'
+#' @export
+#'
+#' @examples
+#' library(Matrix)
+#' x <- Matrix::rsparsematrix(10000, 1000, .01)
+#' select_landmarks(x)
+select_landmarks <- function(
+  x,
+  distance_method = c("euclidean", "pearson", "spearman", "cosine", "manhattan"),
+  landmark_method = c("sample"),
+  num_landmarks = 500
+) {
+  distance_method <- match.arg(distance_method)
+  landmark_method <- match.arg(landmark_method)
+  assert_that(
+    is.matrix(x) || is_sparse(x),
+    is.numeric(num_landmarks), length(num_landmarks) == 1, num_landmarks > 2
+  )
+
+  # parameter check on num_landmarks
+  if (num_landmarks > nrow(x)) {
+    num_landmarks <- nrow(x)
+  }
+
+  # naive -> just subsample the cell ids
+  if (landmark_method == "sample") {
+    ix_lm <- sample.int(nrow(x), num_landmarks)
+    dist_2lm <- as.matrix(calculate_distance(x[ix_lm, , drop = FALSE], x, method = distance_method))
+  }
+
+  dist_2lm <- zapsmall(dist_2lm)
+
+  attr(dist_2lm, "landmark_ix") <- ix_lm
+
+  dist_2lm
+}