tests/testthat/test-view_map.R

In Racmacs: Antigenic Cartography Macros

library(testthat)
context("Viewing a map")

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

# Viewing a null map
test_that("Viewing a 1D map", {

  map <- optimizeMap(map, 1, 2, "none", check_convergence = F)
  export.viewer.test(view(map), "map_1D.html")

})

# Viewing a null map
test_that("Viewing a null map", {

  export.viewer.test(
    RacViewer(
      map = NULL,
      options = list(
        viewer.controls = "shown"
      )
    ),
    filename = "map_null.html"
  )

})

# Viewing a null map
test_that("Viewing a map then reload with no optimizations", {

  widget <- RacViewer(
    map = map,
    options = list(
      viewer.controls = "optimizations"
    )
  )

  map_no_opts <- removeOptimizations(map)
  widget <- htmlwidgets::onRender(
    x      = widget,
    jsCode = "function(el, x, data) { el.viewer.load(JSON.parse(data), { maintain_viewpoint:true }); }",
    data   = as.json(map_no_opts)
  )

  export.viewer.test(
    widget,
    filename = "map_switch_to_no_opts.html"
  )

})

# Viewing a aligned optimizations
test_that("Viewing aligned optimizations", {

  map <- read.acmap(test_path("../testdata/testmap_large.ace"))
  set.seed(10)
  map <- expect_warning(optimizeMap(map, 2, 100, "none"))
  map <- realignOptimizations(map)
  export.viewer.test(
    RacViewer(
      map = map,
      options = list(
        viewer.controls = "optimizations"
      )
    ),
    filename = "map_aligned_optimizations.html"
  )

})

# Viewing maps
test_that("Viewing a map", {

  agCoords(map)[1, ] <- c(5.1, 5.4)
  agFill(map) <- "green"

  x <- view(
    orderAntigens(map, rev(seq_len(numAntigens(map)))),
    options = list(
      viewer.controls = "diagnostics",
      show.names = "antigens",
      xlim = range(agCoords(map)[, 1]),
      ylim = range(agCoords(map)[, 2])
    )
  )

  # map_no_opts <- removeOptimizations(map)
  # widget <- htmlwidgets::onRender(
  #   x      = widget,
  #   jsCode = "function(el, x, data) { el.viewer.load(JSON.parse(data), { maintain_viewpoint:true }); }",
  #   data   = as.json(map_no_opts)
  # )

  expect_equal(class(x), c("RacViewer", "htmlwidget"))
  export.viewer.test(
    x,
    filename = "map_test.html"
  )

})

# Changing point styles
test_that("Viewing a map", {

  map_styled <- map
  srShown(map_styled) <- FALSE
  agShape(map_styled) <- "TRIANGLE"
  x <- view(map_styled)
  expect_equal(class(x), c("RacViewer", "htmlwidget"))
  export.viewer.test(
    x,
    filename = "map_pointstyles.html"
  )

})

# 3D map
test_that("Viewing a 3D map", {

  map <- read.acmap(test_path("../testdata/testmap_h3subset3d.ace"))
  export.viewer.test(
    view(map),
    filename = "map_3d.html"
  )

})

# 3D map
test_that("Viewing a 3D map with sphere outlines", {

  map <- read.acmap(test_path("../testdata/testmap_h3subset3d.ace"))
  srShape(map) <- "CIRCLE"

  export.viewer.test(
    view(map),
    filename = "map_3d_sphere_outlines.html"
  )

})

# Exporting the viewer
test_that("Exporting a map viewer", {

  if (!rmarkdown::pandoc_available()) skip()
  tmp <- tempfile(fileext = ".html")
  export_viewer(map, tmp, selfcontained = FALSE)
  expect_true(file.exists(tmp))
  unlink(tmp)

})

# Overlaid points
test_that("Map with triangle points", {

  ag_coords1 <- cbind(1:5, 1)
  ag_coords2 <- cbind(1:5, 2)
  sr_coords  <- cbind(1:5, 3)
  testmap <- acmap(
    ag_coords = rbind(ag_coords1, ag_coords2),
    sr_coords = sr_coords
  )

  agShape(testmap)[1:5]   <- "BOX"
  srShape(testmap)        <- "TRIANGLE"
  agAspect(testmap)[1:5]  <- seq(from = 0.5, to = 1.5, length.out = 5)
  agAspect(testmap)[6:10] <- seq(from = 0.5, to = 1.5, length.out = 5)
  srAspect(testmap)       <- seq(from = 0.5, to = 1.5, length.out = 5)
  agFill(testmap)[1]      <- "#ff0000"

  export.viewer.test(
    view(testmap),
    filename = "map_with_triangles.html"
  )

})


# Adding a map legend
test_that("Adding a map legend", {

  legendmap <- setLegend(
    map,
    legend = c("Blue points", "Red points"),
    fill   = c("#0000ff", "#ff0000")
  )

  export.viewer.test(
    view(legendmap),
    filename = "map_with_legend.html"
  )

})


# Point styles
test_that("Viewing map point styles", {

  stylemap <- acmap(
    ag_coords = cbind(1:5, 0),
    sr_coords = cbind(1:5, 1)
  )

  agOutlineWidth(stylemap) <- 1:5
  srOutlineWidth(stylemap) <- 1:5

  export.viewer.test(
    view(stylemap),
    filename = "map_with_pointstyles.html"
  )

})


# Rotated map
test_that("Viewing map rotation", {

  map <- acmap(
    ag_coords = cbind(0, 1:5),
    sr_coords = cbind(1:5, 0)
  )

  maprot <- rotateMap(
    map, 45
  )

  export.viewer.test(
    view(maprot),
    "map45degreeclockwise.html"
  )

})


# Setting viewer options
test_that("Viewing map rotation", {

  map <- acmap(
    ag_coords = cbind(0, 1:5),
    sr_coords = cbind(1:5, 0)
  )

  export.viewer.test(
    view(
      map,
      options = list(
        viewer.controls = "shown",
        point.opacity = 0.2
      )
    ),
    "map_vieweroptions.html"
  )

})


# Point opacity
test_that("Viewing map transparency", {

  map <- acmap(
    ag_coords = cbind(0, 1:3),
    sr_coords = cbind(1:3, 0)
  )

  agFill(map) <- c(
    adjustcolor("red", alpha.f = 1),
    adjustcolor("red", alpha.f = 0.6),
    adjustcolor("red", alpha.f = 0.2)
  )

  agOutline(map) <- c(
    adjustcolor("black", alpha.f = 0.2),
    adjustcolor("black", alpha.f = 0.6),
    adjustcolor("black", alpha.f = 1)
  )

  srFill(map) <- c(
    adjustcolor("green", alpha.f = 1),
    adjustcolor("green", alpha.f = 0.6),
    adjustcolor("green", alpha.f = 0.2)
  )

  srOutline(map) <- c(
    adjustcolor("black", alpha.f = 1),
    adjustcolor("black", alpha.f = 0.6),
    adjustcolor("black", alpha.f = 0.2)
  )

  agSize(map) <- 10
  srSize(map) <- 10
  agOutlineWidth(map) <- 3
  srOutlineWidth(map) <- 3

  export.viewer.test(
    view(map),
    "map_transparent_points_uninherited.html"
  )

  export.viewer.test(
    view(
      map,
      options = list(
        point.opacity = "inherit"
      )
    ),
    "map_transparent_points_inherited.html"
  )

})

# Point opacity
test_that("Viewing map with underconstrained points", {

  set.seed(850909)
  dat <- matrix(10*2^round(10*runif(100)), ncol=10)
  for (i in 1:10){
    dat[i,i:10] <- "*"
  }
  map <- expect_warning(make.acmap(dat, options = list(ignore_disconnected = TRUE)))
  map2 <- expect_warning(make.acmap(dat[2:10,]))

  widget1 <- view(map)
  widget2 <- view(map2)

  widget1 <- htmlwidgets::onRender(
    x      = widget1,
    jsCode = "function(el, x, data) { el.viewer.colorPointsByStress(); }",
    data   = NULL
  )

  widget2 <- htmlwidgets::onRender(
    x      = widget2,
    jsCode = "function(el, x, data) { el.viewer.colorPointsByStress(); el.viewer.showErrorLines(); }",
    data   = NULL
  )

  export.viewer.test(widget1, "map_ag_no_titers.html")
  export.viewer.test(widget2, "map_ag_underconstrained.html")

})


# # Snapshot map
# test_that("Map snapshot", {
#
#   snapshotfile <- "~/Dropbox/LabBook/packages/Racmacs/tests/testoutput/viewer/mapsnapshot.png"
#   unlink(snapshotfile)
#
#   snapshotMap(
#     map,
#     filename = snapshotfile
#   )
#
#   expect_true(file.exists(snapshotfile))
#
# })