Compute an elastic full Procrustes mean for a collection of curves
Source:R/compute_elastic_shape_mean.R
compute_elastic_shape_mean.Rd
Computes an elastic full Procrustes mean for curves stored in data_curves
.
Constructor function for class elastic_shape_mean
.
Arguments
- data_curves
list of
data.frame
s with observed points in each row. Each variable is one coordinate direction. If there is a variablet
, it is treated as the time parametrization, not as an additional coordinate.- knots
set of knots for the mean spline curve
- type
if "smooth" linear srv-splines are used which results in a differentiable mean curve if "polygon" the mean will be piecewise linear.
- penalty
the penalty to use in the covariance smoothing step. use '-1' for no penalty.
- var_type
(experimental) assume "smooth", "constant" or "zero" measurement-error variance along t
- pfit_method
(experimental) "smooth" or "polygon"
- smooth_warp
(experimental) controls the weighting of original and smoothed observations over the iterations, if pfit_method == "smooth".
- eps
the algorithm stops if L2 norm of coefficients changes by less than
eps
- max_iter
maximal number of iterations
- verbose
print iterations
- cluster
(experimental) use the parallel package for faster computation
Value
an object of class elastic_shape_mean
, which is a list
with entries
- type
"smooth" if mean was modeled using linear srv-splines, "polygon" if constant srv-splines
- coefs
spline coefficients
- knots
spline knots
- variance
sample elastic shape variance
- data_curves
list of
data.frame
s with observed points in each row. First variablet
gives the initial parametrization, second variablet_optim
the optimal parametrization when the curve is aligned to the mean. Has the attributes 'rotation', 'scaling', 'translation' and 'dist_to_mean'. Useget_procrustes_fit
to get the elastic full Procrustes fit.- fit
see
fit_mean
Examples
curve <- function(t){
rbind(t*cos(13*t), t*sin(13*t))
}
set.seed(18)
data_curves <- lapply(1:4, function(i){
m <- sample(10:15, 1)
delta <- abs(rnorm(m, mean = 1, sd = 0.05))
t <- cumsum(delta)/sum(delta)
data.frame(t(curve(t)) + 0.07*t*matrix(cumsum(rnorm(2*length(delta))),
ncol = 2))
})
#randomly rotate and scale curves
rand_scale <- function(curve){ ( 0.5 + runif(1) ) * curve }
rand_rotate <- function(curve){
names <- colnames(curve)
theta <- 2*pi*runif(1)
mat <- matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), nrow = 2, ncol = 2)
curve.rot <- as.matrix(curve) %*% t(mat)
curve.rot <- as.data.frame(curve.rot)
colnames(curve.rot) <- names
return(curve.rot)
}
data_curves <- lapply(data_curves, rand_scale)
data_curves <- lapply(data_curves, rand_rotate)
#compute smooth procrustes mean with 2 order penalty
knots <- seq(0,1, length = 11)
elastic_shape_mean <- compute_elastic_shape_mean(
data_curves,
knots = knots,
type = "smooth",
penalty = 2
)
plot(elastic_shape_mean)