add: runtime_test demo
This commit is contained in:
parent
b071a689d9
commit
16e03fad3c
|
@ -6,7 +6,7 @@ Date: 2019-07-29
|
||||||
Author: Loki
|
Author: Loki
|
||||||
Maintainer: Loki <loki@no.mail>
|
Maintainer: Loki <loki@no.mail>
|
||||||
Description: More about what it does (maybe more than one line)
|
Description: More about what it does (maybe more than one line)
|
||||||
License: What license is it under?
|
License: GPL-3
|
||||||
Imports: Rcpp (>= 1.0.2)
|
Imports: Rcpp (>= 1.0.2)
|
||||||
LinkingTo: Rcpp, RcppArmadillo
|
LinkingTo: Rcpp, RcppArmadillo
|
||||||
Encoding: UTF-8
|
Encoding: UTF-8
|
||||||
|
|
26
CVE/R/CVE.R
26
CVE/R/CVE.R
|
@ -20,12 +20,22 @@
|
||||||
#' TODO: See ...
|
#' TODO: See ...
|
||||||
#' @examples
|
#' @examples
|
||||||
#' library(CVE)
|
#' library(CVE)
|
||||||
#' ds <- dataset("M5")
|
|
||||||
#' X <- ds$X
|
|
||||||
#' Y <- ds$Y
|
|
||||||
#' dr <- cve(Y ~ X, k = 1)
|
|
||||||
#'
|
#'
|
||||||
#' @references Fertl L, Bura E. Conditional Variance Estimation for Sufficient Dimension Reduction, 2019
|
#' # sample dataset
|
||||||
|
#' ds <- dataset("M5")
|
||||||
|
#'
|
||||||
|
#' # call ´cve´ with default method (aka "simple")
|
||||||
|
#' dr.simple <- cve(ds$Y ~ ds$X, k = ncol(ds$B))
|
||||||
|
#' # plot optimization history (loss via iteration)
|
||||||
|
#' plot(dr.simple, main = "CVE M5 simple")
|
||||||
|
#'
|
||||||
|
#' # call ´cve´ with method "linesearch" using ´data.frame´ as data.
|
||||||
|
#' data <- data.frame(Y = ds$Y, X = ds$X)
|
||||||
|
#' # Note: ´Y, X´ are NOT defined, they are extracted from ´data´.
|
||||||
|
#' dr.linesearch <- cve(Y ~ ., data, method = "linesearch", k = ncol(ds$B))
|
||||||
|
#' plot(dr.linesearch, main = "CVE M5 linesearch")
|
||||||
|
#'
|
||||||
|
#' @references Fertl L., Bura E. Conditional Variance Estimation for Sufficient Dimension Reduction, 2019
|
||||||
#'
|
#'
|
||||||
#' @import stats
|
#' @import stats
|
||||||
#' @importFrom stats model.frame
|
#' @importFrom stats model.frame
|
||||||
|
@ -51,6 +61,7 @@ cve <- function(formula, data, method = "simple", ...) {
|
||||||
return(dr)
|
return(dr)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#' @param nObs as describet in the Paper.
|
||||||
#' @rdname cve
|
#' @rdname cve
|
||||||
#' @export
|
#' @export
|
||||||
cve.call <- function(X, Y, method = "simple", nObs = nrow(X)^.5, k, ...) {
|
cve.call <- function(X, Y, method = "simple", nObs = nrow(X)^.5, k, ...) {
|
||||||
|
@ -101,7 +112,10 @@ cve.call <- function(X, Y, method = "simple", nObs = nrow(X)^.5, k, ...) {
|
||||||
#' }
|
#' }
|
||||||
#' @param ... Pass through parameters to [plot()] and [lines()]
|
#' @param ... Pass through parameters to [plot()] and [lines()]
|
||||||
#'
|
#'
|
||||||
#' @seealso see \code{\link{par}} for graphical parameters to pass through.
|
#' @usage ## S3 method for class 'cve'
|
||||||
|
#' plot(x, content = "history", ...)
|
||||||
|
#' @seealso see \code{\link{par}} for graphical parameters to pass through
|
||||||
|
#' as well as \code{\link{plot}} for standard plot utility.
|
||||||
#' @importFrom graphics plot lines points
|
#' @importFrom graphics plot lines points
|
||||||
#' @method plot cve
|
#' @method plot cve
|
||||||
#' @export
|
#' @export
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
runtime_test Runtime comparison of CVE against MAVE for M1 - M5 datasets.
|
|
@ -0,0 +1,106 @@
|
||||||
|
# -----------------------------------------------------------------------------
|
||||||
|
# Program: runtime_test.R
|
||||||
|
# Author: Loki
|
||||||
|
# Date: 2019.08.12
|
||||||
|
#
|
||||||
|
# Purpose:
|
||||||
|
# Comparing runtime of "MAVE" with "CVE".
|
||||||
|
#
|
||||||
|
# RevisionHistory:
|
||||||
|
# Loki -- 2019.08.12 initial creation
|
||||||
|
# -----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
# load CVE package
|
||||||
|
library(CVE)
|
||||||
|
# load MAVE package for comparison
|
||||||
|
library(MAVE)
|
||||||
|
|
||||||
|
# set nr of simulations per dataset
|
||||||
|
nr.sim <- 10
|
||||||
|
|
||||||
|
# set names of datasets to run tests on
|
||||||
|
dataset.names <- c("M1", "M2", "M3", "M4", "M5")
|
||||||
|
|
||||||
|
#' Orthogonal projection to sub-space spanned by `B`
|
||||||
|
#'
|
||||||
|
#' @param B Matrix
|
||||||
|
#' @return Orthogonal Projection Matrix
|
||||||
|
proj <- function(B) {
|
||||||
|
B %*% solve(t(B) %*% B) %*% t(B)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' Compute nObs given dataset dimension \code{n}.
|
||||||
|
#'
|
||||||
|
#' @param n Number of samples
|
||||||
|
#' @return Numeric estimate of \code{nObs}
|
||||||
|
nObs <- function (n) { n^0.5 }
|
||||||
|
|
||||||
|
## prepare "logging"
|
||||||
|
# result error, time, ... data.frame's
|
||||||
|
error <- matrix(nrow = nr.sim, ncol = 2 * length(dataset.names))
|
||||||
|
time <- matrix(nrow = nr.sim, ncol = 2 * length(dataset.names))
|
||||||
|
# convert to data.frames
|
||||||
|
error <- as.data.frame(error)
|
||||||
|
time <- as.data.frame(time)
|
||||||
|
# set names
|
||||||
|
names(error) <- kronecker(c("CVE.", "MAVE."), dataset.names, paste0)
|
||||||
|
names(time) <- kronecker(c("CVE.", "MAVE."), dataset.names, paste0)
|
||||||
|
|
||||||
|
# get current time
|
||||||
|
start.time <- Sys.time()
|
||||||
|
## main comparison loop (iterate `nr.sim` times for each dataset)
|
||||||
|
for (i in seq_along(dataset.names)) {
|
||||||
|
for (j in 1:nr.sim) {
|
||||||
|
name <- dataset.names[i]
|
||||||
|
# reporting progress
|
||||||
|
cat("\rRunning Test (", name, j , "):",
|
||||||
|
(i - 1) * nr.sim + j, "/", length(dataset.names) * nr.sim,
|
||||||
|
" - Time since start:", format(Sys.time() - start.time), "\033[K")
|
||||||
|
# sample new dataset
|
||||||
|
ds <- dataset(name)
|
||||||
|
k <- ncol(ds$B) # real dim
|
||||||
|
data <- data.frame(X = ds$X, Y = ds$Y)
|
||||||
|
# call CVE
|
||||||
|
cve.time <- system.time(
|
||||||
|
cve.res <- cve(Y ~ .,
|
||||||
|
data = data,
|
||||||
|
method = "simple",
|
||||||
|
k = k)
|
||||||
|
)
|
||||||
|
# call MAVE
|
||||||
|
mave.time <- system.time(
|
||||||
|
mave.res <- mave(Y ~ .,
|
||||||
|
data = data,
|
||||||
|
method = "meanMAVE")
|
||||||
|
)
|
||||||
|
# compute real and approximated sub-space projections
|
||||||
|
P <- proj(ds$B) # real
|
||||||
|
P.cve <- proj(cve.res$B)
|
||||||
|
P.mave <- proj(mave.res$dir[[k]])
|
||||||
|
# compute (and store) errors
|
||||||
|
error[j, paste0("CVE.", name)] <- norm(P - P.cve, 'F') / sqrt(2 * k)
|
||||||
|
error[j, paste0("MAVE.", name)] <- norm(P - P.mave, 'F') / sqrt(2 * k)
|
||||||
|
# store run-times
|
||||||
|
time[j, paste0("CVE.", name)] <- cve.time["elapsed"]
|
||||||
|
time[j, paste0("MAVE.", name)] <- mave.time["elapsed"]
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
cat("\n\n## Time [sec] Means:\n")
|
||||||
|
print(colMeans(time))
|
||||||
|
cat("\n## Error Means:\n")
|
||||||
|
print(colMeans(error))
|
||||||
|
|
||||||
|
len <- length(dataset.names)
|
||||||
|
boxplot(as.matrix(error),
|
||||||
|
main = paste0("Error (nr.sim = ", nr.sim, ")"),
|
||||||
|
ylab = expression(error == group("||", P[B] - P[hat(B)], "||")[F] / sqrt(2*k)),
|
||||||
|
las = 2,
|
||||||
|
at = c(1:len, 1:len + len + 1)
|
||||||
|
)
|
||||||
|
boxplot(as.matrix(time),
|
||||||
|
main = paste0("Time (nr.sim = ", nr.sim, ")"),
|
||||||
|
ylab = "time [sec]",
|
||||||
|
las = 2,
|
||||||
|
at = c(1:len, 1:len + len + 1)
|
||||||
|
)
|
|
@ -26,6 +26,8 @@ See: \code{\link{formula}}.}
|
||||||
|
|
||||||
\item{...}{Further parameters depending on the used method.
|
\item{...}{Further parameters depending on the used method.
|
||||||
TODO: See ...}
|
TODO: See ...}
|
||||||
|
|
||||||
|
\item{nObs}{as describet in the Paper.}
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Conditional Variance Estimator (CVE) is a novel sufficient dimension
|
Conditional Variance Estimator (CVE) is a novel sufficient dimension
|
||||||
|
@ -35,12 +37,22 @@ where B'X is a lower dimensional projection of the predictors.
|
||||||
}
|
}
|
||||||
\examples{
|
\examples{
|
||||||
library(CVE)
|
library(CVE)
|
||||||
|
|
||||||
|
# sample dataset
|
||||||
ds <- dataset("M5")
|
ds <- dataset("M5")
|
||||||
X <- ds$X
|
|
||||||
Y <- ds$Y
|
# call ´cve´ with default method (aka "simple")
|
||||||
dr <- cve(Y ~ X, k = 1)
|
dr.simple <- cve(ds$Y ~ ds$X, k = ncol(ds$B))
|
||||||
|
# plot optimization history (loss via iteration)
|
||||||
|
plot(dr.simple, main = "CVE M5 simple")
|
||||||
|
|
||||||
|
# call ´cve´ with method "linesearch" using ´data.frame´ as data.
|
||||||
|
data <- data.frame(Y = ds$Y, X = ds$X)
|
||||||
|
# Note: ´Y, X´ are NOT defined, they are extracted from ´data´.
|
||||||
|
dr.linesearch <- cve(Y ~ ., data, method = "linesearch", k = ncol(ds$B))
|
||||||
|
plot(dr.linesearch, main = "CVE M5 linesearch")
|
||||||
|
|
||||||
}
|
}
|
||||||
\references{
|
\references{
|
||||||
Fertl L, Bura E. Conditional Variance Estimation for Sufficient Dimension Reduction, 2019
|
Fertl L., Bura E. Conditional Variance Estimation for Sufficient Dimension Reduction, 2019
|
||||||
}
|
}
|
||||||
|
|
|
@ -2,24 +2,27 @@
|
||||||
% Please edit documentation in R/CVE.R
|
% Please edit documentation in R/CVE.R
|
||||||
\name{plot.cve}
|
\name{plot.cve}
|
||||||
\alias{plot.cve}
|
\alias{plot.cve}
|
||||||
\title{Ploting helper for objects of class \code{"cve"}.}
|
\title{Ploting helper for objects of class \code{cve}.}
|
||||||
\usage{
|
\usage{
|
||||||
\method{plot}{cve}(x, ...)
|
## S3 method for class 'cve'
|
||||||
|
plot(x, content = "history", ...)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
\item{x}{Object of class \code{"cve"} (result of [cve()]).}
|
\item{x}{Object of class \code{cve} (result of [cve()]).}
|
||||||
|
|
||||||
\item{...}{Pass through parameters to [plot()] and [lines()]}
|
\item{...}{Pass through parameters to [plot()] and [lines()]}
|
||||||
|
|
||||||
\item{content}{Specifies what to plot:
|
\item{content}{Specifies what to plot:
|
||||||
\itemize{
|
\itemize{
|
||||||
\item "history" Plots the loss history from stiefel optimization.
|
\item "history" Plots the loss history from stiefel optimization
|
||||||
|
(default).
|
||||||
\item ... TODO: add (if there are any)
|
\item ... TODO: add (if there are any)
|
||||||
}}
|
}}
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Ploting helper for objects of class \code{"cve"}.
|
Ploting helper for objects of class \code{cve}.
|
||||||
}
|
}
|
||||||
\seealso{
|
\seealso{
|
||||||
see \code{\link{par}} for graphical parameters to pass through.
|
see \code{\link{par}} for graphical parameters to pass through
|
||||||
|
as well as \code{\link{plot}} for standard plot utility.
|
||||||
}
|
}
|
||||||
|
|
26
README.md
26
README.md
|
@ -5,3 +5,29 @@
|
||||||
The `*.R` and `*.cpp` files in the root directory are _development_ and _test_ files.
|
The `*.R` and `*.cpp` files in the root directory are _development_ and _test_ files.
|
||||||
|
|
||||||
## TODO: README.md
|
## TODO: README.md
|
||||||
|
|
||||||
|
# Package Structure
|
||||||
|
|
||||||
|
## Demos
|
||||||
|
A demo is an `.R` file that lives in `demo/`. Demos are like examples but tend to
|
||||||
|
be longer. Instead of focussing on a single function, they show how to weave
|
||||||
|
together multiple functions to solve a problem.
|
||||||
|
|
||||||
|
You list and access demos with `demo()`:
|
||||||
|
* Show all available demos: `demo()`.
|
||||||
|
* Show all demos in a package: `demo(package = "CVE")`.
|
||||||
|
* Run a specific demo: `demo("runtime_test", package = "CVE")`.
|
||||||
|
* Find a demo: `system.file("demo", "runtime_test.R", package = "CVE")`.
|
||||||
|
|
||||||
|
Each demo must be listed in `demo/00Index` in the following form:
|
||||||
|
`demo-name Demo description`.
|
||||||
|
The demo name is the name of the file without the extension,
|
||||||
|
e.g. `demo/runtime_test.R` becomes `runtime_test`.
|
||||||
|
|
||||||
|
By default the demo ask for human input for each plot: "Hit to see next plot".
|
||||||
|
This behaviour can be overridden by adding `devAskNewPage(ask = FALSE)` to
|
||||||
|
the demo file. You can add pauses by adding:
|
||||||
|
`readline("press any key to continue")`.
|
||||||
|
|
||||||
|
**Note**: Demos are not automatically tested by `R CMD check`. This means that they
|
||||||
|
can easily break without your knowledge.
|
||||||
|
|
Loading…
Reference in New Issue