sparseGaussKernel: #' @export sparseExp <- function(n, nte, mi=0, ma=1, npc=2:5,...

In msalibian/sparseFPCA: Robust functional PCA for longitudinal data

#' @export sparseExp <- function(n, nte, mi=0, ma=1, npc=2:5, mean.f = function(a) 0, mu.c=4, eps=0, scale = 1, theta = .2*(ma - mi)) # contamination ? # n = number of curves # nte = size of the U(mi, ma) grid on which to evaluate the process # (these points will then be sampled for sparsity) # npc = vector of integers with the possible number of # observations per curve (will be uniform among these) # scale, theta = parameters for the covariance # function which is "scale*exp(-abs(s-t)/theta)" te <- sort( runif(nte, min=mi, max=ma) ) my.par <- list(scale=scale, theta=theta) full.dat <- fda.usc::rproc2fdata(n=n, t=te, sigma="vexponential", par.list=my.par)$data dimnames(full.dat) <- NULL tmp <- vector('list', 5) names(tmp) <- c('x', 'pp', 'xis', 'lambdas', 'outs') tmp$x <- tmp$pp <- vector('list', n) # tmp$xis <- matrix(NA, n, q) # tmp$outs <- outs <- rbinom(n, size=1, prob=eps) for(j in 1:n) pps <- sort( sample.int(n=nte, size=sample(npc, 1)) ) tmp$x[[j]] <- as.vector( full.dat[j, pps] ) + mean.f(te[pps]) tmp$pp[[j]] <- te[pps] return(tmp)

Description

#' @export sparseExp <- function(n, nte, mi=0, ma=1, npc=2:5, mean.f = function(a) 0, mu.c=4, eps=0, scale = 1, theta = .2*(ma - mi)) # contamination ? # n = number of curves # nte = size of the U(mi, ma) grid on which to evaluate the process # (these points will then be sampled for sparsity) # npc = vector of integers with the possible number of # observations per curve (will be uniform among these) # scale, theta = parameters for the covariance # function which is "scale*exp(-abs(s-t)/theta)" te <- sort( runif(nte, min=mi, max=ma) ) my.par <- list(scale=scale, theta=theta) full.dat <- fda.usc::rproc2fdata(n=n, t=te, sigma="vexponential", par.list=my.par)$data dimnames(full.dat) <- NULL tmp <- vector('list', 5) names(tmp) <- c('x', 'pp', 'xis', 'lambdas', 'outs') tmp$x <- tmp$pp <- vector('list', n) # tmp$xis <- matrix(NA, n, q) # tmp$outs <- outs <- rbinom(n, size=1, prob=eps) for(j in 1:n) pps <- sort( sample.int(n=nte, size=sample(npc, 1)) ) tmp$x[[j]] <- as.vector( full.dat[j, pps] ) + mean.f(te[pps]) tmp$pp[[j]] <- te[pps] return(tmp)

Usage

sparseGaussKernel(n, nte, mi = 0, ma = 1, npc = 2:5,
  mean.f = function(a) 0, mu.c = 30, eps = 0, scale = 1,
  theta = 0.2 * (ma - mi), phi.cont = function(a) NA)

msalibian/sparseFPCA documentation built on Nov. 26, 2022, 4:47 a.m.