wip: convert to package
This commit is contained in:
parent
3092f6c3f7
commit
db550c77bd
|
@ -1,4 +1,4 @@
|
||||||
# ---> C
|
## C compiler and compiled library files
|
||||||
# Prerequisites
|
# Prerequisites
|
||||||
*.d
|
*.d
|
||||||
|
|
||||||
|
@ -43,24 +43,7 @@
|
||||||
*.idb
|
*.idb
|
||||||
*.pdb
|
*.pdb
|
||||||
|
|
||||||
# Kernel Module Compile Results
|
## R environment, data and pacakge build intermediate files/folders
|
||||||
*.mod*
|
|
||||||
*.cmd
|
|
||||||
.tmp_versions/
|
|
||||||
modules.order
|
|
||||||
Module.symvers
|
|
||||||
Mkfile.old
|
|
||||||
dkms.conf
|
|
||||||
|
|
||||||
# ---> R
|
|
||||||
# History files
|
|
||||||
.Rhistory
|
|
||||||
.Rapp.history
|
|
||||||
|
|
||||||
# Session Data files
|
|
||||||
*.RData
|
|
||||||
*.Rdata
|
|
||||||
|
|
||||||
# R Data Object files
|
# R Data Object files
|
||||||
*.Rds
|
*.Rds
|
||||||
*.rds
|
*.rds
|
||||||
|
@ -68,22 +51,13 @@ dkms.conf
|
||||||
# Example code in package build process
|
# Example code in package build process
|
||||||
*-Ex.R
|
*-Ex.R
|
||||||
|
|
||||||
# Output files from R CMD build
|
|
||||||
/*.tar.gz
|
|
||||||
|
|
||||||
# Output files from R CMD check
|
# Output files from R CMD check
|
||||||
/*.Rcheck/
|
/*.Rcheck/
|
||||||
|
|
||||||
# RStudio files
|
|
||||||
.Rproj.user/
|
|
||||||
|
|
||||||
# produced vignettes
|
# produced vignettes
|
||||||
vignettes/*.html
|
vignettes/*.html
|
||||||
vignettes/*.pdf
|
vignettes/*.pdf
|
||||||
|
|
||||||
# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
|
|
||||||
.httr-oauth
|
|
||||||
|
|
||||||
# knitr and R markdown default cache directories
|
# knitr and R markdown default cache directories
|
||||||
/*_cache/
|
/*_cache/
|
||||||
/cache/
|
/cache/
|
||||||
|
@ -92,8 +66,32 @@ vignettes/*.pdf
|
||||||
*.utf8.md
|
*.utf8.md
|
||||||
*.knit.md
|
*.knit.md
|
||||||
|
|
||||||
# Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html
|
# R documentation
|
||||||
rsconnect/
|
*.Rd
|
||||||
|
|
||||||
|
## R session, RStudio and VSCode files
|
||||||
|
# RStudio files
|
||||||
|
.Rproj.user/
|
||||||
|
|
||||||
|
# History files
|
||||||
|
.Rhistory
|
||||||
|
.Rapp.history
|
||||||
|
|
||||||
|
# Session Data files
|
||||||
|
*.RData
|
||||||
|
*.Rdata
|
||||||
|
|
||||||
|
# VSCode configuration
|
||||||
|
.vscode/
|
||||||
|
|
||||||
|
## Archives, compressed files/folders
|
||||||
|
# Output files from R CMD build
|
||||||
|
*.tar.gz
|
||||||
|
*.zip
|
||||||
|
|
||||||
|
## Further project development folders/files
|
||||||
# General Work In Progress files
|
# General Work In Progress files
|
||||||
wip/
|
wip/
|
||||||
|
|
||||||
|
# PDFs
|
||||||
|
*.pdf
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
Package: tensorPredictors
|
Package: tensorPredictors
|
||||||
Type: Package
|
Type: Package
|
||||||
Title: Tensor/Matrix valued predictors for regression and dimension reduction
|
Title: Sufficient Dimension Reduction for Matrix Valued Predictors
|
||||||
Version: 0.1
|
Version: 0.1
|
||||||
Date: 2021-10-28
|
Date: 2021-10-28
|
||||||
Author: Daniel Kapla [aut]
|
Author: Daniel Kapla [aut]
|
||||||
|
@ -8,6 +8,8 @@ Maintainer: Daniel Kapla <daniel@kapla.at>
|
||||||
Description: Multiple methods using tensor/matrix valued predictors for
|
Description: Multiple methods using tensor/matrix valued predictors for
|
||||||
regression or sufficient dimension reduction.
|
regression or sufficient dimension reduction.
|
||||||
License: GPL-3
|
License: GPL-3
|
||||||
Depends:
|
Depends: R(>= 3.0)
|
||||||
|
Imports: stats
|
||||||
|
Suggests: RSpectra
|
||||||
Encoding: UTF-8
|
Encoding: UTF-8
|
||||||
RoxygenNote: 7.1.1
|
RoxygenNote: 7.1.1
|
||||||
|
|
|
@ -4,4 +4,6 @@ export(LSIR)
|
||||||
export(PCA2d)
|
export(PCA2d)
|
||||||
export(POI)
|
export(POI)
|
||||||
export(approx.kronecker)
|
export(approx.kronecker)
|
||||||
|
export(reduce)
|
||||||
|
import(stats)
|
||||||
useDynLib(tensorPredictors, .registration = TRUE)
|
useDynLib(tensorPredictors, .registration = TRUE)
|
||||||
|
|
|
@ -13,15 +13,13 @@
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples
|
||||||
#' A <- matrix(seq(14), 7, 2)
|
#' A <- matrix(seq(14), 7, 2)
|
||||||
#' B <- matrix(c(T, F), 3, 4)
|
#' B <- matrix(c(1, 0), 3, 4)
|
||||||
#' C <- kronecker(A, B) # the same as 'C <- A %x% B'
|
#' C <- kronecker(A, B) # the same as 'C <- A %x% B'
|
||||||
#' approx.kronecker(C, dim(A), dim(B))
|
#' approx.kronecker(C, dim(A), dim(B))
|
||||||
#'
|
#'
|
||||||
#' @seealso C.F. Van Loan / Journal of Computational and Applied Mathematics
|
#' @seealso C.F. Van Loan / Journal of Computational and Applied Mathematics
|
||||||
#' 123 (2000) 85-100 (pp. 93-95)
|
#' 123 (2000) 85-100 (pp. 93-95)
|
||||||
#'
|
#'
|
||||||
#' @imports RSpectra
|
|
||||||
#'
|
|
||||||
#' @export
|
#' @export
|
||||||
approx.kronecker <- function(C, dimA, dimB) {
|
approx.kronecker <- function(C, dimA, dimB) {
|
||||||
|
|
||||||
|
@ -29,8 +27,9 @@ approx.kronecker <- function(C, dimA, dimB) {
|
||||||
R <- aperm(C, c(2L, 4L, 1L, 3L))
|
R <- aperm(C, c(2L, 4L, 1L, 3L))
|
||||||
dim(R) <- c(prod(dimA), prod(dimB))
|
dim(R) <- c(prod(dimA), prod(dimB))
|
||||||
|
|
||||||
svdR <- try(RSpectra::svds(R, 1L), silent = TRUE)
|
if (requireNamespace("RSpectra", quietly = TRUE)) {
|
||||||
if (is(svdR, 'try-error')) {
|
svdR <- RSpectra::svds(R, 1L)
|
||||||
|
} else {
|
||||||
svdR <- svd(R, 1L, 1L)
|
svdR <- svd(R, 1L, 1L)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -21,7 +21,7 @@
|
||||||
#'
|
#'
|
||||||
#' @seealso \code{\link{solve}}, \code{\link{qr}}, \code{\link{svd}}.
|
#' @seealso \code{\link{solve}}, \code{\link{qr}}, \code{\link{svd}}.
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples \dontrun{
|
||||||
#' # General full rank square matrices.
|
#' # General full rank square matrices.
|
||||||
#' A <- matrix(rnorm(121), 11, 11)
|
#' A <- matrix(rnorm(121), 11, 11)
|
||||||
#' all.equal(matpow(A, 1), A)
|
#' all.equal(matpow(A, 1), A)
|
||||||
|
@ -54,6 +54,7 @@
|
||||||
#' all.equal(B %*% B %*% A %*% B %*% B, B %*% B)
|
#' all.equal(B %*% B %*% A %*% B %*% B, B %*% B)
|
||||||
#' all.equal(B %*% A, t(B %*% A))
|
#' all.equal(B %*% A, t(B %*% A))
|
||||||
#' all.equal(A %*% B, t(A %*% B))
|
#' all.equal(A %*% B, t(A %*% B))
|
||||||
|
#' }
|
||||||
#'
|
#'
|
||||||
#' @keywords internal
|
#' @keywords internal
|
||||||
matpow <- function(A, pow, tol = 1e-7) {
|
matpow <- function(A, pow, tol = 1e-7) {
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
#' @details The parameter names \code{lhs} and \code{rhs} stand for "Left Hand
|
#' @details The parameter names \code{lhs} and \code{rhs} stand for "Left Hand
|
||||||
#' Side" and "Right Hand Side", respectively.
|
#' Side" and "Right Hand Side", respectively.
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples \dontrun{
|
||||||
#' c(a, b) %<-% list(1, 2)
|
#' c(a, b) %<-% list(1, 2)
|
||||||
#' # is equivalent to
|
#' # is equivalent to
|
||||||
#' ## a <- 1
|
#' ## a <- 1
|
||||||
|
@ -15,12 +15,13 @@
|
||||||
#'
|
#'
|
||||||
#' # Switching the values of a, b could be done by.
|
#' # Switching the values of a, b could be done by.
|
||||||
#' c(a, b) %<-% list(b, a)
|
#' c(a, b) %<-% list(b, a)
|
||||||
#' note the usage of 'list' on the right side, otherwise an exraction of the
|
#' # note the usage of 'list' on the right side, otherwise an exraction of the
|
||||||
#' first two values of the concatenated object is performed. See next:
|
#' # first two values of the concatenated object is performed. See next:
|
||||||
#'
|
#'
|
||||||
#' # Extract values.
|
#' # Extract values.
|
||||||
#' c(d1, d2, d3) %<-% 1:10
|
#' c(d1, d2, d3) %<-% 1:10
|
||||||
#' extracting the first three valus from the vector of length 10.
|
#' # extracting the first three valus from the vector of length 10.
|
||||||
|
#' }
|
||||||
#'
|
#'
|
||||||
#' @keywords internal
|
#' @keywords internal
|
||||||
"%<-%" <- function(lhs, rhs) {
|
"%<-%" <- function(lhs, rhs) {
|
||||||
|
@ -30,4 +31,5 @@
|
||||||
for (i in seq_along(var.names)) {
|
for (i in seq_along(var.names)) {
|
||||||
assign(var.names[i], values[[i]], envir = env)
|
assign(var.names[i], values[[i]], envir = env)
|
||||||
}
|
}
|
||||||
|
lhs
|
||||||
}
|
}
|
||||||
|
|
|
@ -1,10 +1,14 @@
|
||||||
#'2-Dimensional Principal Component Analysis
|
#'2-Dimensional Principal Component Analysis
|
||||||
#'
|
#'
|
||||||
#' @param X Matrix of dim (n, p * t) with each row the vectorized (p, t) observation.
|
#' @param X Matrix of \code{dim (n, p * t)} with each row the vectorized
|
||||||
|
#' \eqn{p \times t} observation.
|
||||||
#' @param p nr. predictors
|
#' @param p nr. predictors
|
||||||
#' @param t nr. timepoints
|
#' @param t nr. timepoints
|
||||||
#' @param ppc reduced nr. predictors (p-principal components)
|
#' @param ppc reduced nr. predictors (p-principal components)
|
||||||
#' @param tpc reduced nr. timepoints (t-principal components)
|
#' @param tpc reduced nr. timepoints (t-principal components)
|
||||||
|
#' @param scale passed to \code{\link{scale}} before processing \code{X}.
|
||||||
|
#'
|
||||||
|
#' @return list with 2d pca estimated reduction estimates.
|
||||||
#'
|
#'
|
||||||
#' @details The `i`th observation is stored in a row such that its matrix equiv
|
#' @details The `i`th observation is stored in a row such that its matrix equiv
|
||||||
#' is given by `matrix(X[i, ], p, t)`.
|
#' is given by `matrix(X[i, ], p, t)`.
|
||||||
|
|
|
@ -19,13 +19,10 @@ POI <- function(A, B, d,
|
||||||
# TODO:
|
# TODO:
|
||||||
stopifnot(method == 'FastPOI-C')
|
stopifnot(method == 'FastPOI-C')
|
||||||
|
|
||||||
if (nrow(A) < 100) {
|
if (requireNamespace("RSpectra", quietly = TRUE)) {
|
||||||
Delta <- eigen(A, symmetric = TRUE)$vectors[, 1:d, drop = FALSE]
|
Delta <- RSpectra::eigs_sym(A, d)$vectors
|
||||||
} else {
|
} else {
|
||||||
Delta <- try(RSpectra::eigs_sym(A, d)$vectors, silent = TRUE)
|
Delta <- eigen(A, symmetric = TRUE)$vectors[, 1:d, drop = FALSE]
|
||||||
if (is(Delta, 'try-error')) {
|
|
||||||
Delta <- eigen(A, symmetric = TRUE)$vectors[1:d, , drop = FALSE]
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# Set initial value.
|
# Set initial value.
|
||||||
|
|
|
@ -9,11 +9,11 @@
|
||||||
#'
|
#'
|
||||||
#' @return a \eqn{n\times p}{n x p} matrix with samples in its rows.
|
#' @return a \eqn{n\times p}{n x p} matrix with samples in its rows.
|
||||||
#'
|
#'
|
||||||
#' @examples
|
#' @examples \dontrun{
|
||||||
#' \dontrun{
|
|
||||||
#' rmvnorm(20, sigma = matrix(c(2, 1, 1, 2), 2))
|
#' rmvnorm(20, sigma = matrix(c(2, 1, 1, 2), 2))
|
||||||
#' rmvnorm(20, mu = c(3, -1, 2))
|
#' rmvnorm(20, mu = c(3, -1, 2))
|
||||||
#' }
|
#' }
|
||||||
|
#'
|
||||||
#' @keywords internal
|
#' @keywords internal
|
||||||
rmvnorm <- function(n = 1, mu = rep(0, p), sigma = diag(p)) {
|
rmvnorm <- function(n = 1, mu = rep(0, p), sigma = diag(p)) {
|
||||||
if (!missing(sigma)) {
|
if (!missing(sigma)) {
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
#'
|
#'
|
||||||
#' @author Daniel Kapla
|
#' @author Daniel Kapla
|
||||||
#'
|
#'
|
||||||
|
#' @import stats
|
||||||
|
#'
|
||||||
#' @docType package
|
#' @docType package
|
||||||
#' @useDynLib tensorPredictors, .registration = TRUE
|
#' @useDynLib tensorPredictors, .registration = TRUE
|
||||||
"_PACKAGE"
|
"_PACKAGE"
|
||||||
|
@ -158,7 +160,13 @@ tensor_predictor <- function(X, Fy, p, t, k = 1L, r = 1L, d1 = 1L, d2 = 1L,
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
|
|
||||||
#' TODO: Write this properly!
|
#' Reduce new data using estimated reduction.
|
||||||
|
#'
|
||||||
|
#' @param object estimated reduction object.
|
||||||
|
#' @param data new data to apply reduce
|
||||||
|
#' @param use which type of reduction/internal variables should be used
|
||||||
|
#'
|
||||||
|
#' @export
|
||||||
reduce <- function(object, data, use = 'Gamma') {
|
reduce <- function(object, data, use = 'Gamma') {
|
||||||
if (use == 'Gamma') {
|
if (use == 'Gamma') {
|
||||||
projection <- object$Gamma
|
projection <- object$Gamma
|
||||||
|
|
|
@ -74,13 +74,14 @@ extern SEXP FastPOI_C_sub(SEXP in_A, SEXP in_B, SEXP in_Delta, SEXP in_lambda, S
|
||||||
return out_Z;
|
return out_Z;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* List of registered routines (e.g. C entry points) */
|
||||||
static const R_CallMethodDef CallEntries[] = {
|
static const R_CallMethodDef CallEntries[] = {
|
||||||
{"FastPOI_C_sub", (DL_FUNC) &FastPOI_C_sub, 5},
|
{"FastPOI_C_sub", (DL_FUNC) &FastPOI_C_sub, 5},
|
||||||
{NULL, NULL, 0}
|
{NULL, NULL, 0}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Restrict C entry points to registered routines. */
|
/* Restrict C entry points to registered routines. */
|
||||||
void R_init_CVE(DllInfo *dll) {
|
void R_init_tensorPredictors(DllInfo *dll) {
|
||||||
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
|
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
|
||||||
R_useDynamicSymbols(dll, FALSE);
|
R_useDynamicSymbols(dll, FALSE);
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue