tests/testthat/test-reconstructed-outline.R

In retistruct: Retinal Reconstruction Program

context("ReconstructedOutline")
test_that("ReconstructededOutlines with a single fragment work correctly", {
  P <- rbind(c(1,1),
             c(2,1),
             c(2,-1),
             c(1,-1),
             c(1,-2),
             c(-1,-2),
             c(-1,-1),
             c(-2,-1),
             c(-2,1),
             c(-1,1),
             c(-1,2),
             c(1,2))

  ## Stitched outlines
  a <- StitchedOutline$new(P)

  ## Set a fixed point
  ## One that is in the rim should be fine
  a$setFixedPoint(5, "Nasal")
  expect_equal(a$i0, c(Nasal=5))

  ## One that is not in the rim should be moved
  a$addTear(c(3, 4, 5))
  a$addTear(c(6, 7, 8))
  a$addTear(c(9, 10, 11))
  a$addTear(c(12, 1, 2))

  ## Reconstruct
  r <- ReconstructedOutline$new()
  r$loadOutline(a)
  r$mergePointsEdges()
  expect_equal(length(r$Lt), nrow(r$Cut))
  expect_true(!any(is.na(r$Lt)))
  r$projectToSphere()
  expect_equal(r$ol$A.tot, 4 + 4*2)
  expect_true(is.numeric(r$R))
  r$getStrains()

  ## FIXME: Test of scaling required. i.e. suppose we scale the
  ## original points (P) by a factor, do we get the same mapping?
})

test_that("ReconstructededOutlines with mutliple fragments work correctly", {
  P <- list(rbind(c(1,1),
                  c(2,1),
                  c(2.5,2),
                  c(3,1),
                  c(4,1),
                  c(1,4)),
            rbind(c(-1,1),
                  c(-1,4),
                  c(-2,3),
                  c(-2,2),
                  c(-3,2),
                  c(-4,1)),
            rbind(c(-4,-1),
                  c(-1,-1),
                  c(-1,-4)),
            rbind(c(1,-1),
                  c(2,-1),
                  c(2.5,-2),
                  c(3,-1),
                  c(4,-1),
                  c(1,-4)))

  ## Stitched outlines
  a <- StitchedOutline$new(P)

  ## Set a fixed point
  ## One that is in the rim should be fine
  a$setFixedPoint(5, "Nasal")
  expect_equal(a$i0, c(Nasal=5))

  ## One that is not in the rim should be moved
  a$addTear(c(9, 10, 11))
  a$addTear(c(2, 3, 4))
  a$addTear(c(17, 18, 19))

  ## Add fullcuts
  a$addFullCut(c(1, 5, 16, 20))
  a$addFullCut(c(1, 7, 6, 8))
  a$addFullCut(c(7, 14, 12, 13))
  a$addFullCut(c(14, 15, 16, 21))
  r <- ReconstructedOutline$new()
  r$loadOutline(a)
  r$mergePointsEdges()
  expect_equal(length(r$Lt), nrow(r$Cut))
  expect_true(!any(is.na(r$Lt)))
  r$projectToSphere()
  expect_equal(r$ol$A.tot, 16.5)
  expect_true(is.numeric(r$R))
  r$getStrains()

  #r <- ReconstructedOutline$new(a)
  #r$reconstruct()

  ## FIXME: Test of scaling required. i.e. suppose we scale the
  ## original points (P) by a factor, do we get the same mapping?
})

test_that("ReconstructededOutlines with multiple fragments with a hole work correctly", {
  ## Constructing multi-fragment outline
  P <- list(rbind(c(1,1.5),
                  c(1.5,1),
                  c(2,1),
                  c(2.5,2),
                  c(3,1),
                  c(4,1),
                  c(1,4)),
            rbind(c(-1.5,1),
                  c(-1,1.5),
                  c(-1,4),
                  c(-2,3),
                  c(-2,2),
                  c(-3,2),
                  c(-4,1)),
            rbind(c(-4,-1),
                  c(-1.5,-1),
                  c(-1,-1.5),
                  c(-1,-4)),
            rbind(c(1,-1.5),
                  c(1.5,-1),
                  c(2,-1),
                  c(2.5,-2),
                  c(3,-1),
                  c(4,-1),
                  c(1,-4)))
  ## Stitched outlines
  a <- StitchedOutline$new(P)

  expect_false(a$isStitched())

  ## Set a fixed point
  ## One that is in the rim should be fine
  a$setFixedPoint(6, "Nasal")
  expect_equal(a$i0, c(Nasal=6))

  ## One that is not in the rim should be moved
  a$addTear(c(11, 12, 13))
  a$addTear(c(3, 4, 5))
  a$addTear(c(21, 22, 23))

  ## Add fullcuts
  a$addFullCut(c(2, 6, 20, 24))
  a$addFullCut(c(1, 7, 9, 10))
  a$addFullCut(c(8, 14, 15, 16))
  a$addFullCut(c(17, 18, 19, 25))

  r <- ReconstructedOutline$new()
  r$loadOutline(a)
  r$mergePointsEdges()
  expect_equal(length(r$Lt), nrow(r$Cut))
  expect_true(!any(is.na(r$Lt)))
  r$projectToSphere()
  expect_equal(r$ol$A.tot, 16.0)
  expect_true(is.numeric(r$R))
  r$getStrains()
  r$reconstruct()
})