wip: convert to R-package
This commit is contained in:
parent
14d8a9bcdc
commit
3092f6c3f7
|
@ -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
|
|
@ -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)
|
|
@ -22,6 +22,7 @@
|
|||
#'
|
||||
#' @imports RSpectra
|
||||
#'
|
||||
#' @export
|
||||
approx.kronecker <- function(C, dimA, dimB) {
|
||||
|
||||
dim(C) <- c(dimB[1L], dimA[1L], dimB[2L], dimA[2L])
|
||||
|
|
|
@ -1,5 +1,3 @@
|
|||
source('../tensor_predictors/matpow.R')
|
||||
|
||||
#' Longitudinal Sliced Inverse Regression
|
||||
#'
|
||||
#' @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
|
||||
#'
|
||||
#' @export
|
||||
LSIR <- function(X, y, p, t, k = 1L, r = 1L) {
|
||||
# the code assumes:
|
||||
# alpha: T x r, beta: p x k, X_i: p x T, for ith observation
|
||||
|
|
|
@ -55,6 +55,7 @@
|
|||
#' all.equal(B %*% A, t(B %*% A))
|
||||
#' all.equal(A %*% B, t(A %*% B))
|
||||
#'
|
||||
#' @keywords internal
|
||||
matpow <- function(A, pow, tol = 1e-7) {
|
||||
if (nrow(A) != ncol(A)) {
|
||||
stop("Expected a square matix, but 'A' is ", nrow(A), " by ", ncol(A))
|
||||
|
|
|
@ -22,6 +22,7 @@
|
|||
#' c(d1, d2, d3) %<-% 1:10
|
||||
#' extracting the first three valus from the vector of length 10.
|
||||
#'
|
||||
#' @keywords internal
|
||||
"%<-%" <- function(lhs, rhs) {
|
||||
var.names <- make.names(as.list(substitute(lhs))[-1])
|
||||
values <- as.list(rhs)
|
||||
|
|
|
@ -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 p nr. predictors
|
||||
#' @param t nr. timepoints
|
||||
|
@ -7,7 +8,8 @@
|
|||
#'
|
||||
#' @details The `i`th observation is stored in a row such that its matrix equiv
|
||||
#' is given by `matrix(X[i, ], p, t)`.
|
||||
#'
|
||||
#'
|
||||
#' @export
|
||||
PCA2d <- function(X, p, t, ppc, tpc, scale = FALSE) {
|
||||
stopifnot(ncol(X) == p * t, ppc <= p, tpc <= t)
|
||||
|
||||
|
|
|
@ -4,6 +4,8 @@
|
|||
#'
|
||||
#' @note use.C required 'poi.so' beeing dynamicaly loaded.
|
||||
#' dyn.load('../tensor_predictors/poi.so')
|
||||
#'
|
||||
#' @export
|
||||
POI <- function(A, B, d,
|
||||
lambda = 0.75 * sqrt(max(rowSums(Delta^2))),
|
||||
update.tol = 1e-3,
|
||||
|
@ -33,7 +35,7 @@ POI <- function(A, B, d,
|
|||
# The "inner" optimization loop, aka repeated coordinate optimization.
|
||||
if (use.C) {
|
||||
Z <- .Call('FastPOI_C_sub', A, B, Delta, lambda, as.integer(maxit.inner),
|
||||
PACKAGE = 'poi')
|
||||
PACKAGE = 'tensorPredictors')
|
||||
} else {
|
||||
p <- nrow(Z)
|
||||
for (iter.inner in 1:maxit.inner) {
|
||||
|
|
|
@ -1,6 +1,13 @@
|
|||
source('../tensor_predictors/matpow.R')
|
||||
source('../tensor_predictors/multi_assign.R')
|
||||
source('../tensor_predictors/approx_kronecker.R')
|
||||
#' Tensor/Matrix valued Predictors for Regression and Dimension Reduction
|
||||
#'
|
||||
#' 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) {
|
||||
alpha <- matrix(par[1:prod(da)], da[1L])
|
||||
|
|
|
@ -3,7 +3,8 @@
|
|||
#include <R.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 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);
|
||||
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);
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue