tests/testthat/test_apply_transformation_matrix.R

library(rearrr)
context("apply_transformation_matrix()")


test_that("testing examples in apply_transformation_matrix()", {
  xpectr::set_test_seed(42)

  # Create a data frame
  df <- data.frame(
    "x" = 1:12,
    "y" = 13:24,
    "z" = runif(12),
    "g" = c(
      1, 1, 1, 1, 2, 2,
      2, 2, 3, 3, 3, 3
    )
  )

  # Apply identity matrix
  identity_matrix <- matrix(c(1,0,0,0,1,0,0,0,1), nrow=3)
  res <- apply_transformation_matrix(
    data = df,
    mat = identity_matrix,
    cols = c("x", "y", "z"),
    origin = c(0, 0, 0)
  )

  expect_equal(
    res$x,
    res$x_transformed
  )
  expect_equal(
    res$y,
    res$y_transformed
  )
  expect_equal(
    res$z,
    res$z_transformed
  )

  ## Testing 'res'                                                          ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(res),
    c("tbl_df", "tbl", "data.frame"),
    fixed = TRUE)
  # Testing column values
  expect_equal(
    res[["x"]],
    c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
    tolerance = 1e-4)
  expect_equal(
    res[["y"]],
    c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
    tolerance = 1e-4)
  expect_equal(
    res[["z"]],
    c(0.91481, 0.93708, 0.28614, 0.83045, 0.64175, 0.5191, 0.73659,
      0.13467, 0.65699, 0.70506, 0.45774, 0.71911),
    tolerance = 1e-4)
  expect_equal(
    res[["g"]],
    c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
    tolerance = 1e-4)
  expect_equal(
    res[["x_transformed"]],
    c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
    tolerance = 1e-4)
  expect_equal(
    res[["y_transformed"]],
    c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
    tolerance = 1e-4)
  expect_equal(
    res[["z_transformed"]],
    c(0.91481, 0.93708, 0.28614, 0.83045, 0.64175, 0.5191, 0.73659,
      0.13467, 0.65699, 0.70506, 0.45774, 0.71911),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(res),
    c("x", "y", "z", "g", "x_transformed", "y_transformed", "z_transformed",
      ".origin"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(res),
    c("integer", "integer", "numeric", "numeric", "numeric", "numeric",
      "numeric", "list"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(res),
    c("integer", "integer", "double", "double", "double", "double",
      "double", "list"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(res),
    c(12L, 8L))
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(res)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'res'                                                 ####


  # Apply rotation matrix
  # 90 degrees around z-axis
  rotation_matrix <- matrix(c(0,1,0,-1,0,0,0,0,1), nrow=3)
  res <- apply_transformation_matrix(
    data = df,
    mat = rotation_matrix,
    cols = c("x", "y", "z"),
    origin_fn = most_centered
  )

  expect_equal(
    res$x_transformed,
    rev(res$x) + 1
  )


  ## Testing 'res'                                                          ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(res),
    c("tbl_df", "tbl", "data.frame"),
    fixed = TRUE)
  # Testing column values
  expect_equal(
    res[["x"]],
    c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
    tolerance = 1e-4)
  expect_equal(
    res[["y"]],
    c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
    tolerance = 1e-4)
  expect_equal(
    res[["z"]],
    c(0.91481, 0.93708, 0.28614, 0.83045, 0.64175, 0.5191, 0.73659,
      0.13467, 0.65699, 0.70506, 0.45774, 0.71911),
    tolerance = 1e-4)
  expect_equal(
    res[["g"]],
    c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
    tolerance = 1e-4)
  expect_equal(
    res[["x_transformed"]],
    c(13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2),
    tolerance = 1e-4)
  expect_equal(
    res[["y_transformed"]],
    c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
    tolerance = 1e-4)
  expect_equal(
    res[["z_transformed"]],
    c(0.91481, 0.93708, 0.28614, 0.83045, 0.64175, 0.5191, 0.73659,
      0.13467, 0.65699, 0.70506, 0.45774, 0.71911),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(res),
    c("x", "y", "z", "g", "x_transformed", "y_transformed", "z_transformed",
      ".origin"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(res),
    c("integer", "integer", "numeric", "numeric", "numeric", "numeric",
      "numeric", "list"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(res),
    c("integer", "integer", "double", "double", "double", "double",
      "double", "list"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(res),
    c(12L, 8L))
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(res)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'res'                                                 ####


  # Apply rotation matrix to grouped data frame
  # Around centroids
  res <- apply_transformation_matrix(
    data = dplyr::group_by(df, g),
    mat = rotation_matrix,
    cols = c("x", "y", "z"),
    origin_fn = centroid
  )


  ## Testing 'res'                                                          ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(res),
    c("tbl_df", "tbl", "data.frame"),
    fixed = TRUE)
  # Testing column values
  expect_equal(
    res[["x"]],
    c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
    tolerance = 1e-4)
  expect_equal(
    res[["y"]],
    c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
    tolerance = 1e-4)
  expect_equal(
    res[["z"]],
    c(0.91481, 0.93708, 0.28614, 0.83045, 0.64175, 0.5191, 0.73659,
      0.13467, 0.65699, 0.70506, 0.45774, 0.71911),
    tolerance = 1e-4)
  expect_equal(
    res[["g"]],
    c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
    tolerance = 1e-4)
  expect_equal(
    res[["x_transformed"]],
    c(4, 3, 2, 1, 8, 7, 6, 5, 12, 11, 10, 9),
    tolerance = 1e-4)
  expect_equal(
    res[["y_transformed"]],
    c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
    tolerance = 1e-4)
  expect_equal(
    res[["z_transformed"]],
    c(0.91481, 0.93708, 0.28614, 0.83045, 0.64175, 0.5191, 0.73659,
      0.13467, 0.65699, 0.70506, 0.45774, 0.71911),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(res),
    c("x", "y", "z", "g", "x_transformed", "y_transformed", "z_transformed",
      ".origin"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(res),
    c("integer", "integer", "numeric", "numeric", "numeric", "numeric",
      "numeric", "list"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(res),
    c("integer", "integer", "double", "double", "double", "double",
      "double", "list"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(res),
    c(12L, 8L))
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(res)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'res'                                                 ####


  ## Testing 'res$.origin'                                                  ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(res$.origin),
    "list",
    fixed = TRUE)
  # Testing type
  expect_type(
    res$.origin,
    type = "list")
  # Testing values
  expect_equal(
    res$.origin,
    list(c(x = 2.5, y = 14.5, z = 0.742117154411972),
         c(x = 2.5, y = 14.5, z = 0.742117154411972),
         c(x = 2.5, y = 14.5, z = 0.742117154411972),
         c(x = 2.5, y = 14.5, z = 0.742117154411972),
         c(x = 6.5, y = 18.5, z = 0.508024094975553),
         c(x = 6.5, y = 18.5, z = 0.508024094975553),
         c(x = 6.5, y = 18.5, z = 0.508024094975553),
         c(x = 6.5, y = 18.5, z = 0.508024094975553),
         c(x = 10.5, y = 22.5, z = 0.634727775584906),
         c(x = 10.5, y = 22.5, z = 0.634727775584906),
         c(x = 10.5, y = 22.5, z = 0.634727775584906),
         c(x = 10.5, y = 22.5, z = 0.634727775584906)))
  # Testing names
  expect_equal(
    names(res$.origin),
    NULL,
    fixed = TRUE)
  # Testing length
  expect_equal(
    length(res$.origin),
    12L)
  # Testing sum of element lengths
  expect_equal(
    sum(xpectr::element_lengths(res$.origin)),
    36L)
  ## Finished testing 'res$.origin'                                         ####


  # Random matrix
  xpectr::set_test_seed(42)
  rotation_matrix <- matrix(runif(9), nrow=3)
  res <- apply_transformation_matrix(
    data = df,
    mat = rotation_matrix,
    cols = c("x", "y", "z"),
    origin_fn = centroid
  )

  # Manual calculation
  centr <- c(6.5, 18.5, mean(df$z))
  res_manual <- t(rotation_matrix %*% (t(df[, c("x", "y", "z")]) - centr) + centr)

  expect_equal(
    res_manual[,1],
    res$x_transformed
  )
  expect_equal(
    res_manual[,2],
    res$y_transformed
  )
  expect_equal(
    res_manual[,3],
    res$z_transformed
  )

  ## Testing 'res'                                                          ####
  ## Initially generated by xpectr
  xpectr::set_test_seed(42)
  # Testing class
  expect_equal(
    class(res),
    c("tbl_df", "tbl", "data.frame"),
    fixed = TRUE)
  # Testing column values
  expect_equal(
    res[["x"]],
    c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
    tolerance = 1e-4)
  expect_equal(
    res[["y"]],
    c(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24),
    tolerance = 1e-4)
  expect_equal(
    res[["z"]],
    c(0.91481, 0.93708, 0.28614, 0.83045, 0.64175, 0.5191, 0.73659,
      0.13467, 0.65699, 0.70506, 0.45774, 0.71911),
    tolerance = 1e-4)
  expect_equal(
    res[["g"]],
    c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3),
    tolerance = 1e-4)
  expect_equal(
    res[["x_transformed"]],
    c(-2.88785, -1.12619, 0.13959, 2.28577, 3.89203, 5.54694, 7.4524,
      8.75428, 10.88428, 12.66494, 14.22802, 16.16579),
    tolerance = 1e-4)
  expect_equal(
    res[["y_transformed"]],
    c(9.85507, 11.43689, 12.92805, 14.58017, 16.13358, 17.69588, 19.30399,
      20.80176, 22.45092, 24.03621, 25.58173, 27.19575),
    tolerance = 1e-4)
  expect_equal(
    res[["z_transformed"]],
    c(-3.61227, -2.7924, -2.41482, -1.25198, -0.57072, 0.15393, 1.10206,
      1.51184, 2.66024, 3.49705, 4.1398, 5.11675),
    tolerance = 1e-4)
  # Testing column names
  expect_equal(
    names(res),
    c("x", "y", "z", "g", "x_transformed", "y_transformed", "z_transformed",
      ".origin"),
    fixed = TRUE)
  # Testing column classes
  expect_equal(
    xpectr::element_classes(res),
    c("integer", "integer", "numeric", "numeric", "numeric", "numeric",
      "numeric", "list"),
    fixed = TRUE)
  # Testing column types
  expect_equal(
    xpectr::element_types(res),
    c("integer", "integer", "double", "double", "double", "double",
      "double", "list"),
    fixed = TRUE)
  # Testing dimensions
  expect_equal(
    dim(res),
    c(12L, 8L))
  # Testing group keys
  expect_equal(
    colnames(dplyr::group_keys(res)),
    character(0),
    fixed = TRUE)
  ## Finished testing 'res'                                                 ####

})

Try the rearrr package in your browser

Any scripts or data that you put into this service are public.

rearrr documentation built on April 4, 2025, 1:07 a.m.