tests/testthat/test-utils.R

In bigmds: Multidimensional Scaling for Big Data

test_that("Procrustes parameters are well recovered when translation vector is FALSE", {
  n_rows <- 100
  n_cols <- 2
  x <- matrix(data = rnorm(n_rows*n_cols, sd = 10), nrow = n_rows)
  rot_mat <- matrix(data = c(cos(45), -sin(45), sin(45), cos(45)), ncol = n_cols, nrow = n_cols)
  y <- x %*% rot_mat
  proc <- get_procrustes_parameters(x = x, target = y, translation = FALSE)
  dif_rot <- max(abs(proc$rotation_matrix - rot_mat))
  max_trans <- max(abs(proc$translation_vector))
  max_error <- max(c(dif_rot, max_trans))
  expect_lt(max_error, 1e-6)
})

test_that("Procrustes parameters are well recovered when translation vector is TRUE", {
  n_rows <- 100
  n_cols <- 2
  x <- matrix(data = rnorm(n_rows*n_cols, sd = 10), nrow = n_rows)
  rot_mat <- matrix(data = c(cos(45), -sin(45), sin(45), cos(45)), ncol = n_cols, nrow = n_cols)
  trans_vector <- matrix(data = c(1, -1), nrow = n_cols, ncol = 1)
  ones_vector <- matrix(data = 1, nrow = n_rows, ncol = 1)
  trans_matrix <- ones_vector %*% t(trans_vector)
  y <- x %*% rot_mat + trans_matrix
  proc <- get_procrustes_parameters(x = x, target = y, translation = TRUE)
  dif_rot <- max(abs(proc$rotation_matrix - rot_mat))
  max_trans <- max(abs(proc$translation_vector - trans_vector))
  max_error <- max(c(dif_rot, max_trans))
  expect_lt(max_error, 1e-6)
})

test_that("Procrustes transforms the matrix correctly when translation vector is FALSE", {
  n_rows <- 100
  n_cols <- 2
  x <- matrix(data = rnorm(n_rows*n_cols, sd = 10), nrow = n_rows)
  rot_mat <- matrix(data = c(cos(45), -sin(45), sin(45), cos(45)), ncol = n_cols, nrow = n_cols)
  y <- x %*% rot_mat
  proc <- perform_procrustes(x = x, target = y, matrix_to_transform = x, translation = FALSE)
  max_error <- max(abs(proc - y))
  expect_lt(max_error, 1e-6)
})

test_that("Procrustes transforms the matrix correctly when translation vector is TRUE", {
  n_rows <- 100
  n_cols <- 2
  x <- matrix(data = rnorm(n_rows*n_cols, sd = 10), nrow = n_rows)
  rot_mat <- matrix(data = c(cos(45), -sin(45), sin(45), cos(45)), ncol = n_cols, nrow = n_cols)
  trans_vector <- matrix(data = c(1, -1), nrow = n_cols, ncol = 1)
  ones_vector <- matrix(data = 1, nrow = n_rows, ncol = 1)
  trans_matrix <- ones_vector %*% t(trans_vector)
  y <- x %*% rot_mat + trans_matrix
  proc <- perform_procrustes(x = x, target = y, matrix_to_transform = x, translation = TRUE)
  max_error <- max(abs(proc - y))
  expect_lt(max_error, 1e-6)
})

test_that("Procrustes fails when number of rows does not match (x, target)", {
  x <- matrix(data = c(1, 2, 3, 4, 5, 6), nrow = 3)
  y <- matrix(data = c(-1, -2, -3, -4), nrow = 2)
  expect_error(
    perform_procrustes(x = x, target = y, matrix_to_transform = x, translation = FALSE),
    "x and target do not have the same number of rows"
  )
})

test_that("Procrustes fails when number of columns does not match (x, target)", {
  x <- matrix(data = c(1, 2, 3, 4, 5, 6), nrow = 2, ncol = 3)
  y <- matrix(data = c(-1, -2, -3, -4), nrow = 2)
  expect_error(
    perform_procrustes(x = x, target = y, matrix_to_transform = x, translation = FALSE),
    "x and target do not have the same number of columns"
  )
})

test_that("Procrustes fails when number of columns does not match (x, matrix_to_transform)", {
  x <- matrix(data = c(1, 2, 3, 4, 5, 6), nrow = 3)
  x_t <- t(x)
  y <- matrix(data = c(-1, -2, -3, -4, -5, -6), nrow = 3)
  expect_error(
    perform_procrustes(x = x, target = y, matrix_to_transform = x_t, translation = FALSE),
    "x and matrix_to_transform do not have the same number of columns"
  )
})

test_that("Classical MDS returns a valid MDS configuration", {
  x <- matrix(data = rnorm(4*100, sd = 10), nrow = 100)
  cmds <- classical_mds(x = x, r = 4)
  cmds_proc <- perform_procrustes(x = cmds$points, target = x, matrix_to_transform = cmds$points, 
                                  translation = FALSE)
  corr_first <- cor(x[, 1], cmds_proc[, 1])
  expect_gt(corr_first, 0.9)
})

test_that("Classical MDS fails when there are NA values", {
  x <- matrix(data = rnorm(4*100, sd = 10), nrow = 100)
  x[1,1] <- NA
  expect_error(classical_mds(x = x, r = 4), "NA values not allowed in 'x'")
})