wip: convert to R-package

This commit is contained in:
Daniel Kapla 2021-10-29 18:16:40 +02:00
parent 14d8a9bcdc
commit 3092f6c3f7
10 changed files with 54 additions and 9 deletions

View File

@ -0,0 +1,13 @@
Package: tensorPredictors
Type: Package
Title: Tensor/Matrix valued predictors for regression and dimension reduction
Version: 0.1
Date: 2021-10-28
Author: Daniel Kapla [aut]
Maintainer: Daniel Kapla <daniel@kapla.at>
Description: Multiple methods using tensor/matrix valued predictors for
regression or sufficient dimension reduction.
License: GPL-3
Depends:
Encoding: UTF-8
RoxygenNote: 7.1.1

View File

@ -0,0 +1,7 @@
# Generated by roxygen2: do not edit by hand
export(LSIR)
export(PCA2d)
export(POI)
export(approx.kronecker)
useDynLib(tensorPredictors, .registration = TRUE)

View File

@ -22,6 +22,7 @@
#' #'
#' @imports RSpectra #' @imports RSpectra
#' #'
#' @export
approx.kronecker <- function(C, dimA, dimB) { approx.kronecker <- function(C, dimA, dimB) {
dim(C) <- c(dimB[1L], dimA[1L], dimB[2L], dimA[2L]) dim(C) <- c(dimB[1L], dimA[1L], dimB[2L], dimA[2L])

View File

@ -1,5 +1,3 @@
source('../tensor_predictors/matpow.R')
#' Longitudinal Sliced Inverse Regression #' Longitudinal Sliced Inverse Regression
#' #'
#' @param X matrix of dim \eqn{n \times p t} with each row representing a #' @param X matrix of dim \eqn{n \times p t} with each row representing a
@ -13,6 +11,7 @@ source('../tensor_predictors/matpow.R')
#' #'
#' TODO: finish #' TODO: finish
#' #'
#' @export
LSIR <- function(X, y, p, t, k = 1L, r = 1L) { LSIR <- function(X, y, p, t, k = 1L, r = 1L) {
# the code assumes: # the code assumes:
# alpha: T x r, beta: p x k, X_i: p x T, for ith observation # alpha: T x r, beta: p x k, X_i: p x T, for ith observation

View File

@ -55,6 +55,7 @@
#' 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
matpow <- function(A, pow, tol = 1e-7) { matpow <- function(A, pow, tol = 1e-7) {
if (nrow(A) != ncol(A)) { if (nrow(A) != ncol(A)) {
stop("Expected a square matix, but 'A' is ", nrow(A), " by ", ncol(A)) stop("Expected a square matix, but 'A' is ", nrow(A), " by ", ncol(A))

View File

@ -22,6 +22,7 @@
#' 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
"%<-%" <- function(lhs, rhs) { "%<-%" <- function(lhs, rhs) {
var.names <- make.names(as.list(substitute(lhs))[-1]) var.names <- make.names(as.list(substitute(lhs))[-1])
values <- as.list(rhs) values <- as.list(rhs)

View File

@ -1,4 +1,5 @@
#'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 dim (n, p * t) with each row the vectorized (p, t) observation.
#' @param p nr. predictors #' @param p nr. predictors
#' @param t nr. timepoints #' @param t nr. timepoints
@ -8,6 +9,7 @@
#' @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)`.
#' #'
#' @export
PCA2d <- function(X, p, t, ppc, tpc, scale = FALSE) { PCA2d <- function(X, p, t, ppc, tpc, scale = FALSE) {
stopifnot(ncol(X) == p * t, ppc <= p, tpc <= t) stopifnot(ncol(X) == p * t, ppc <= p, tpc <= t)

View File

@ -4,6 +4,8 @@
#' #'
#' @note use.C required 'poi.so' beeing dynamicaly loaded. #' @note use.C required 'poi.so' beeing dynamicaly loaded.
#' dyn.load('../tensor_predictors/poi.so') #' dyn.load('../tensor_predictors/poi.so')
#'
#' @export
POI <- function(A, B, d, POI <- function(A, B, d,
lambda = 0.75 * sqrt(max(rowSums(Delta^2))), lambda = 0.75 * sqrt(max(rowSums(Delta^2))),
update.tol = 1e-3, update.tol = 1e-3,
@ -33,7 +35,7 @@ POI <- function(A, B, d,
# The "inner" optimization loop, aka repeated coordinate optimization. # The "inner" optimization loop, aka repeated coordinate optimization.
if (use.C) { if (use.C) {
Z <- .Call('FastPOI_C_sub', A, B, Delta, lambda, as.integer(maxit.inner), Z <- .Call('FastPOI_C_sub', A, B, Delta, lambda, as.integer(maxit.inner),
PACKAGE = 'poi') PACKAGE = 'tensorPredictors')
} else { } else {
p <- nrow(Z) p <- nrow(Z)
for (iter.inner in 1:maxit.inner) { for (iter.inner in 1:maxit.inner) {

View File

@ -1,6 +1,13 @@
source('../tensor_predictors/matpow.R') #' Tensor/Matrix valued Predictors for Regression and Dimension Reduction
source('../tensor_predictors/multi_assign.R') #'
source('../tensor_predictors/approx_kronecker.R') #' Multiple methods using tensor/matrix valued predictors for regression or
#' sufficient dimension reduction.
#'
#' @author Daniel Kapla
#'
#' @docType package
#' @useDynLib tensorPredictors, .registration = TRUE
"_PACKAGE"
log.likelihood <- function(par, X, Fy, Delta.inv, da, db) { log.likelihood <- function(par, X, Fy, Delta.inv, da, db) {
alpha <- matrix(par[1:prod(da)], da[1L]) alpha <- matrix(par[1:prod(da)], da[1L])

View File

@ -3,7 +3,8 @@
#include <R.h> #include <R.h>
#include <Rinternals.h> #include <Rinternals.h>
SEXP FastPOI_C_sub(SEXP in_A, SEXP in_B, SEXP in_Delta, SEXP in_lambda, SEXP in_maxit) { /* invoced by .Call */
extern SEXP FastPOI_C_sub(SEXP in_A, SEXP in_B, SEXP in_Delta, SEXP in_lambda, SEXP in_maxit) {
int i, j, k, g; int i, j, k, g;
int p = nrows(in_Delta); int p = nrows(in_Delta);
@ -72,3 +73,14 @@ SEXP FastPOI_C_sub(SEXP in_A, SEXP in_B, SEXP in_Delta, SEXP in_lambda, SEXP in_
UNPROTECT(1); UNPROTECT(1);
return out_Z; return out_Z;
} }
static const R_CallMethodDef CallEntries[] = {
{"FastPOI_C_sub", (DL_FUNC) &FastPOI_C_sub, 5},
{NULL, NULL, 0}
};
/* Restrict C entry points to registered routines. */
void R_init_CVE(DllInfo *dll) {
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
R_useDynamicSymbols(dll, FALSE);
}