tests/testthat/test-funsWork.R

In viscomplexr: Phase Portraits of Functions in the Complex Number Plane

# -----------------------------------------------------------------------------
# Test if phasePortrait produces the correct numerical output.
#
# Uses reference files created with the R-script in CreateTestCases/.
# These reference files are in the project's subdirectory tests/testthat/,
# which automatically becomes the working directory when test_that() is run.
# -----------------------------------------------------------------------------


# function cleanUp
# Deletes all files from the R session's temporary directory which match the
# naming conventions of phasePortrait's temporary files. Is called before and
# after each test run. Thus, the R session's temporary directory, is always
# absolutely clean and unambiguous as far as phasePortrait output is concerned.
cleanUp <- function() {
  existZWMat <- dir(tempdir(), pattern = "^\\d+(z|w)mat\\d{10}\\.RData$")
  unlink(paste0(tempdir(), "/", existZWMat))
}


# function loadActual
# After a call to cleanup and a subsequent call of phasePortrait, only output
# files from the last phasePortrait run can possibly reside in the R session's
# temporary directory (if we explicitly told phasePortrait not to delete them
# after use). The test cases are so slim, that there is only one zmat and one
# wmat file. We load the "wmat" file for further inspection.
loadActual <- function() {
  existWMat <- dir(tempdir(), pattern = "^\\d+wmat\\d{10}\\.RData$")
  get(load(paste0(tempdir(), "/", existWMat)))
}


# Test cases defined as functions
# -------------------------------

# Test cases for phasePortrait


# Test case 1:
# A rational function given as single string
testCase1 <- function() {
  cleanUp()
  phasePortrait("(2-z)^2*(-1i+z)^3*(4-3i-z)/((2+2i+z)^4)",
                xlim = c(-4, 4), ylim = c(-4, 4),
                invertFlip = FALSE,
                blockSizePx = 2250000,
                res = 150,
                tempDir = NULL,
                deleteTempFiles = FALSE,
                noScreenDevice = TRUE,
                nCores = 2,
                verbose = FALSE)
  referenceWmat <- get(load("1wmatCase001.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}


# Test case 2:
# A rational function given as single string, but with invertFlip = TRUE
testCase2 <- function() {
  cleanUp()
  phasePortrait("(2-z)^2*(-1i+z)^3*(4-3i-z)/((2+2i+z)^4)",
                xlim = c(-4, 4), ylim = c(-4, 4),
                invertFlip = TRUE,
                blockSizePx = 2250000,
                res = 150,
                tempDir = NULL,
                deleteTempFiles = FALSE,
                noScreenDevice = TRUE,
                nCores = 2,
                verbose = FALSE)
  referenceWmat <- get(load("1wmatCase002.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}


# Test case 3
# User function with additional default arguments which are _not_ specified
# in the call to phasePortrait
testCase3 <- function() {

  jacobiTheta_1 <- function(z, tau = 1i, nIter = 30) {
    k <- c(1:nIter)
    q <- exp(pi*1i*tau)
    g <- exp(2*pi*1i*z)
    return(1 + sum(q^(k^2)*g^k + q^(k^2)*(1/g)^k))
  }

  cleanUp()
  phasePortrait(jacobiTheta_1,
                xlim = c(-2, 2), ylim = c(-2, 2),
                invertFlip = FALSE,
                blockSizePx = 2250000,
                res = 150,
                tempDir = NULL,
                deleteTempFiles = FALSE,
                noScreenDevice = TRUE,
                nCores = 2,
                verbose = FALSE)
  referenceWmat <- get(load("1wmatCase003.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}


# Test case 4
# User function with additional default arguments which are specified
# in the call to phasePortrait
testCase4 <- function() {

  jacobiTheta_1 <- function(z, tau = 1i, nIter = 30) {
    k <- c(1:nIter)
    q <- exp(pi*1i*tau)
    g <- exp(2*pi*1i*z)
    return(1 + sum(q^(k^2)*g^k + q^(k^2)*(1/g)^k))
  }

  cleanUp()
  phasePortrait(jacobiTheta_1,
                moreArgs = list(tau = 1i/2 - 1/4, nIter = 30),
                xlim = c(-2, 2), ylim = c(-2, 2),
                invertFlip = FALSE,
                blockSizePx = 2250000,
                res = 150,
                tempDir = NULL,
                deleteTempFiles = FALSE,
                noScreenDevice = TRUE,
                nCores = 2,
                verbose = FALSE,
                autoDereg = TRUE) # Register sequential backend after
                                  # the last phase portrait
  referenceWmat <- get(load("1wmatCase004.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}


# Test cases for phasePortrait

# Test case 5
# Same as case 1, but with phasePortraitBw
testCase5 <- function() {
  cleanUp()
  phasePortraitBw("(2-z)^2*(-1i+z)^3*(4-3i-z)/((2+2i+z)^4)",
                  xlim = c(-4, 4), ylim = c(-4, 4),
                  invertFlip = FALSE,
                  blockSizePx = 2250000,
                  res = 150,
                  tempDir = NULL,
                  deleteTempFiles = FALSE,
                  noScreenDevice = TRUE,
                  nCores = 2,
                  verbose = FALSE)
  referenceWmat <- get(load("1wmatCase005.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}


# Test case 6:
# A rational function given as single string, but with invertFlip = TRUE
# Same as case 2, but with phasePortraitBw
testCase6 <- function() {
  cleanUp()
  phasePortraitBw("(2-z)^2*(-1i+z)^3*(4-3i-z)/((2+2i+z)^4)",
                  xlim = c(-4, 4), ylim = c(-4, 4),
                  invertFlip = TRUE,
                  blockSizePx = 2250000,
                  res = 150,
                  tempDir = NULL,
                  deleteTempFiles = FALSE,
                  noScreenDevice = TRUE,
                  nCores = 2,
                  verbose = FALSE)
  referenceWmat <- get(load("1wmatCase006.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}


# Test case 7
# User function with additional default arguments which are _not_ specified
# in the call to phasePortraitBw
# Same as case 3, but with phasePortraitBw
testCase7 <- function() {

  jacobiTheta_1 <- function(z, tau = 1i, nIter = 30) {
    k <- c(1:nIter)
    q <- exp(pi*1i*tau)
    g <- exp(2*pi*1i*z)
    return(1 + sum(q^(k^2)*g^k + q^(k^2)*(1/g)^k))
  }

  cleanUp()
  phasePortraitBw(jacobiTheta_1,
                  xlim = c(-2, 2), ylim = c(-2, 2),
                  invertFlip = FALSE,
                  blockSizePx = 2250000,
                  res = 150,
                  tempDir = NULL,
                  deleteTempFiles = FALSE,
                  noScreenDevice = TRUE,
                  nCores = 2,
                  verbose = FALSE)
  referenceWmat <- get(load("1wmatCase007.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}


# Test case 8
# User function with additional default arguments which are specified
# in the call to phasePortraitBw
# Same as case 4, but with phasePortraitBw
testCase8 <- function() {

  jacobiTheta_1 <- function(z, tau = 1i, nIter = 30) {
    k <- c(1:nIter)
    q <- exp(pi*1i*tau)
    g <- exp(2*pi*1i*z)
    return(1 + sum(q^(k^2)*g^k + q^(k^2)*(1/g)^k))
  }

  cleanUp()
  phasePortrait(jacobiTheta_1,
                moreArgs = list(tau = 1i/2 - 1/4, nIter = 30),
                xlim = c(-2, 2), ylim = c(-2, 2),
                invertFlip = FALSE,
                blockSizePx = 2250000,
                res = 150,
                tempDir = NULL,
                deleteTempFiles = FALSE,
                noScreenDevice = TRUE,
                nCores = 2,
                verbose = FALSE,
                autoDereg = TRUE) # Register sequential backend after
  # the last phase portrait
  referenceWmat <- get(load("1wmatCase008.RData"))
  actualWmat    <- loadActual()
  cleanUp()
  rslt          <- all.equal(referenceWmat, actualWmat)
  rm(referenceWmat, actualWmat)
  return(rslt)
}




# The actual tests
test_that("phasePortrait produces correct numerical output", {
  expect_true(testCase1())
  expect_true(testCase2())
  expect_true(testCase3())
  expect_true(testCase4())
})

test_that("phasePortraitBw produces correct numerical output", {
  expect_true(testCase5())
  expect_true(testCase6())
  expect_true(testCase7())
  expect_true(testCase8())
})


# -----------------------------------------------------------------------------
# -----------------------------------------------------------------------------