1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
|
#' Diffusion Maps
#'
#' An S4 Class implementing Diffusion Maps
#'
#' Diffusion Maps uses a diffusion probability matrix to robustly
#' approximate a manifold.
#'
#'
#' @template dimRedMethodSlots
#'
#' @template dimRedMethodGeneralUsage
#'
#' @section Parameters:
#' Diffusion Maps can take the following parameters:
#' \describe{
#' \item{d}{a function transforming a matrix row wise into a
#' distance matrix or \code{dist} object,
#' e.g. \code{\link[stats]{dist}}.}
#' \item{ndim}{The number of dimensions}
#' \item{eps}{The epsilon parameter that determines the
#' diffusion weight matrix from a distance matrix \code{d},
#' \eqn{exp(-d^2/eps)}, if set to \code{"auto"} it will
#' be set to the median distance to the 0.01*n nearest
#' neighbor.}
#' \item{t}{Time-scale parameter. The recommended value, 0,
#' uses multiscale geometry.}
#' \item{delta}{Sparsity cut-off for the symmetric graph Laplacian,
#' a higher value results in more sparsity and faster calculation.
#' The predefined value is 10^-5.}
#' }
#'
#' @section Implementation:
#' Wraps around \code{\link[diffusionMap]{diffuse}}, see there for
#' details. It uses the notation of Richards et al. (2009) which is
#' slightly different from the one in the original paper (Coifman and
#' Lafon, 2006) and there is no \eqn{\alpha} parameter.
#' There is also an out-of-sample extension, see examples.
#'
#'
#' @references
#' Richards, J.W., Freeman, P.E., Lee, A.B., Schafer,
#' C.M., 2009. Exploiting Low-Dimensional Structure in
#' Astronomical Spectra. ApJ 691,
#' 32. doi:10.1088/0004-637X/691/1/32
#'
#' Coifman, R.R., Lafon, S., 2006. Diffusion maps. Applied and
#' Computational Harmonic Analysis 21,
#' 5-30. doi:10.1016/j.acha.2006.04.006
#'
#' @examples
#' if(requireNamespace("diffusionMap", quietly = TRUE)) {
#' dat <- loadDataSet("3D S Curve", n = 300)
#' emb <- embed(dat, "DiffusionMaps")
#'
#' plot(emb, type = "2vars")
#'
#' # predicting is possible:
#' samp <- sample(floor(nrow(dat) / 10))
#' emb2 <- embed(dat[samp])
#' emb3 <- predict(emb2, dat[-samp])
#'
#' plot(emb2, type = "2vars")
#' points(getData(emb3))
#' }
#' @include dimRedResult-class.R
#' @include dimRedMethod-class.R
#' @family dimensionality reduction methods
#' @export DiffusionMaps
#' @exportClass DiffusionMaps
DiffusionMaps <- setClass(
"DiffusionMaps",
contains = "dimRedMethod",
prototype = list(
stdpars = list(d = stats::dist,
ndim = 2,
eps = "auto",
t = 0,
delta = 1e-5),
fun = function (data, pars,
keep.org.data = TRUE) {
chckpkg("diffusionMap")
meta <- data@meta
orgdata <- if (keep.org.data) data@data else NULL
indata <- data@data
distmat <- pars$d(indata)
if (pars$eps == "auto")
pars$eps <- diffusionMap::epsilonCompute(distmat)
diffres <- diffusionMap::diffuse(
D = distmat,
t = pars$t,
eps.val = pars$eps,
neigen = pars$ndim,
maxdim = pars$ndim,
delta = pars$delta
)
outdata <- as.matrix(diffres$X)
appl <- function(x) {
appl.meta <- if (inherits(x, "dimRedData")) x@meta else data.frame()
proj <- if (inherits(x, "dimRedData")) x@data else x
if (ncol(proj) != ncol(data@data))
stop("x must have the same number of dimensions ",
"as the original data")
dd <- sqrt(pdist2(proj, indata))
appl.res <-
diffusionMap::nystrom(diffres, dd, sigma = diffres$epsilon)
dimnames(appl.res) <- list(
rownames(x), paste0("diffMap", seq_len(ncol(outdata)))
)
new("dimRedData", data = appl.res, meta = appl.meta)
}
colnames(outdata) <- paste0("diffMap", seq_len(ncol(outdata)))
return(new(
"dimRedResult",
data = new("dimRedData",
data = outdata,
meta = meta),
org.data = orgdata,
apply = appl,
has.apply = TRUE,
has.org.data = keep.org.data,
method = "diffmap",
pars = pars
))
},
requires = c("diffusionMap"))
)
|