tests/testthat/test-compute_elastic_shape_mean.R

In elastes: Elastic Full Procrustes Means for Sparse and Irregular Planar Curves

data_curve1 <- data.frame(x1 = sin(1:7/4*pi), x2 = cos(1:7/4*pi))
data_curve2 <- data.frame(x1 = sin(1:15/8*pi), x2 = cos(1:15/8*pi))
data_curves <- list(data_curve1, data_curve2)


test_that("Test computed variance and distances in [0,1]", {
  mean <- compute_elastic_shape_mean(data_curves)
  expect_gt(mean$variance, 0)
  expect_lte(mean$variance, 1)
  for (d in mean$distances) {
    expect_gte(d, 0)
    expect_lte(d, 1)
  }
})


test_that("Test variance == sum-of-squared distances / N", {
  mean <- compute_elastic_shape_mean(data_curves, max_iter = 0)
  ssdn <- sum(mean$distances^2)*2/(length(mean$distances)*(length(mean$distances) - 1))
  expect_equal(mean$variance, ssdn, tolerance = 1e-1)
})


test_that("Test unelastic full procrustes mean has distances", {
  mean <- compute_elastic_shape_mean(data_curves, max_iter = 0)
  expect_equal(mean$data_curves[[1]]$t, mean$data_curves[[1]]$t_optim)
  expect_false(is.null(attr(mean$data_curves[[1]], "dist_to_mean")))
  mean2 <- compute_elastic_shape_mean(data_curves, max_iter = 0, pfit_method = "polygon")
  expect_equal(mean2$data_curves[[1]]$t, mean2$data_curves[[1]]$t_optim)
  expect_false(is.null(attr(mean2$data_curves[[1]], "dist_to_mean")))
})


test_that("Initial rot, scaling do not matter much", {
  knots <- seq(0, 1, length = 11)

  # Apply rot, scaling to data_curve2
  beta <- 2.5
  theta <- 0.7*pi
  rot <- matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), nrow = 2, ncol = 2)
  data_curve2 <- as.matrix(data_curve2) %*% t(rot)
  data_curve2 <- as.data.frame(data_curve2)
  colnames(data_curve2) <- c("x1","x2")
  data_curves <- list(data_curve1, data_curve2)

  mean1 <- compute_elastic_shape_mean(data_curves, knots = knots, type = "smooth", penalty = 2)
  mean2 <- compute_elastic_shape_mean(data_curves, knots = knots, type = "polygon", penalty = 2)

  # Apply different rot, scaling to data_curve2
  beta <- 0.25
  theta <- 2.3*pi
  rot <- matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), nrow = 2, ncol = 2)
  data_curve2 <- data_curve <- beta * data.frame(x1 = sin(1:15/8*pi), x2 = cos(1:15/8*pi))
  data_curve2 <- as.matrix(data_curve2) %*% t(rot)
  data_curve2 <- as.data.frame(data_curve2)
  colnames(data_curve2) <- c("x1","x2")
  data_curves <- list(data_curve1, data_curve2)

  # Get means "smooth"
  mean3 <- compute_elastic_shape_mean(data_curves, knots = knots, type = "smooth", penalty = 2)
  mean4 <- compute_elastic_shape_mean(data_curves, knots = knots, type = "polygon", penalty = 2)

  expect_equal(mean1$coefs, mean3$coefs, tolerance=1e-1)
  expect_equal(mean2$coefs, mean4$coefs, tolerance=1e-1)
})