Nothing
R/RcppExports.R
In curveDepth: Tukey Curve Depth and Distance in the Space of Curves
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
#' Distance for images
#'
#' Calculates distance matrix for a sample of images using the minimax metric.
#' This fucntion can be seen as a wrapper of a sequential call of
#' \code{images2curves} and \code{dist.curves}.
#'
#' @param images A 3-dimensional array with each slice (matrix in first two
#' dimensions) corresponding to an image. Each (eps-strictly) positive
#' entry is regarded as an occupied pixel (one), otherwise it is regarded
#' as an empty pixel, of an image.
#'
#' @param verbosity Level of reporting messages, the higher the more progress
#' reports are printed, set \code{0} (default) for no messages.
#'
#' @return A matrix \code{dim(images)[3] x dim(images)[3]} with each entry
#' being the distance between two images.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Load two Sevens and one One, and plot them
#' data("mnistShort017")
#' # First Seven
#' firstSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(firstSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(firstSevenDigit)[1:2])
#' # Second Seven
#' secondSevenDigit <- mnistShort017$`7`[, , 6]
#' image(as.matrix(rev(as.data.frame(secondSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(secondSevenDigit)[1:2])
#' # A One
#' aOneDigit <- mnistShort017$`1`[, , 1]
#' image(as.matrix(rev(as.data.frame(aOneDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aOneDigit)[1:2])
#' # Caculate distances between all the images
#' threeDigits <- array(NA, dim = c(nrow(firstSevenDigit),
#' ncol(firstSevenDigit), 3))
#' threeDigits[, , 1] <- firstSevenDigit
#' threeDigits[, , 2] <- secondSevenDigit
#' threeDigits[, , 3] <- aOneDigit
#' distMatrix <- dist.images(threeDigits)
#' # Print distance matrix
#' print(distMatrix)
dist.images <- function(images, verbosity = 0L) {
.Call('_curveDepth_distImages', PACKAGE = 'curveDepth', images, verbosity)
}
#' Distance for curves
#'
#' Calculates distance matrix for a sample of curves using the minimax metric.
#'
#' @param curves A list where each element is a function being a list
#' containing a matrix \code{coords} (values, d columns).
#'
#' @param oneWay Whether curves should be condisered as a one-directional,
#' \code{FALSE} by default.
#'
#' @param verbosity Level of reporting messages, the higher the more progress
#' reports are printed, set \code{0} (default) for no messages.
#'
#' @return A matrix \code{length(curves) x length(curves)} with each entry
#' being the distance between two curves.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Load two Sevens and one One, plot them,
#' # and transform to curves
#' data("mnistShort017")
#' # First Seven
#' firstSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(firstSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(firstSevenDigit)[1:2])
#' firstSevenCurve <- images2curves(array(
#' firstSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # Second Seven
#' secondSevenDigit <- mnistShort017$`7`[, , 6]
#' image(as.matrix(rev(as.data.frame(secondSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(secondSevenDigit)[1:2])
#' secondSevenCurve <- images2curves(array(
#' secondSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # A One
#' aOneDigit <- mnistShort017$`1`[, , 1]
#' image(as.matrix(rev(as.data.frame(aOneDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aOneDigit)[1:2])
#' aOneCurve <- images2curves(array(
#' aOneDigit, dim = c(28, 28, 1)))[[1]]
#' # Caculate distances between all the curves
#' distMatrix <- dist.curves(list(
#' firstSevenCurve, secondSevenCurve, aOneCurve))
#' # Print distance matrix
#' print(distMatrix)
dist.curves <- function(curves, oneWay = FALSE, verbosity = 0L) {
.Call('_curveDepth_distCurves', PACKAGE = 'curveDepth', curves, oneWay, verbosity)
}
#' Distance for curves
#'
#' Calculates distance matrix for two samples of curves using minimax metric.
#' The function can be particularly useful for parallel computation of a
#' big distance matrix.
#'
#' @param curvesRows A list where each element is a function being a list
#' containing a matrix \code{coords} (values, d columns).
#'
#' @param curvesCols A list where each element is a function being a list
#' containing a matrix \code{coords} (values, d columns).
#'
#' @param oneWay Whether curves should be condisered as a one-directional,
#' \code{FALSE} by default.
#'
#' @param verbosity Level of reporting messages, the higher the more progress
#' reports are printed, set \code{0} (default) for no messages.
#'
#' @return A matrix \code{length(curvesRows) x length(curvesCols)} with each
#' entry being the distance between two corresponding curves.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Load two Sevens and one One, plot them,
#' # and transform to curves
#' data("mnistShort017")
#' # First Seven
#' firstSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(firstSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(firstSevenDigit)[1:2])
#' firstSevenCurve <- images2curves(array(
#' firstSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # Second Seven
#' secondSevenDigit <- mnistShort017$`7`[, , 6]
#' image(as.matrix(rev(as.data.frame(secondSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(secondSevenDigit)[1:2])
#' secondSevenCurve <- images2curves(array(
#' secondSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # A One
#' aOneDigit <- mnistShort017$`1`[, , 1]
#' image(as.matrix(rev(as.data.frame(aOneDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aOneDigit)[1:2])
#' aOneCurve <- images2curves(array(
#' aOneDigit, dim = c(28, 28, 1)))[[1]]
#' # Caculate distances between all the curves
#' distMatrix <- matrix(0, 3, 3)
#' distMatrix[3, 1:2] <- distMatrix[1:2, 3] <-
#' dist.curves.asymm(list(
#' firstSevenCurve, secondSevenCurve), list(aOneCurve))
#' distMatrix[2, 1] <- distMatrix[1, 2] <-
#' dist.curves.asymm(
#' list(firstSevenCurve), list(secondSevenCurve))
#' # Print distance matrix
#' print(distMatrix)
dist.curves.asymm <- function(curvesRows, curvesCols, oneWay = FALSE, verbosity = 0L) {
.Call('_curveDepth_distCurvesAsymm', PACKAGE = 'curveDepth', curvesRows, curvesCols, oneWay, verbosity)
}
#' Calculate Tukey curve depth using given points
#'
#' Calculates Tukey curve depth of each curve in \code{objects} w.r.t. the
#' sample of curves in \code{data}. Calculation of partial depth of each
#' single point can be either exact or approximate. If exact, modified method
#' of Dyckerhoff and Mozharovskyi (2016) is used; if approximate,
#' approximation is performed by projections on directions - points uniformly
#' distributed on the unit hypersphere.
#'
#' @param objects A list where each element is a multivariate curve being a
#' list containing a matrix \code{coords} (values, d columns).
#'
#' @param data A list where each element is a multivariate curve being a list
#' containing a matrix \code{coords} (values, d columns). The depths are
#' computed w.r.t. this data set.
#'
#' @param nDirs Number of directions used to inspect the space, drawn from the
#' uniform distribution on the sphere.
#'
#' @param subs Whether to split each object into two disjunctive subsets (one
#' for integrating and one for estimation) when computing the depth.
#'
#' @param fracInt Portion of an object used for integrating.
#'
#' @param fracEst Portion of an object used for estimation,
#' maximum: \code{1 - fracInt}.
#'
#' @param subsamples A list indicating subsamples of points for each curve in
#' \code{objects}. Each elemnt of the list corresponds to a single curve and
#' should be given as a vector of the length equal to the number of points
#' on it, with entries indicating:
#' \itemize{
#' \item 0 do not take the point into account at all,
#' \item 1 use point as a reference (i.e. for integrating) and thus
#' calculate its depth,
#' \item 2 utilize point in depth calculation (i.e. for estimation).}
#'
#' @param exactEst Is calculation of depth for each reference point of the
#' curve exact (\code{TRUE}, by default) or approximate (\code{FALSE}).
#'
#' @param minMassObj Minimal portion of the \code{objects} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @param minMassDat minimal portion of the \code{data} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @return A vector of doubles having the same length as \code{objects}, whose
#' each entry is the depth of each element of \code{objects} w.r.t.
#' \code{data}.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' Dyckerhoff, R. and Mozharovskyi P. (2016). Exact computation of the
#' halfspace depth. \emph{Computational Statistics and Data Analysis}, 98,
#' 19-30.
#'
#' @examples
#' library(curveDepth)
#' # Load digits and transform them to curves
#' data("mnistShort017")
#' n <- 10 # cardinality of each class
#' m <- 50 # number of points to sample
#' cst <- 1/10 # a threshold constant
#' alp <- 1/8 # a threshold constant
#' curves0 <- images2curves(mnistShort017$`0`[, , 1:n])
#' curves1 <- images2curves(mnistShort017$`1`[, , 1:n])
#' set.seed(1)
#' curves0Smpl <- sample.curves(curves0, 2 * m)
#' curves1Smpl <- sample.curves(curves1, 2 * m)
#' # Calculate depths
#' depthSpace = matrix(NA, nrow = n * 2, ncol = 2)
#' depthSpace[, 1] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves0Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' depthSpace[, 2] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves1Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' # Draw the DD-plot
#' plot(NULL, xlim = c(0, 1), ylim = c(0, 1),
#' xlab = paste("Depth w.r.t. '0'"),
#' ylab = paste("Depth w.r.t. '1'"),
#' main = paste("DD-plot for '0' vs '1'"))
#' grid()
#' # Draw the separating rule
#' dat1 <- data.frame(cbind(
#' depthSpace, c(rep(0, n), rep(1, n))))
#' ddalpha1 <- ddalpha.train(X3 ~ X1 + X2, data = dat1,
#' depth = "ddplot",
#' separator = "alpha")
#' ddnormal <- ddalpha1$classifiers[[1]]$hyperplane[2:3]
#' pts <- matrix(c(0, 0, 1, ddnormal[1] / -ddnormal[2]),
#' nrow = 2, byrow = TRUE)
#' lines(pts, lwd = 2)
#' # Draw the points
#' points(depthSpace[1:n, ],
#' col = "red", lwd = 2, pch = 1)
#' points(depthSpace[(n + 1):(2 * n), ],
#' col = "blue", lwd = 2, pch = 3)
depth.curve.Tukey <- function(objects, data, nDirs = 100L, subs = TRUE, fracInt = 0.5, fracEst = 0.5, subsamples = NULL, exactEst = TRUE, minMassObj = 0, minMassDat = 0) {
.Call('_curveDepth_depthCurveTukey', PACKAGE = 'curveDepth', objects, data, nDirs, subs, fracInt, fracEst, subsamples, exactEst, minMassObj, minMassDat)
}
#' Sample points on curves
#'
#' Samples points uniformly on curves interpolated as linear consequent
#' segments.
#'
#' @param curves A list where each element is a function being a list
#' containing a matrix \code{coords} (curves' values, d columns).
#'
#' @param ptsPerCurve A vector of numbers of points to be sampled on each
#' curve. If \code{length(ptsPerCurve) < length(curves)} then the first entry
#' of \code{ptsPerCurve} is considered only, and corresponds to the number of
#' points on a curve.
#'
#' @return A list of curves with each entry being a list constiting of [[1]]
#' the drawn curve being a matrix named \code{coords}, [[2]] length of the
#' curve as in \code{curves} named \code{length.init}, and [[3]] length of the
#' drawn curve named \code{length}.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Load digits and transform them to curves
#' data("mnistShort017")
#' n <- 10 # cardinality of each class
#' m <- 50 # number of points to sample
#' cst <- 1/10 # a threshold constant
#' alp <- 1/8 # a threshold constant
#' curves0 <- images2curves(mnistShort017$`0`[, , 1:n])
#' curves1 <- images2curves(mnistShort017$`1`[, , 1:n])
#' set.seed(1)
#' curves0Smpl <- sample.curves(curves0, 2 * m)
#' curves1Smpl <- sample.curves(curves1, 2 * m)
#' # Calculate depths
#' depthSpace = matrix(NA, nrow = n * 2, ncol = 2)
#' depthSpace[, 1] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves0Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' depthSpace[, 2] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves1Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' # Draw the DD-plot
#' plot(NULL, xlim = c(0, 1), ylim = c(0, 1),
#' xlab = paste("Depth w.r.t. '0'"),
#' ylab = paste("Depth w.r.t. '1'"),
#' main = paste("DD-plot for '0' vs '1'"))
#' grid()
#' # Draw the separating rule
#' dat1 <- data.frame(cbind(
#' depthSpace, c(rep(0, n), rep(1, n))))
#' ddalpha1 <- ddalpha.train(X3 ~ X1 + X2, data = dat1,
#' depth = "ddplot",
#' separator = "alpha")
#' ddnormal <- ddalpha1$classifiers[[1]]$hyperplane[2:3]
#' pts <- matrix(c(0, 0, 1, ddnormal[1] / -ddnormal[2]),
#' nrow = 2, byrow = TRUE)
#' lines(pts, lwd = 2)
#' # Draw the points
#' points(depthSpace[1:n, ],
#' col = "red", lwd = 2, pch = 1)
#' points(depthSpace[(n + 1):(2 * n), ],
#' col = "blue", lwd = 2, pch = 3)
sample.curves <- function(curves, ptsPerCurve = as.integer( c(500))) {
.Call('_curveDepth_curvesSubsample', PACKAGE = 'curveDepth', curves, ptsPerCurve)
}
#' Convert images to curves
#'
#' Converts images to curves with points sorted in traversing order.
#'
#' @param images A 3-dimensional array with each slice (matrix in first two
#' dimensions) corresponding to an image. Each (eps-strictly) positive
#' entry is regarded as an occupied pixel (one), otherwise it is regarded
#' as an empty pixel, of an image.
#'
#' @return A list of curves where each element is a function being a list
#' containing a matrix \code{coords} (curve's values, d columns).
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Pixel-grid filling function for a curve
#' plotGridCurve <- function(dims){
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / dims[1], i / dims[1]), c(0, 1),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0, 1), c(i / dims[2], i / dims[2]),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0, 0, 1, 1)
#' }
#' # Load a digit and plot it
#' data("mnistShort017")
#' aSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(aSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aSevenDigit)[1:2])
#' # Convert the digit to a curve and plot it
#' aSevenCurve <- images2curves(array(
#' aSevenDigit, dim = c(28, 28, 1)))[[1]]
#' plot(cbind(aSevenCurve$coords[, 1],
#' 1 - aSevenCurve$coords[, 2]),
#' type = "l", lwd = 3, asp = 1,
#' xlim = c(0, 1), ylim = c(0, 1),
#' xlab = "x", ylab = "y")
#' plotGridCurve(dim(aSevenDigit)[1:2])
images2curves <- function(images) {
.Call('_curveDepth_images2curves', PACKAGE = 'curveDepth', images)
}
#' Calculate Tukey curve depth for curves
#'
#' Calculates Tukey curve depth of each curve in \code{objects} w.r.t. the
#' sample of curves in \code{data}. First, \code{m} points are sampled from a
#' uniform distribution on a piecewise linear approximation of each of the
#' curves in \code{data} and \code{m / fracEst * (fracInt + fracEst)} points
#' on each of the curves in \code{objects}. Second, these samples are used to
#' calculate the Tukey curve depth.
#'
#' Calculation of partial depth of each single point can be either exact
#' or approximate. If exact, an extension of the method of
#' Dyckerhoff and Mozharovskyi (2016) is used; if approximate, approximation
#' is performed by projections on directions - points uniformly distributed on
#' the unit hypersphere.
#'
#' @param objects A list where each element is a multivariate curve being a
#' list containing a matrix \code{coords} (values, d columns).
#'
#' @param data A list where each element is a multivariate curve being a list
#' containing a matrix \code{coords} (values, d columns). The depths are
#' computed w.r.t. this data set.
#'
#' @param nDirs Number of directions used to inspect the space, drawn from the
#' uniform distribution on the sphere.
#'
#' @param subs Whether to split each object into two disjunctive subsets (one
#' for integrating and one for estimation) when computing the depth.
#'
#' @param m Number of points used for estimation.
#'
#' @param fracInt Portion of an object used for integrating.
#'
#' @param fracEst Portion of an object used for estimation,
#' maximum: \code{1 - fracInt}.
#'
#' @param exactEst Is calculation of depth for each reference point of the
#' curve exact (\code{TRUE}, by default) or approximate (\code{FALSE}).
#'
#' @param minMassObj Minimal portion of the \code{objects} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @param minMassDat minimal portion of the \code{data} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @return A vector of doubles having the same length as \code{objects}, whose
#' each entry is the depth of each element of \code{objects} w.r.t.
#' \code{data}.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' Dyckerhoff, R. and Mozharovskyi P. (2016). Exact computation of the
#' halfspace depth. \emph{Computational Statistics and Data Analysis}, 98,
#' 19-30.
#'
#' @examples
#' library(curveDepth)
#' # Load digits and transform them to curves
#' data("mnistShort017")
#' n <- 10 # cardinality of each class
#' m <- 50 # number of points to sample
#' cst <- 1/10 # a threshold constant
#' alp <- 1/8 # a threshold constant
#' curves0 <- images2curves(mnistShort017$`0`[, , 1:n])
#' curves1 <- images2curves(mnistShort017$`1`[, , 1:n])
#' # Calculate depths
#' depthSpace = matrix(NA, nrow = n * 2, ncol = 2)
#' set.seed(1)
#' depthSpace[, 1] = depthc.Tukey(
#' c(curves0, curves1), curves0, m = m,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' depthSpace[, 2] = depthc.Tukey(
#' c(curves0, curves1), curves1, m = m,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' # Draw the DD-plot
#' plot(NULL, xlim = c(0, 1), ylim = c(0, 1),
#' xlab = paste("Depth w.r.t. '0'"),
#' ylab = paste("Depth w.r.t. '1'"),
#' main = paste("DD-plot for '0' vs '1'"))
#' grid()
#' # Draw the separating rule
#' dat1 <- data.frame(cbind(
#' depthSpace, c(rep(0, n), rep(1, n))))
#' ddalpha1 <- ddalpha.train(X3 ~ X1 + X2, data = dat1,
#' depth = "ddplot",
#' separator = "alpha")
#' ddnormal <- ddalpha1$classifiers[[1]]$hyperplane[2:3]
#' pts <- matrix(c(0, 0, 1, ddnormal[1] / -ddnormal[2]),
#' nrow = 2, byrow = TRUE)
#' lines(pts, lwd = 2)
#' # Draw the points
#' points(depthSpace[1:n, ],
#' col = "red", lwd = 2, pch = 1)
#' points(depthSpace[(n + 1):(2 * n), ],
#' col = "blue", lwd = 2, pch = 3)
depthc.Tukey <- function(objects, data, nDirs = 100L, subs = TRUE, m = 500L, fracInt = 0.5, fracEst = 0.5, exactEst = TRUE, minMassObj = 0, minMassDat = 0) {
.Call('_curveDepth_depthCTukey', PACKAGE = 'curveDepth', objects, data, nDirs, subs, m, fracInt, fracEst, exactEst, minMassObj, minMassDat)
}
#' Voxelization of functions
#'
#' Convertes a pice-wise linear parametrized funtion into a discretized
#' voxel representation.
#'
#' @param f A parametrized function as a list containing a vector
#' "args" (arguments), and a matrix "vals" (values, d columns).
#'
#' @param from A vector of d numbers, each giving a starting discretization
#' point for one dimension.
#'
#' @param to A vector of d numbers, each giving a finishing discretization
#' point for one dimension.
#'
#' @param by A vector of d numbers, each giving discretization step for one
#' dimension.
#'
#' @return A list containing two matrices: "voxels" with rows being voxel
#' numbers, and "coords" with rows being coordinates of voxel centers.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Create some data based on growth curves
#' g1d <- dataf.growth()
#' g3d <- list("")
#' set.seed(1)
#' for (i in 1:length(g1d$dataf)){
#' g3d[[i]] <- list(
#' args = g1d$dataf[[1]]$args,
#' vals = cbind(g1d$dataf[[i]]$vals,
#' g1d$dataf[[i]]$vals[length(g1d$dataf[[i]]$vals):1],
#' rnorm(length(g1d$dataf[[i]]$vals), sd = 1) +
#' rnorm(1, mean = 0, sd = 10)))
#' }
#' # Define voxels' bounds and resolution
#' from <- c(65, 65, -25)
#' to <- c(196, 196, 25)
#' steps <- 100
#' by <- (to - from) / steps
#' # Voxelize all curves
#' fs <- list("")
#' for (i in 1:length(g3d)){
#' fs[[i]] <- voxelize(g3d[[i]], from, to, by)
#' }
#' \dontrun{
#' # Plot first 10 curves
#' library(rgl)
#' rgl.open()
#' rgl.bg(color = "white")
#' for (i in 1:10){
#' spheres3d(fs[[i]]$voxels[, 1], fs[[i]]$voxels[, 2], fs[[i]]$voxels[, 3],
#' col = "red", radius = 0.5)
#' }}
voxelize <- function(f, from, to, by) {
.Call('_curveDepth_voxelize', PACKAGE = 'curveDepth', f, from, to, by)
}
Try the curveDepth package in your browser
Any scripts or data that you put into this service are public.
curveDepth documentation built on May 1, 2019, 8 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
#' Distance for images
#'
#' Calculates distance matrix for a sample of images using the minimax metric.
#' This fucntion can be seen as a wrapper of a sequential call of
#' \code{images2curves} and \code{dist.curves}.
#'
#' @param images A 3-dimensional array with each slice (matrix in first two
#' dimensions) corresponding to an image. Each (eps-strictly) positive
#' entry is regarded as an occupied pixel (one), otherwise it is regarded
#' as an empty pixel, of an image.
#'
#' @param verbosity Level of reporting messages, the higher the more progress
#' reports are printed, set \code{0} (default) for no messages.
#'
#' @return A matrix \code{dim(images)[3] x dim(images)[3]} with each entry
#' being the distance between two images.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Load two Sevens and one One, and plot them
#' data("mnistShort017")
#' # First Seven
#' firstSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(firstSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(firstSevenDigit)[1:2])
#' # Second Seven
#' secondSevenDigit <- mnistShort017$`7`[, , 6]
#' image(as.matrix(rev(as.data.frame(secondSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(secondSevenDigit)[1:2])
#' # A One
#' aOneDigit <- mnistShort017$`1`[, , 1]
#' image(as.matrix(rev(as.data.frame(aOneDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aOneDigit)[1:2])
#' # Caculate distances between all the images
#' threeDigits <- array(NA, dim = c(nrow(firstSevenDigit),
#' ncol(firstSevenDigit), 3))
#' threeDigits[, , 1] <- firstSevenDigit
#' threeDigits[, , 2] <- secondSevenDigit
#' threeDigits[, , 3] <- aOneDigit
#' distMatrix <- dist.images(threeDigits)
#' # Print distance matrix
#' print(distMatrix)
dist.images <- function(images, verbosity = 0L) {
.Call('_curveDepth_distImages', PACKAGE = 'curveDepth', images, verbosity)
}
#' Distance for curves
#'
#' Calculates distance matrix for a sample of curves using the minimax metric.
#'
#' @param curves A list where each element is a function being a list
#' containing a matrix \code{coords} (values, d columns).
#'
#' @param oneWay Whether curves should be condisered as a one-directional,
#' \code{FALSE} by default.
#'
#' @param verbosity Level of reporting messages, the higher the more progress
#' reports are printed, set \code{0} (default) for no messages.
#'
#' @return A matrix \code{length(curves) x length(curves)} with each entry
#' being the distance between two curves.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Load two Sevens and one One, plot them,
#' # and transform to curves
#' data("mnistShort017")
#' # First Seven
#' firstSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(firstSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(firstSevenDigit)[1:2])
#' firstSevenCurve <- images2curves(array(
#' firstSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # Second Seven
#' secondSevenDigit <- mnistShort017$`7`[, , 6]
#' image(as.matrix(rev(as.data.frame(secondSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(secondSevenDigit)[1:2])
#' secondSevenCurve <- images2curves(array(
#' secondSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # A One
#' aOneDigit <- mnistShort017$`1`[, , 1]
#' image(as.matrix(rev(as.data.frame(aOneDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aOneDigit)[1:2])
#' aOneCurve <- images2curves(array(
#' aOneDigit, dim = c(28, 28, 1)))[[1]]
#' # Caculate distances between all the curves
#' distMatrix <- dist.curves(list(
#' firstSevenCurve, secondSevenCurve, aOneCurve))
#' # Print distance matrix
#' print(distMatrix)
dist.curves <- function(curves, oneWay = FALSE, verbosity = 0L) {
.Call('_curveDepth_distCurves', PACKAGE = 'curveDepth', curves, oneWay, verbosity)
}
#' Distance for curves
#'
#' Calculates distance matrix for two samples of curves using minimax metric.
#' The function can be particularly useful for parallel computation of a
#' big distance matrix.
#'
#' @param curvesRows A list where each element is a function being a list
#' containing a matrix \code{coords} (values, d columns).
#'
#' @param curvesCols A list where each element is a function being a list
#' containing a matrix \code{coords} (values, d columns).
#'
#' @param oneWay Whether curves should be condisered as a one-directional,
#' \code{FALSE} by default.
#'
#' @param verbosity Level of reporting messages, the higher the more progress
#' reports are printed, set \code{0} (default) for no messages.
#'
#' @return A matrix \code{length(curvesRows) x length(curvesCols)} with each
#' entry being the distance between two corresponding curves.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Load two Sevens and one One, plot them,
#' # and transform to curves
#' data("mnistShort017")
#' # First Seven
#' firstSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(firstSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(firstSevenDigit)[1:2])
#' firstSevenCurve <- images2curves(array(
#' firstSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # Second Seven
#' secondSevenDigit <- mnistShort017$`7`[, , 6]
#' image(as.matrix(rev(as.data.frame(secondSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(secondSevenDigit)[1:2])
#' secondSevenCurve <- images2curves(array(
#' secondSevenDigit, dim = c(28, 28, 1)))[[1]]
#' # A One
#' aOneDigit <- mnistShort017$`1`[, , 1]
#' image(as.matrix(rev(as.data.frame(aOneDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aOneDigit)[1:2])
#' aOneCurve <- images2curves(array(
#' aOneDigit, dim = c(28, 28, 1)))[[1]]
#' # Caculate distances between all the curves
#' distMatrix <- matrix(0, 3, 3)
#' distMatrix[3, 1:2] <- distMatrix[1:2, 3] <-
#' dist.curves.asymm(list(
#' firstSevenCurve, secondSevenCurve), list(aOneCurve))
#' distMatrix[2, 1] <- distMatrix[1, 2] <-
#' dist.curves.asymm(
#' list(firstSevenCurve), list(secondSevenCurve))
#' # Print distance matrix
#' print(distMatrix)
dist.curves.asymm <- function(curvesRows, curvesCols, oneWay = FALSE, verbosity = 0L) {
.Call('_curveDepth_distCurvesAsymm', PACKAGE = 'curveDepth', curvesRows, curvesCols, oneWay, verbosity)
}
#' Calculate Tukey curve depth using given points
#'
#' Calculates Tukey curve depth of each curve in \code{objects} w.r.t. the
#' sample of curves in \code{data}. Calculation of partial depth of each
#' single point can be either exact or approximate. If exact, modified method
#' of Dyckerhoff and Mozharovskyi (2016) is used; if approximate,
#' approximation is performed by projections on directions - points uniformly
#' distributed on the unit hypersphere.
#'
#' @param objects A list where each element is a multivariate curve being a
#' list containing a matrix \code{coords} (values, d columns).
#'
#' @param data A list where each element is a multivariate curve being a list
#' containing a matrix \code{coords} (values, d columns). The depths are
#' computed w.r.t. this data set.
#'
#' @param nDirs Number of directions used to inspect the space, drawn from the
#' uniform distribution on the sphere.
#'
#' @param subs Whether to split each object into two disjunctive subsets (one
#' for integrating and one for estimation) when computing the depth.
#'
#' @param fracInt Portion of an object used for integrating.
#'
#' @param fracEst Portion of an object used for estimation,
#' maximum: \code{1 - fracInt}.
#'
#' @param subsamples A list indicating subsamples of points for each curve in
#' \code{objects}. Each elemnt of the list corresponds to a single curve and
#' should be given as a vector of the length equal to the number of points
#' on it, with entries indicating:
#' \itemize{
#' \item 0 do not take the point into account at all,
#' \item 1 use point as a reference (i.e. for integrating) and thus
#' calculate its depth,
#' \item 2 utilize point in depth calculation (i.e. for estimation).}
#'
#' @param exactEst Is calculation of depth for each reference point of the
#' curve exact (\code{TRUE}, by default) or approximate (\code{FALSE}).
#'
#' @param minMassObj Minimal portion of the \code{objects} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @param minMassDat minimal portion of the \code{data} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @return A vector of doubles having the same length as \code{objects}, whose
#' each entry is the depth of each element of \code{objects} w.r.t.
#' \code{data}.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' Dyckerhoff, R. and Mozharovskyi P. (2016). Exact computation of the
#' halfspace depth. \emph{Computational Statistics and Data Analysis}, 98,
#' 19-30.
#'
#' @examples
#' library(curveDepth)
#' # Load digits and transform them to curves
#' data("mnistShort017")
#' n <- 10 # cardinality of each class
#' m <- 50 # number of points to sample
#' cst <- 1/10 # a threshold constant
#' alp <- 1/8 # a threshold constant
#' curves0 <- images2curves(mnistShort017$`0`[, , 1:n])
#' curves1 <- images2curves(mnistShort017$`1`[, , 1:n])
#' set.seed(1)
#' curves0Smpl <- sample.curves(curves0, 2 * m)
#' curves1Smpl <- sample.curves(curves1, 2 * m)
#' # Calculate depths
#' depthSpace = matrix(NA, nrow = n * 2, ncol = 2)
#' depthSpace[, 1] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves0Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' depthSpace[, 2] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves1Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' # Draw the DD-plot
#' plot(NULL, xlim = c(0, 1), ylim = c(0, 1),
#' xlab = paste("Depth w.r.t. '0'"),
#' ylab = paste("Depth w.r.t. '1'"),
#' main = paste("DD-plot for '0' vs '1'"))
#' grid()
#' # Draw the separating rule
#' dat1 <- data.frame(cbind(
#' depthSpace, c(rep(0, n), rep(1, n))))
#' ddalpha1 <- ddalpha.train(X3 ~ X1 + X2, data = dat1,
#' depth = "ddplot",
#' separator = "alpha")
#' ddnormal <- ddalpha1$classifiers[[1]]$hyperplane[2:3]
#' pts <- matrix(c(0, 0, 1, ddnormal[1] / -ddnormal[2]),
#' nrow = 2, byrow = TRUE)
#' lines(pts, lwd = 2)
#' # Draw the points
#' points(depthSpace[1:n, ],
#' col = "red", lwd = 2, pch = 1)
#' points(depthSpace[(n + 1):(2 * n), ],
#' col = "blue", lwd = 2, pch = 3)
depth.curve.Tukey <- function(objects, data, nDirs = 100L, subs = TRUE, fracInt = 0.5, fracEst = 0.5, subsamples = NULL, exactEst = TRUE, minMassObj = 0, minMassDat = 0) {
.Call('_curveDepth_depthCurveTukey', PACKAGE = 'curveDepth', objects, data, nDirs, subs, fracInt, fracEst, subsamples, exactEst, minMassObj, minMassDat)
}
#' Sample points on curves
#'
#' Samples points uniformly on curves interpolated as linear consequent
#' segments.
#'
#' @param curves A list where each element is a function being a list
#' containing a matrix \code{coords} (curves' values, d columns).
#'
#' @param ptsPerCurve A vector of numbers of points to be sampled on each
#' curve. If \code{length(ptsPerCurve) < length(curves)} then the first entry
#' of \code{ptsPerCurve} is considered only, and corresponds to the number of
#' points on a curve.
#'
#' @return A list of curves with each entry being a list constiting of [[1]]
#' the drawn curve being a matrix named \code{coords}, [[2]] length of the
#' curve as in \code{curves} named \code{length.init}, and [[3]] length of the
#' drawn curve named \code{length}.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Load digits and transform them to curves
#' data("mnistShort017")
#' n <- 10 # cardinality of each class
#' m <- 50 # number of points to sample
#' cst <- 1/10 # a threshold constant
#' alp <- 1/8 # a threshold constant
#' curves0 <- images2curves(mnistShort017$`0`[, , 1:n])
#' curves1 <- images2curves(mnistShort017$`1`[, , 1:n])
#' set.seed(1)
#' curves0Smpl <- sample.curves(curves0, 2 * m)
#' curves1Smpl <- sample.curves(curves1, 2 * m)
#' # Calculate depths
#' depthSpace = matrix(NA, nrow = n * 2, ncol = 2)
#' depthSpace[, 1] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves0Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' depthSpace[, 2] = depth.curve.Tukey(
#' c(curves0Smpl, curves1Smpl), curves1Smpl,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' # Draw the DD-plot
#' plot(NULL, xlim = c(0, 1), ylim = c(0, 1),
#' xlab = paste("Depth w.r.t. '0'"),
#' ylab = paste("Depth w.r.t. '1'"),
#' main = paste("DD-plot for '0' vs '1'"))
#' grid()
#' # Draw the separating rule
#' dat1 <- data.frame(cbind(
#' depthSpace, c(rep(0, n), rep(1, n))))
#' ddalpha1 <- ddalpha.train(X3 ~ X1 + X2, data = dat1,
#' depth = "ddplot",
#' separator = "alpha")
#' ddnormal <- ddalpha1$classifiers[[1]]$hyperplane[2:3]
#' pts <- matrix(c(0, 0, 1, ddnormal[1] / -ddnormal[2]),
#' nrow = 2, byrow = TRUE)
#' lines(pts, lwd = 2)
#' # Draw the points
#' points(depthSpace[1:n, ],
#' col = "red", lwd = 2, pch = 1)
#' points(depthSpace[(n + 1):(2 * n), ],
#' col = "blue", lwd = 2, pch = 3)
sample.curves <- function(curves, ptsPerCurve = as.integer( c(500))) {
.Call('_curveDepth_curvesSubsample', PACKAGE = 'curveDepth', curves, ptsPerCurve)
}
#' Convert images to curves
#'
#' Converts images to curves with points sorted in traversing order.
#'
#' @param images A 3-dimensional array with each slice (matrix in first two
#' dimensions) corresponding to an image. Each (eps-strictly) positive
#' entry is regarded as an occupied pixel (one), otherwise it is regarded
#' as an empty pixel, of an image.
#'
#' @return A list of curves where each element is a function being a list
#' containing a matrix \code{coords} (curve's values, d columns).
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Pixel-grid filling function for an image
#' plotGridImage <- function(dims){
#' redDims1 <- dims[1] - 1
#' redDims2 <- dims[2] - 1
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / redDims1 - 0.5 / redDims1,
#' i / redDims1 - 0.5 / redDims1),
#' c(0 - 0.5 / redDims2, 1 + 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0 - 0.5 / redDims1, 1 + 0.5 / redDims1),
#' c(i / redDims2 - 0.5 / redDims2,
#' i / redDims2 - 0.5 / redDims2),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0 - 0.5 / redDims1, 0 - 0.5 / redDims2,
#' 1 + 0.5 / redDims1, 1 + 0.5 / redDims2)
#' }
#' # Pixel-grid filling function for a curve
#' plotGridCurve <- function(dims){
#' for (i in 1:(dims[1] - 1)){
#' lines(c(i / dims[1], i / dims[1]), c(0, 1),
#' lwd = 1, lty = 3, col = "lightgray")
#' lines(c(0, 1), c(i / dims[2], i / dims[2]),
#' lwd = 1, lty = 3, col = "lightgray")
#' }
#' rect(0, 0, 1, 1)
#' }
#' # Load a digit and plot it
#' data("mnistShort017")
#' aSevenDigit <- mnistShort017$`7`[, , 5]
#' image(as.matrix(rev(as.data.frame(aSevenDigit))),
#' col = gray((255:0) / 256), asp = 1,
#' xlim = c(0 - 1 / 27, 1 + 1 / 27),
#' ylim = c(0 - 1 / 27, 1 + 1 / 27))
#' plotGridImage(dim(aSevenDigit)[1:2])
#' # Convert the digit to a curve and plot it
#' aSevenCurve <- images2curves(array(
#' aSevenDigit, dim = c(28, 28, 1)))[[1]]
#' plot(cbind(aSevenCurve$coords[, 1],
#' 1 - aSevenCurve$coords[, 2]),
#' type = "l", lwd = 3, asp = 1,
#' xlim = c(0, 1), ylim = c(0, 1),
#' xlab = "x", ylab = "y")
#' plotGridCurve(dim(aSevenDigit)[1:2])
images2curves <- function(images) {
.Call('_curveDepth_images2curves', PACKAGE = 'curveDepth', images)
}
#' Calculate Tukey curve depth for curves
#'
#' Calculates Tukey curve depth of each curve in \code{objects} w.r.t. the
#' sample of curves in \code{data}. First, \code{m} points are sampled from a
#' uniform distribution on a piecewise linear approximation of each of the
#' curves in \code{data} and \code{m / fracEst * (fracInt + fracEst)} points
#' on each of the curves in \code{objects}. Second, these samples are used to
#' calculate the Tukey curve depth.
#'
#' Calculation of partial depth of each single point can be either exact
#' or approximate. If exact, an extension of the method of
#' Dyckerhoff and Mozharovskyi (2016) is used; if approximate, approximation
#' is performed by projections on directions - points uniformly distributed on
#' the unit hypersphere.
#'
#' @param objects A list where each element is a multivariate curve being a
#' list containing a matrix \code{coords} (values, d columns).
#'
#' @param data A list where each element is a multivariate curve being a list
#' containing a matrix \code{coords} (values, d columns). The depths are
#' computed w.r.t. this data set.
#'
#' @param nDirs Number of directions used to inspect the space, drawn from the
#' uniform distribution on the sphere.
#'
#' @param subs Whether to split each object into two disjunctive subsets (one
#' for integrating and one for estimation) when computing the depth.
#'
#' @param m Number of points used for estimation.
#'
#' @param fracInt Portion of an object used for integrating.
#'
#' @param fracEst Portion of an object used for estimation,
#' maximum: \code{1 - fracInt}.
#'
#' @param exactEst Is calculation of depth for each reference point of the
#' curve exact (\code{TRUE}, by default) or approximate (\code{FALSE}).
#'
#' @param minMassObj Minimal portion of the \code{objects} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @param minMassDat minimal portion of the \code{data} distribution in the
#' halfspace to be considered when calculating depth.
#'
#' @return A vector of doubles having the same length as \code{objects}, whose
#' each entry is the depth of each element of \code{objects} w.r.t.
#' \code{data}.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' Dyckerhoff, R. and Mozharovskyi P. (2016). Exact computation of the
#' halfspace depth. \emph{Computational Statistics and Data Analysis}, 98,
#' 19-30.
#'
#' @examples
#' library(curveDepth)
#' # Load digits and transform them to curves
#' data("mnistShort017")
#' n <- 10 # cardinality of each class
#' m <- 50 # number of points to sample
#' cst <- 1/10 # a threshold constant
#' alp <- 1/8 # a threshold constant
#' curves0 <- images2curves(mnistShort017$`0`[, , 1:n])
#' curves1 <- images2curves(mnistShort017$`1`[, , 1:n])
#' # Calculate depths
#' depthSpace = matrix(NA, nrow = n * 2, ncol = 2)
#' set.seed(1)
#' depthSpace[, 1] = depthc.Tukey(
#' c(curves0, curves1), curves0, m = m,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' depthSpace[, 2] = depthc.Tukey(
#' c(curves0, curves1), curves1, m = m,
#' exactEst = TRUE, minMassObj = cst/m^alp)
#' # Draw the DD-plot
#' plot(NULL, xlim = c(0, 1), ylim = c(0, 1),
#' xlab = paste("Depth w.r.t. '0'"),
#' ylab = paste("Depth w.r.t. '1'"),
#' main = paste("DD-plot for '0' vs '1'"))
#' grid()
#' # Draw the separating rule
#' dat1 <- data.frame(cbind(
#' depthSpace, c(rep(0, n), rep(1, n))))
#' ddalpha1 <- ddalpha.train(X3 ~ X1 + X2, data = dat1,
#' depth = "ddplot",
#' separator = "alpha")
#' ddnormal <- ddalpha1$classifiers[[1]]$hyperplane[2:3]
#' pts <- matrix(c(0, 0, 1, ddnormal[1] / -ddnormal[2]),
#' nrow = 2, byrow = TRUE)
#' lines(pts, lwd = 2)
#' # Draw the points
#' points(depthSpace[1:n, ],
#' col = "red", lwd = 2, pch = 1)
#' points(depthSpace[(n + 1):(2 * n), ],
#' col = "blue", lwd = 2, pch = 3)
depthc.Tukey <- function(objects, data, nDirs = 100L, subs = TRUE, m = 500L, fracInt = 0.5, fracEst = 0.5, exactEst = TRUE, minMassObj = 0, minMassDat = 0) {
.Call('_curveDepth_depthCTukey', PACKAGE = 'curveDepth', objects, data, nDirs, subs, m, fracInt, fracEst, exactEst, minMassObj, minMassDat)
}
#' Voxelization of functions
#'
#' Convertes a pice-wise linear parametrized funtion into a discretized
#' voxel representation.
#'
#' @param f A parametrized function as a list containing a vector
#' "args" (arguments), and a matrix "vals" (values, d columns).
#'
#' @param from A vector of d numbers, each giving a starting discretization
#' point for one dimension.
#'
#' @param to A vector of d numbers, each giving a finishing discretization
#' point for one dimension.
#'
#' @param by A vector of d numbers, each giving discretization step for one
#' dimension.
#'
#' @return A list containing two matrices: "voxels" with rows being voxel
#' numbers, and "coords" with rows being coordinates of voxel centers.
#'
#' @references Lafaye De Micheaux, P., Mozharovskyi, P. and Vimond, M. (2018).
#' Depth for curve data and applications.
#'
#' @examples
#' library(curveDepth)
#' # Create some data based on growth curves
#' g1d <- dataf.growth()
#' g3d <- list("")
#' set.seed(1)
#' for (i in 1:length(g1d$dataf)){
#' g3d[[i]] <- list(
#' args = g1d$dataf[[1]]$args,
#' vals = cbind(g1d$dataf[[i]]$vals,
#' g1d$dataf[[i]]$vals[length(g1d$dataf[[i]]$vals):1],
#' rnorm(length(g1d$dataf[[i]]$vals), sd = 1) +
#' rnorm(1, mean = 0, sd = 10)))
#' }
#' # Define voxels' bounds and resolution
#' from <- c(65, 65, -25)
#' to <- c(196, 196, 25)
#' steps <- 100
#' by <- (to - from) / steps
#' # Voxelize all curves
#' fs <- list("")
#' for (i in 1:length(g3d)){
#' fs[[i]] <- voxelize(g3d[[i]], from, to, by)
#' }
#' \dontrun{
#' # Plot first 10 curves
#' library(rgl)
#' rgl.open()
#' rgl.bg(color = "white")
#' for (i in 1:10){
#' spheres3d(fs[[i]]$voxels[, 1], fs[[i]]$voxels[, 2], fs[[i]]$voxels[, 3],
#' col = "red", radius = 0.5)
#' }}
voxelize <- function(f, from, to, by) {
.Call('_curveDepth_voxelize', PACKAGE = 'curveDepth', f, from, to, by)
}
Try the curveDepth package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.