Description Usage Arguments Value Author(s) See Also Examples
View source: R/do_alphas_rss_multiv.R
In the ADALARA algorithm, every time that a set of archetypoids is computed using a sample of the data, the alpha coefficients and the associated residual sum of squares (RSS) for the entire data set must be computed.
1 2 | do_alphas_rss_multiv(data, subset, huge, k_subset, rand_obs, alphas_subset,
type_alg = "ada", PM, prob, nbasis, nvars)
|
data |
Data matrix with all the observations. |
subset |
Data matrix with a sample of the |
huge |
Penalization added to solve the convex least squares problems. |
k_subset |
Archetypoids obtained from |
rand_obs |
Sample observations that form |
alphas_subset |
Alpha coefficients related to |
type_alg |
String. Options are 'ada' for the non-robust multivariate adalara algorithm, 'ada_rob' for the robust multivariate adalara algorithm, 'fada' for the non-robust fda fadalara algorithm and 'fada_rob' for the robust fda fadalara algorithm. |
PM |
Penalty matrix obtained with |
prob |
Probability with values in [0,1]. Needed when
|
nbasis |
Number of basis. |
nvars |
Number of variables. |
A list with the following elements:
rss Real number of the residual sum of squares.
resid_rss Matrix with the residuals.
alphas Matrix with the alpha values.
Guillermo Vinue
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | ## Not run:
library(fda)
?growth
str(growth)
hgtm <- growth$hgtm
hgtf <- growth$hgtf[,1:39]
# Create array:
nvars <- 2
data.array <- array(0, dim = c(dim(hgtm), nvars))
data.array[,,1] <- as.matrix(hgtm)
data.array[,,2] <- as.matrix(hgtf)
rownames(data.array) <- 1:nrow(hgtm)
colnames(data.array) <- colnames(hgtm)
str(data.array)
# Create basis:
nbasis <- 10
basis_fd <- create.bspline.basis(c(1,nrow(hgtm)), nbasis)
PM <- eval.penalty(basis_fd)
# Make fd object:
temp_points <- 1:nrow(hgtm)
temp_fd <- Data2fd(argvals = temp_points, y = data.array, basisobj = basis_fd)
X <- array(0, dim = c(dim(t(temp_fd$coefs[,,1])), nvars))
X[,,1] <- t(temp_fd$coef[,,1])
X[,,2] <- t(temp_fd$coef[,,2])
# Standardize the variables:
Xs <- X
Xs[,,1] <- scale(X[,,1])
Xs[,,2] <- scale(X[,,2])
# We have to give names to the dimensions to know the
# observations that were identified as archetypoids.
dimnames(Xs) <- list(paste("Obs", 1:dim(hgtm)[2], sep = ""),
1:nbasis,
c("boys", "girls"))
n <- dim(Xs)[1]
# Number of archetypoids:
k <- 3
numRep <- 20
huge <- 200
# Size of the random sample of observations:
m <- 15
# Number of samples:
N <- floor(1 + (n - m)/(m - k))
N
prob <- 0.75
data_alg <- Xs
nbasis <- dim(data_alg)[2] # number of basis.
nvars <- dim(data_alg)[3] # number of variables.
n <- nrow(data_alg)
suppressWarnings(RNGversion("3.5.0"))
set.seed(1)
rand_obs_si <- sample(1:n, size = m)
si <- apply(data_alg, 2:3, function(x) x[rand_obs_si])
fada_si <- do_fada_multiv_robust(si, k, numRep, huge, 0.8, FALSE, PM)
k_si <- fada_si$cases
alphas_si <- fada_si$alphas
colnames(alphas_si) <- rownames(si)
rss_si <- do_alphas_rss_multiv(data_alg, si, huge, k_si, rand_obs_si, alphas_si,
"fada_rob", PM, 0.8, nbasis, nvars)
str(rss_si)
## End(Not run)
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.