tests/testthat/test-map_procrustes.R

In Racmacs: Antigenic Cartography Macros

library(Racmacs)
library(testthat)
context("Test procrustes methods")
set.seed(100)

# Check MCMCpack installed
package_required("MCMCpack")

# Setup rotation and translation matrices
rot_mat <- matrix(
  data = c(cos(0.24), sin(0.24), -sin(0.24), cos(0.24)),
  nrow = 2,
  ncol = 2
)

inv_rot_mat <- t(rot_mat)

coords1 <- matrix(runif(10), ncol = 2)
coords2 <- coords1 %*% rot_mat
coords3 <- coords2 %*% inv_rot_mat

trans_mat <- matrix(c(2.4, 3.8), nrow = 1)


# Create new maps
num_ags <- c(10, 14)
num_sr  <- c(8,  6)

ag_names1 <- paste("Map1 antigen", seq_len(num_ags[1]))
sr_names1 <- paste("Map1 sera",    seq_len(num_sr[1]))

ag_names2 <- paste("Map2 antigen", seq_len(num_ags[2]))
sr_names2 <- paste("Map2 sera",    seq_len(num_sr[2]))


# Define matching antigens
matching_ags <- rbind(
  c(10, 2),
  c(1,  14),
  c(3,  4),
  c(6,  7),
  c(4,  11)
)

matching_sr <- rbind(
  c(3, 1),
  c(1, 3),
  c(8, 6),
  c(2, 5)
)

for (x in seq_len(nrow(matching_ags))) {
  ag_names1[matching_ags[x, 1]] <- paste("Matched antigen", x)
  ag_names2[matching_ags[x, 2]] <- paste("Matched antigen", x)
}

for (x in seq_len(nrow(matching_sr))) {
  sr_names1[matching_sr[x, 1]] <- paste("Matched sera", x)
  sr_names2[matching_sr[x, 2]] <- paste("Matched sera", x)
}


# Generate coordinates
ag_coords1 <- matrix(runif(num_ags[1] * 2) * 10, ncol = 2)
ag_coords2 <- matrix(runif(num_ags[2] * 2) * 10, ncol = 2)
rownames(ag_coords1) <- ag_names1
rownames(ag_coords2) <- ag_names2

sr_coords1 <- matrix(runif(num_sr[1] * 2) * 10, ncol = 2)
sr_coords2 <- matrix(runif(num_sr[2] * 2) * 10, ncol = 2)
rownames(sr_coords1) <- sr_names1
rownames(sr_coords2) <- sr_names2


# Create the test maps
map1 <- acmap(
  titer_table = matrix(
    as.character(2^round(runif(nrow(ag_coords1)*nrow(sr_coords1), -1, 10))*10),
    nrow(ag_coords1),
    nrow(sr_coords1)
  ),
  ag_coords = ag_coords1,
  sr_coords = sr_coords1,
  ag_names  = ag_names1,
  sr_names  = sr_names1,
  minimum_column_basis = "none"
)

map2 <- acmap(
  titer_table = matrix(
    as.character(2^round(runif(nrow(ag_coords2)*nrow(sr_coords2), -1, 10))*10),
    nrow(ag_coords2),
    nrow(sr_coords2)
  ),
  ag_coords = ag_coords2,
  sr_coords = sr_coords2,
  ag_names  = ag_names2,
  sr_names  = sr_names2,
  minimum_column_basis = "none"
)


# Create a rotated and shuffled version
## Shuffle antigens and sera
ag_order1rot <- sample(seq_along(ag_names1))
sr_order1rot <- sample(seq_along(sr_names1))

## Add some name mismatches
ag_mismatches1rot <- c(1, 6)
sr_mismatches1rot <- c(2, 3)
ag_names1rot <- ag_names1[ag_order1rot]
sr_names1rot <- sr_names1[sr_order1rot]
ag_names1rot[ag_mismatches1rot] <- paste("Mismatched antigen", ag_mismatches1rot)
sr_names1rot[sr_mismatches1rot] <- paste("Mismatched sera",    sr_mismatches1rot)

## Rotate and translate the coordinates
ag_coords1rot <- ag_coords1 %*% rot_mat + matrix(trans_mat, num_ags[1], 2, byrow = TRUE)
sr_coords1rot <- sr_coords1 %*% rot_mat + matrix(trans_mat, num_sr[1],  2, byrow = TRUE)
ag_coords1rot <- ag_coords1rot[ag_order1rot, ]
sr_coords1rot <- sr_coords1rot[sr_order1rot, ]

map1rot <- acmap(
  ag_coords = ag_coords1rot,
  sr_coords = sr_coords1rot,
  ag_names  = ag_names1rot,
  sr_names  = sr_names1rot,
  minimum_column_basis = "none"
)


# Test procrustes of map to itself
test_that("Realign a map to itself", {

  omap1 <- map1
  omap1 <- realignMap(omap1, map1)
  expect_equal(agCoords(omap1), agCoords(map1))
  expect_equal(srCoords(omap1), srCoords(map1))

})

# Realign a map with NA coordinates
test_that("Realign a map with NA coordinates", {

  omap1 <- map1
  omap2 <- map1
  agCoords(omap1)[1,] <- NA
  agCoords(omap2)[5,] <- NA
  srCoords(omap1)[2,] <- NA
  srCoords(omap2)[4,] <- NA
  omap1 <- realignMap(omap1, omap2)
  expect_equal(numAntigens(omap1), numAntigens(omap2))

})

test_that("Procrustes a map to itself", {

  pc1 <- procrustesData(map1, map1)
  expected_ag_dists <- rep(0, num_ags[1])
  expected_sr_dists <- rep(0, num_sr[1])

  expect_equal(pc1$ag_dists, expected_ag_dists)
  expect_equal(pc1$sr_dists, expected_sr_dists)
  expect_equal(pc1$ag_rmsd, 0)
  expect_equal(pc1$sr_rmsd, 0)
  expect_equal(pc1$total_rmsd, 0)
  # expect_equal(pc1$pc_coords$ag, unname(ag_coords1))
  # expect_equal(pc1$pc_coords$sr, unname(sr_coords1))

})


test_that("Procrustes a map to with duplicate antigen or sera names", {

  map1a <- map1
  agNames(map1a)[2] <- agNames(map1a)[1]
  expect_error(procrustesMap(map1, map1a))

  map1a <- map1
  srNames(map1a)[2] <- srNames(map1a)[1]
  expect_error(procrustesMap(map1, map1a))

})


test_that("Procrustes a map to one with no matching viruses", {

  map1a <- map1
  agNames(map1a) <- paste(agNames(map1a), "alt")
  srNames(map1a) <- paste(srNames(map1a), "alt")
  expect_error(
    procrustesData(map1, map1a),
    "Not enough matching points \\(0\\)"
  )

})


test_that("Realign to a transformed version", {

  omap1 <- realignMap(map1, map1rot)
  expect_equal(unname(srCoords(omap1)[sr_order1rot, ]), unname(srCoords(map1rot)))
  expect_equal(unname(agCoords(omap1)[ag_order1rot, ]), unname(agCoords(map1rot)))

})


test_that("Procrustes to a transformed version", {

  pc1 <- procrustesData(map1rot, map1)

  expected_ag_dists <- rep(0, num_ags[1])
  expected_sr_dists <- rep(0, num_sr[1])
  expected_ag_dists[ag_mismatches1rot] <- NA
  expected_sr_dists[sr_mismatches1rot] <- NA

  expected_pc_coords_ag <- agCoords(map1rot)
  expected_pc_coords_sr <- srCoords(map1rot)
  expected_pc_coords_ag[ag_mismatches1rot, ] <- NA
  expected_pc_coords_sr[sr_mismatches1rot, ] <- NA

  expect_equal(round(pc1$ag_dists, 5), expected_ag_dists)
  expect_equal(round(pc1$sr_dists, 5), expected_sr_dists)
  expect_equal(round(pc1$ag_rmsd, 5), 0)
  expect_equal(round(pc1$sr_rmsd, 5), 0)
  # expect_equal(unname(pc1$procrustes$pc_coords$ag), unname(expected_pc_coords_ag))
  # expect_equal(unname(pc1$procrustes$pc_coords$sr), unname(expected_pc_coords_sr))

})


# Realign a map that's been rotated into 3D
test_that("Realigning 2D to 3D and back", {

  coords2d <- matrix(c(2, 3, 1, 8, 3, 3, 2, 9, 1, 0), 5, 2)
  coords3d <- coords2d %*% rotation_matrix_3D(1.2, "y")[1:2, ]

  map2d <- acmap(
    ag_coords = coords2d[1:3, ],
    sr_coords = coords2d[4:5, ],
    minimum_column_basis = "none"
  )

  map3d <- acmap(
    ag_coords = coords3d[1:3, ],
    sr_coords = coords3d[4:5, ],
    minimum_column_basis = "none"
  )

  pc2d3d <- procrustesData(
    map2d,
    map3d
  )

  pc3d2d <- procrustesData(
    map3d,
    map2d
  )

  expect_equal(round(pc2d3d$ag_rmsd, 5), 0)
  expect_equal(round(pc3d2d$ag_rmsd, 5), 0)
  expect_equal(round(pc2d3d$sr_rmsd, 5), 0)
  expect_equal(round(pc3d2d$sr_rmsd, 5), 0)
  expect_equal(round(pc2d3d$total_rmsd, 5), 0)
  expect_equal(round(pc3d2d$total_rmsd, 5), 0)

})



# Realign a map that's been rotated into 3D
test_that("Realigning 2D to 3D and back in a rotated map", {

  coords2d <- matrix(c(2, 3, 1, 8, 3, 3, 2, 9, 1, 0), 5, 2)

  map2d <- acmap(
    ag_coords = coords2d[1:3, ],
    sr_coords = coords2d[4:5, ],
    minimum_column_basis = "none"
  )

  map3d <- acmap(
    ag_coords = coords2d[1:3, ],
    sr_coords = coords2d[4:5, ],
    minimum_column_basis = "none"
  )

  mapTransformation(map3d) <- rotation_matrix_3D(1, "x")
  mapTranslation(map3d)    <- matrix(c(1, 2))

  pc2d3d <- procrustesData(
    map2d,
    map3d
  )

  pc3d2d <- procrustesData(
    map3d,
    map2d
  )

  map3d <- realignMap(
    map3d,
    map2d
  )

  map2d <- realignMap(
    map2d,
    map3d
  )

  expect_equal(pc2d3d$total_rmsd, 0)
  expect_equal(pc3d2d$total_rmsd, 0)
  warning("Need to decide how to deal with rotating a map in 3D back to a 2D plane")
  # For example, do we want to treat it like a 2D map again (as is now the case)
  expect_equal(mapTransformation(map3d), diag(nrow = 2))
  expect_equal(mapTranslation(map3d), matrix(0, nrow = 2, ncol = 1))
  expect_equal(ncol(agBaseCoords(map3d)), 2)

})


# Testing realigning optimizations
mapA <- read.acmap(test_path("../testdata/testmap.ace"))

test_that("Realigning map optimizations 3D to 2D", {

  mapB <- realignOptimizations(mapA)

  expect_lt(
    sum((agCoords(mapB, 1) - MCMCpack::procrustes(agCoords(mapB, 2), agCoords(mapB, 1))$X.new)^2),
    sum((agCoords(mapA, 1) - MCMCpack::procrustes(agCoords(mapA, 2), agCoords(mapA, 1))$X.new)^2)
  )

  expect_lt(
    sum((cbind(agCoords(mapB, 1), 0) - MCMCpack::procrustes(agCoords(mapB, 3), cbind(agCoords(mapB, 1), 0))$X.new)^2),
    sum((cbind(agCoords(mapA, 1), 0) - MCMCpack::procrustes(agCoords(mapA, 3), cbind(agCoords(mapA, 1), 0))$X.new)^2)
  )

})


test_that("Realigning map optimizations 2D to 3D", {

  mapB <- realignOptimizations(mapA)

  pcA <- procrustesData(
    map = mapA,
    comparison_map = mapA,
    optimization_number = 1,
    comparison_optimization_number = 3
  )

  pcB <- procrustesData(
    map = mapB,
    comparison_map = mapB,
    optimization_number = 3,
    comparison_optimization_number = 1
  )

  pcAmap <- procrustesMap(
    map = mapB,
    comparison_map = mapB,
    optimization_number = 1,
    comparison_optimization_number = 3
  )

  pcBmap <- procrustesMap(
    map = mapB,
    comparison_map = mapB,
    optimization_number = 3,
    comparison_optimization_number = 1
  )

  export.viewer.test(
    view(pcBmap),
    "procrustes_3d_to_2d.html"
  )

  expect_equal(pcA$total_rmsd, pcB$total_rmsd)

  expect_lt(
    sum(ac_coord_dists(agCoords(mapB, 1), agCoords(mapB, 2))^2),
    sum(ac_coord_dists(agCoords(mapA, 1), agCoords(mapA, 2))^2)
  )

})


test_that("Procrustes maps with na coords", {

  map1na <- map1
  agCoords(map1na)[1:2, ] <- NA
  srCoords(map1na)[1, ] <- NA

  export.viewer.test(
    view(map1na),
    "na_map.html"
  )

  pcmap <- procrustesMap(
    map1na,
    map2
  )

  export.viewer.test(
    view(
      pcmap,
      options = list(
        point.opacity = 1
      )
    ),
    "na_map_procrustes.html"
  )

})

test_that("Procrustes against only antigens or sera", {

  ag_coords <- matrix(11:30, 10, 2)
  sr_coords <- matrix(1:10, 5, 2)

  ag_coords2 <- rotate_coords_by_degrees(ag_coords, 34)
  sr_coords2 <- rotate_coords_by_degrees(sr_coords, -12)

  map1 <- acmap(ag_coords = ag_coords, sr_coords = sr_coords)
  map2 <- acmap(ag_coords = ag_coords2, sr_coords = sr_coords2)

  map2o <- procrustesMap(map2, map1)
  expect_failure(
    expect_equal(
      map2o$optimizations[[1]]$procrustes$ag_coords,
      agBaseCoords(map2o)
    )
  )

  map2a <- procrustesMap(map2, map1, sera = FALSE)
  expect_equal(
    map2a$optimizations[[1]]$procrustes$ag_coords,
    agBaseCoords(map2a)
  )

  expect_equal(0, sum(!is.nan(map2a$optimizations[[1]]$procrustes$sr_coords)))
  expect_equal(0, sum(is.nan(map2a$optimizations[[1]]$procrustes$ag_coords)))

  map2s <- procrustesMap(map2, map1, antigens = FALSE)
  expect_equal(
    map2s$optimizations[[1]]$procrustes$sr_coords,
    srBaseCoords(map2s)
  )

  expect_equal(0, sum(!is.nan(map2s$optimizations[[1]]$procrustes$ag_coords)))
  expect_equal(0, sum(is.nan(map2s$optimizations[[1]]$procrustes$sr_coords)))

  expect_failure(
    expect_equal(
      map2s$optimizations[[1]]$procrustes$ag_coords,
      agBaseCoords(map2s)
    )
  )

})


test_that("Procrustes data with no matching sera", {

  mapA <- map1
  mapB <- map2
  srNames(mapB) <- paste("mismatch", srNames(mapB))
  expect_true("total_rmsd" %in% names(procrustesData(mapA, mapB)))

})