tests/testthat/test-map_optimization.R

In Racmacs: Antigenic Cartography Macros

library(Racmacs)
library(testthat)
context("Optimizing maps")
set.seed(100)

# Generate some toy data
ag_coords <- cbind(-4:4, runif(9, -1, 1))
sr_coords <- cbind(runif(9, -1, 1), -4:4)
colbases  <- round(runif(9, 3, 6))
colbasesmat <- matrix(colbases, 9, 9, byrow = T)
distmat <- as.matrix(dist(rbind(ag_coords, sr_coords)))[seq_len(9), -seq_len(9)]
logtiters <- colbasesmat - distmat
titers <- 2 ^ logtiters * 10
mode(titers) <- "character"

# Create a perfect representation of the toy data
perfect_map <- acmap(
  titer_table = titers,
  ag_coords = ag_coords,
  sr_coords = sr_coords
)

# Generate some 3D toy data
ag_coords3d <- cbind(runif(9, -4, 4), runif(9, -4, 4), runif(9, -4, 4))
sr_coords3d <- cbind(runif(9, -4, 4), runif(9, -4, 4), runif(9, -4, 4))
colbases3d  <- round(runif(9, 3, 6))
colbasesmat3d <- matrix(colbases3d, 9, 9, byrow = T)
distmat3d <- as.matrix(dist(rbind(ag_coords3d, sr_coords3d)))[seq_len(9), -seq_len(9)]
logtiters3d <- colbasesmat3d - distmat3d
titers3d <- 2 ^ logtiters3d * 10
mode(titers3d) <- "character"

# Create a perfect representation of the toy data
perfect_map3d <- acmap(
  titer_table = titers3d,
  ag_coords = ag_coords3d,
  sr_coords = sr_coords3d
)

# Setup a perfect optimization to test
test_that("Optimizing a perfect map", {

  # Try the perfect map with optimization
  perfect_map_opt <- optimizeMap(
    map = perfect_map,
    number_of_dimensions = 2,
    number_of_optimizations = 100,
    fixed_column_bases = colbases,
    options = list(dim_annealing = TRUE)
  )

  expect_warning(
    optimizeMap(
      map = perfect_map,
      number_of_dimensions = 2,
      number_of_optimizations = 100,
      fixed_column_bases = colbases
    )
  )

  expect_message(
    checkHemisphering(perfect_map_opt),
    "No hemisphering or trapped points found"
  )

  # Check output
  pcdata <- procrustesData(perfect_map_opt, perfect_map)
  expect_equal(numOptimizations(perfect_map_opt), 100)
  expect_lt(pcdata$total_rmsd, 0.01)

  # Check stresses are calculated correctly
  expect_lt(optStress(perfect_map_opt, 1), 0.001)

})

# Setup a perfect optimization to test
test_that("Optimizing with weights", {

  # Optimize the map setting weights in different ways
  set.seed(200)
  map1 <- optimizeMap(
    map = perfect_map,
    number_of_dimensions = 2,
    number_of_optimizations = 10
  )

  set.seed(200)
  map2 <- optimizeMap(
    map = perfect_map,
    number_of_dimensions = 2,
    number_of_optimizations = 10,
    titer_weights = matrix(1, numAntigens(perfect_map), numSera(perfect_map))
  )

  set.seed(200)
  map3 <- optimizeMap(
    map = perfect_map,
    number_of_dimensions = 2,
    number_of_optimizations = 10,
    titer_weights = matrix(6.3, numAntigens(perfect_map), numSera(perfect_map))
  )
  map3 <- realignMap(map3, map1)

  titer_weights <- matrix(
    runif(numAntigens(perfect_map)*numSera(perfect_map)),
    numAntigens(perfect_map),
    numSera(perfect_map)
  )

  set.seed(200)
  map4 <- optimizeMap(
    map = perfect_map,
    number_of_dimensions = 2,
    number_of_optimizations = 10,
    titer_weights = titer_weights
  )
  map4 <- realignMap(map4, map1)

  # Check output
  expect_equal(ptCoords(map1), ptCoords(map2))
  expect_equal(ptCoords(map1), ptCoords(map3), tolerance = 1e-5)
  expect_false(isTRUE(all.equal(ptCoords(map1), ptCoords(map4))))

})

# Setup a perfect optimization to test
test_that("Optimizing a perfect map with dimensional annealing", {

  # Try the perfect map with optimization
  perfect_map_opt <- optimizeMap(
    map = perfect_map,
    number_of_dimensions = 2,
    number_of_optimizations = 1000,
    fixed_column_bases = colbases,
    options = list(
      dim_annealing = TRUE
    )
  )

  # Check output
  pcdata <- procrustesData(perfect_map_opt, perfect_map)
  expect_equal(numOptimizations(perfect_map_opt), 1000)
  expect_lt(pcdata$total_rmsd, 0.01)
  expect_equal(ncol(agCoords(perfect_map_opt)), 2)
  expect_equal(ncol(srCoords(perfect_map_opt)), 2)

  # Check stresses are calculated correctly
  expect_lt(optStress(perfect_map_opt, 1), 0.001)

})

# Multi-point blobs
test_that("Calculating number of blobs", {

  hemi_map_ag <- perfect_map3d
  titerTable(hemi_map_ag)[3, -c(4, 5, 8)] <- "*"

  hemi_map_ag <- expect_warning(optimizeMap(
    map = hemi_map_ag,
    number_of_dimensions = 3,
    number_of_optimizations = 1,
    fixed_column_bases = colbases
  ))

  hemi_map_ag <- triangulationBlobs(hemi_map_ag, stress_lim = 0.25, grid_spacing = 0.25)
  expect_equal(length(agTriangulationBlobs(hemi_map_ag)[[3]]), 2)

})

# Finding trapped points
test_that("Finding hemisphering points", {

  # Create an antigen hemisphering point
  hemi_map_ag <- perfect_map
  titerTable(hemi_map_ag)[1, -c(2, 7)] <- "*"

  hemi_map_ag <- expect_warning(
    optimizeMap(
      map = hemi_map_ag,
      number_of_dimensions = 2,
      number_of_optimizations = 1,
      fixed_column_bases = colbases
    )
  )

  hemi_map_ag <- expect_warning(
    checkHemisphering(hemi_map_ag, stress_lim = 0.1),
    "Hemisphering or trapped points found:.*"
  )

  expect_false(is.null(agHemisphering(hemi_map_ag)[[1]]))
  export.plot.test(
    ggplot(hemi_map_ag),
    "hemisphering_ags.pdf"
  )

  export.viewer.test(
    view(hemi_map_ag),
    "hemisphering_ags.html"
  )

  # Create a sera hemisphering point
  hemi_map_sr <- perfect_map
  titerTable(hemi_map_sr)[-c(1, 7), 6] <- "*"

  hemi_map_sr <- expect_warning(optimizeMap(
    map = hemi_map_sr,
    number_of_dimensions = 2,
    number_of_optimizations = 1,
    fixed_column_bases = colbases
  ))
  hemi_map_sr <- expect_warning(
    checkHemisphering(hemi_map_sr, stress_lim = 0.1),
    "Hemisphering or trapped points found:.*"
  )

  expect_false(is.null(srHemisphering(hemi_map_sr)[[6]]))

  export.plot.test(
    ggplot(hemi_map_sr),
    "hemisphering_sr.pdf"
  )

  export.viewer.test(
    view(hemi_map_sr),
    "hemisphering_sr.html"
  )

})


# Finding trapped points
test_that("Finding hemisphering points 3d", {

  # Create an antigen hemisphering point
  hemi_map_ag3d <- perfect_map3d
  titerTable(hemi_map_ag3d)[1, -c(2, 7)] <- "*"

  hemi_map_ag3d <- expect_warning(
    optimizeMap(
      map = hemi_map_ag3d,
      number_of_dimensions = 3,
      number_of_optimizations = 1,
      fixed_column_bases = colbases3d
    )
  )

  hemi_map_ag3d <- checkHemisphering(hemi_map_ag3d, stress_lim = 0.1)
  expect_false(is.null(agHemisphering(hemi_map_ag3d)[[1]]))

  export.viewer.test(
    view(hemi_map_ag3d),
    "hemisphering_ags3d.html"
  )

})



# Read testmap
map <- read.acmap(test_path("../testdata/testmap.ace"))
titerTable(map)[1, 3:4] <- "*"
titerTable(map)[4, 1:2] <- "*"

colbase_matrix <- matrix(
  data = colBases(map),
  nrow = numAntigens(map),
  ncol = numSera(map),
  byrow = TRUE
)

mapDistances(map) + colbase_matrix

test_that("Getting numeric titers", {

  titers <- titerTable(map)
  titers <- gsub("[<>]", "", titers)
  titers[titers == "*"] <- NA
  mode(titers) <- "numeric"

  expect_equal(
    unname(titers),
    numerictiterTable(map)
  )

})

test_that("Calculating table distances", {

  colbases <- ac_table_colbases(
    titer_table = titerTable(map),
    fixed_col_bases = rep(NA, numSera(map)),
    min_col_basis = "none",
    ag_reactivity_adjustments = rep(0, numAntigens(map))
  )
  expect_equal(colbases, c(8, 9, 9, 9, 8))

  table_dists <- ac_numeric_table_distances(
    titer_table = titerTable(map),
    min_col_basis = minColBasis(map),
    fixed_col_bases = fixedColBases(map),
    ag_reactivity_adjustments = agReactivityAdjustments(map)
  )

  numeric_titers <- numerictiterTable(map)
  colbase_matrix <- matrix(
    colbases,
    nrow = nrow(numeric_titers),
    ncol = ncol(numeric_titers),
    byrow = TRUE
  )

  expect_equal(
    colbase_matrix - log2(numeric_titers / 10),
    table_dists
  )

})


titertable <- read.titerTable(test_path("../testdata/titer_tables/titer_table1.csv"))

test_that("Optimizing a map with just a table", {
  map <- acmap(titer_table = titertable)
  map <- optimizeMap(
    map = map,
    number_of_dimensions = 2,
    number_of_optimizations = 1,
    minimum_column_basis = "none"
  )
  expect_equal(numOptimizations(map), 1)
})

test_that("Optimizing a map with a random seed", {

  map <- acmap(titer_table = titertable)
  set.seed(100)
  map1 <- optimizeMap(
    map = map,
    number_of_dimensions = 2,
    number_of_optimizations = 1,
    minimum_column_basis = "none"
  )

  set.seed(100)
  map2 <- optimizeMap(
    map = map,
    number_of_dimensions = 2,
    number_of_optimizations = 1,
    minimum_column_basis = "none"
  )
  expect_equal(agCoords(map1), agCoords(map2))
  expect_equal(srCoords(map1), srCoords(map2))

})

test_that("Optimizing a map with just a data frame", {
  map <- make.acmap(titer_table = as.data.frame(titertable))
  map <- optimizeMap(
    map = map,
    number_of_dimensions = 2,
    number_of_optimizations = 2,
    minimum_column_basis = "none",
    check_convergence = FALSE
  )
  expect_equal(numOptimizations(map), 2)
})

largemap <- read.acmap(test_path("../testdata/testmap_large.ace"))


# Relax existing maps
map_relax      <- map
largemap_relax <- largemap

test_that("Relax existing maps", {

  agCoords(map_relax)    <- agCoords(map_relax) + 1
  agCoords(map_relax, 2) <- agCoords(map_relax, 2) - 1

  stress1        <- mapStress(map_relax)
  stress1_2      <- mapStress(map_relax, 2)

  map_relax     <- relaxMap(map_relax)
  map_relax     <- relaxMap(map_relax, 2)

  stress2        <- mapStress(map_relax)
  stress2_2      <- mapStress(map_relax, 2)

  expect_equal(stress2, 95.0448, tolerance = 1e-4)
  expect_equal(stress2_2, 95.0448, tolerance = 1e-4)

  expect_lt(stress2, stress1)
  expect_lt(stress2_2, stress1_2)

})


# Optimizing with fixed points
test_that("Relax a map with fixed coords", {

  map_unrelaxed      <- map
  agCoords(map_unrelaxed)    <- agCoords(map_unrelaxed) + 1
  srCoords(map_unrelaxed)    <- srCoords(map_unrelaxed) - 1

  map_relaxed_fixed_ags <- relaxMap(map_unrelaxed, fixed_antigens = TRUE)
  expect_true(isTRUE(all.equal(agCoords(map_unrelaxed), agCoords(map_relaxed_fixed_ags))))
  expect_false(isTRUE(all.equal(srCoords(map_unrelaxed), srCoords(map_relaxed_fixed_ags))))

  map_relaxed_fixed_sr  <- relaxMap(map_unrelaxed, fixed_sera = TRUE)
  expect_false(isTRUE(all.equal(agCoords(map_unrelaxed), agCoords(map_relaxed_fixed_sr))))
  expect_true(isTRUE(all.equal(srCoords(map_unrelaxed), srCoords(map_relaxed_fixed_sr))))

  map_relaxed_fixed_all <- relaxMap(map_unrelaxed, fixed_antigens = TRUE, fixed_sera = TRUE)
  expect_true(all.equal(agCoords(map_unrelaxed), agCoords(map_relaxed_fixed_all)))
  expect_true(all.equal(srCoords(map_unrelaxed), srCoords(map_relaxed_fixed_all)))

  map_relaxed_fixed_specific <- relaxMap(map_unrelaxed, fixed_antigens = c(2, 3), fixed_sera = c(1, 4))
  expect_true(isTRUE(all.equal(agCoords(map_unrelaxed)[c(2, 3), ], agCoords(map_relaxed_fixed_specific)[c(2, 3), ])))
  expect_true(isTRUE(all.equal(srCoords(map_unrelaxed)[c(1, 4), ], srCoords(map_relaxed_fixed_specific)[c(1, 4), ])))
  expect_false(isTRUE(all.equal(agCoords(map_unrelaxed)[-c(2, 3), ], agCoords(map_relaxed_fixed_specific)[-c(2, 3), ])))
  expect_false(isTRUE(all.equal(srCoords(map_unrelaxed)[-c(1, 4), ], srCoords(map_relaxed_fixed_specific)[-c(1, 4), ])))

})


# Relax a newly created map
test_that("Relax a map with no titers", {

  testmap <- acmap(
    ag_coords = matrix(1:10, 5, 2),
    sr_coords = matrix(1:10, 5, 2)
  )

  expect_error(
    relaxMap(testmap),
    "Table has no measurable titers"
  )

})


# Optimizing existing maps
test_that("Optimizing existing maps", {

  # Doing new optimizations
  new_map <- expect_warning(optimizeMap(
    map                          = map,
    number_of_dimensions         = 3,
    minimum_column_basis         = "none",
    number_of_optimizations      = 2
  ))
  expect_equal(numOptimizations(new_map), 2)

})


# Moving trapped points
map4 <- map
largemap4 <- largemap
test_that("Moving trapped points", {

  map4 <- relaxMap(map4)

  agcoords1 <- agCoords(map4)
  srcoords1 <- srCoords(map4)

  map4 <- moveTrappedPoints(map4, grid_spacing = 0.25)

  agcoords2 <- agCoords(map4)
  srcoords2 <- srCoords(map4)

  expect_equal(agcoords1, agcoords2)
  expect_equal(srcoords1, srcoords2)

  # Moving trapped points on large map with trapped points
  largemap4 <- relaxMap(largemap4)
  largemap4moved <- moveTrappedPoints(largemap4, grid_spacing = 0.25)
  expect_lt(
    mapStress(largemap4moved),
    mapStress(largemap4)
  )

})


# Randomizing coordinates
test_that("Randomize map coordinates", {

  orig_stress <- mapStress(map)
  rmap <- randomizeCoords(map)
  new_stress <- mapStress(rmap)

  expect_true(sum(agCoords(map) - agCoords(rmap)) != 0)
  expect_true(sum(srCoords(map) - srCoords(rmap)) != 0)
  expect_gt(new_stress, orig_stress)
  expect_true(is.na(optStress(rmap)))

})


# Making a 1D map
test_that("Make a 1D map", {

  # generate random test data
  coord <- matrix(rep(runif(10, 0, 10), times = 2), ncol = 2, byrow = T)
  dist <- as.matrix(dist(coord)) + rnorm(100)
  max_mat <- matrix(apply(round(dist),2,max), ncol = 10, nrow = 10, byrow = T)
  tab1 <- 10 * 2^round(max_mat - dist)

  # make map
  map1 <- make.acmap(
    titer_table = tab1,
    number_of_dimensions = 1,
    number_of_optimizations = 10,
    minimum_column_basis = "2560",
    check_convergence = FALSE
  )

  expect_equal(
    ncol(agCoords(map1)),
    1
  )

})


# Adjusting antigen reactivity
test_that("Adjust antigen reactivity", {

  map <- read.acmap(test_path("../testdata/testmap.ace"))
  expect_equal(
    agReactivityAdjustments(map),
    rep(0, numAntigens(map))
  )

  original_stress <- mapStress(map)
  original_coords <- ptCoords(map)

  # Normal optimization
  map1 <- optimizeAgReactivity(map)
  expect_equal(sum(agReactivityAdjustments(map1) == 0), 0)

  new_stress <- mapStress(map1)
  new_coords <- ptCoords(map1)

  expect_lt(new_stress, original_stress)
  expect_false(isTRUE(all.equal(original_coords, new_coords)))

  # Optimization with fixed reactivities
  ag_reactivities <- rep(NA, numAntigens(map))
  ag_reactivities[2] <- 1.12

  map2 <- optimizeAgReactivity(map, fixed_ag_reactivities = ag_reactivities)
  expect_equal(sum(agReactivityAdjustments(map2) == 0), 0)

  new_stress <- mapStress(map2)
  new_coords <- ptCoords(map2)

  expect_lt(new_stress, original_stress)
  expect_false(isTRUE(all.equal(original_coords, new_coords)))
  expect_equal(agReactivityAdjustments(map2)[2], 1.12)

})


# Setting a different dilution stepsize
test_that("Setting dilution stepsize", {

  map <- read.acmap(test_path("../testdata/testmap.ace"))
  map <- randomizeCoords(map)

  map1 <- map
  titerTable(map1)[titerTable(map1) == "<10"] <- "<20"
  map1 <- relaxMap(map1)

  map2a <- map
  map2a <- relaxMap(map2a)

  map2b <- map
  dilutionStepsize(map2b) <- 0
  map2b <- relaxMap(map2b)

  expect_equal(dilutionStepsize(map), 1)
  expect_false(isTRUE(all.equal(ptCoords(map1), ptCoords(map2a))))
  expect_true(isTRUE(all.equal(ptCoords(map1), ptCoords(map2b))))

})


# Setting a different dilution stepsize
test_that("Setting high min column bases", {

  map <- read.acmap(test_path("../testdata/testmap.ace"))
  map <- optimizeMap(map, 2, 1, "10240")
  expect_equal(numOptimizations(map), 1)

})


# Relaxing a map with NA coords
test_that("Relaxing a map with NA coords", {

  map <- read.acmap(test_path("../testdata/testmap.ace"))
  agCoords(map)[2:3,] <- NA
  map_relaxed <- relaxMap(map)

  expect_lt(
    mapStress(map_relaxed),
    mapStress(map)
  )

  expect_gt(
    mapStress(map_relaxed),
    0
  )

})


# Errors for disconnected maps
test_that("Error when optimizing a map with disconnected points", {

  dat <- matrix(rep(40, 90), ncol=9)
  dat[6:10,1:5] <- "*"
  dat[1:5,6:9] <- "*"
  map <- acmap(titer_table = dat)
  expect_error(
    optimizeMap(map, 2, 10, "none"),
    "Map contains disconnected points.*"
  )

})


# Errors for disconnected maps
test_that("Optimizing a map with duplicate antigen or serum names", {

  dat <- matrix(rep(40, 90), ncol=9)
  ag_names <- rep("AG", nrow(dat))
  sr_names <- rep("SR", ncol(dat))
  rownames(dat) <- ag_names
  colnames(dat) <- sr_names

  map <- expect_warning(make.acmap(dat, number_of_optimizations = 2))
  expect_equal(agNames(map), ag_names)
  expect_equal(srNames(map), sr_names)
  expect_equal(sum(is.na(agCoords(map))), 0)
  expect_equal(sum(is.na(srCoords(map))), 0)

})