tests/testthat/testParameters.R

In campsismod: Generic Implementation of a PK/PD Model

library(testthat)

context("Test all methods from the parameters class")

source(paste0("", "testUtils.R"))

test_that("Write/Read THETA's", {
  
  file <- paste0(testFolder, "write/parameters/")
  
  # Read THETA's
  theta1 <- Theta(name="CL", index=1, value=5, fix=TRUE)
  theta2 <- Theta(name="KA", index=2, value=1, fix=TRUE)
  theta3 <- Theta(name="V", index=3,  value=80, fix=TRUE)
  
  thetas <- Parameters() %>% add(theta1) %>% add(theta2) %>% add(theta3)
  thetas %>% write(file=file)
  
  # Write THETA's
  thetas2 <- read.parameters(paste0(file, "theta.csv"), type="theta")
  
  # Check we can retrieve the exact same list
  expect_equal(thetas, thetas2)
})


test_that("Add/contains methods", {
  
  theta1 <- Theta(name="CL", index=1, value=5, fix=TRUE)
  theta2 <- Theta(name="KA", index=2, value=1, fix=TRUE)
  thetas <- Parameters() %>% add(theta1) %>% add(theta2)

  expect_true(thetas %>% contains(Theta(name="CL")))
  expect_false(thetas %>% contains(Theta(name="V")))
  
  thetas <- thetas %>% add(Theta(name="V"))
  expect_true(thetas %>% contains(Theta(name="V")))
})

test_that("GetByIndex, find & select method work well", {
  p <- Parameters()
  p <- p %>% add(Theta())
  p <- p %>% add(Theta())
  p <- p %>% add(Theta())
  p <- p %>% add(Omega())
  p <- p %>% add(Omega())
  p <- p %>% add(Sigma())

  # Search by index
  expect_equal(p %>% getByIndex(Theta(index=3)), Theta(index=3))
  expect_equal(p %>% getByIndex(Omega(index=1, index2=1)), Omega(index=1, index2=1))
  expect_equal(p %>% getByIndex(Sigma(index=1, index2=1)), Sigma(index=1, index2=1))
  
  # Or equivalently using find
  expect_equal(p %>% find(Theta(index=3)), Theta(index=3))
  expect_equal(p %>% find(Omega(index=1, index2=1)), Omega(index=1, index2=1))
  expect_equal(p %>% find(Sigma(index=1, index2=1)), Sigma(index=1, index2=1))
  
  p <- p %>% select("theta")
  expect_equal(p %>% length(), 3)
  
  # Check there is no conflict with dplyr::select
  df <- data.frame(ID=c(1,2,3), ID2=c(3,4,5))
  df <- df %>% select(ID)
  expect_false("ID2" %in% colnames(df))
})


test_that("Sort method", {
  
  sigma1 <- Sigma(index=1, index2=1, value=1)
  omega2 <- Omega(index=2, index2=2, value=1)
  omega1 <- Omega(index=1, index2=1, value=1)
  theta2 <- Theta(index=2, value=1)
  theta1 <- Theta(index=1, value=1)
  
  params <- Parameters() %>% add(c(sigma1, omega2, omega1, theta2, theta1))
  
  orderedParams <- params %>% sort()
  
  expectedParams <- Parameters() %>% add(c(theta1, theta2, omega1, omega2, sigma1))
  expect_equal(orderedParams, expectedParams)
})

test_that("Disable method (IIV/RUV)", {
  
  model <- model_suite$testing$nonmem$advan4_trans4
  
  model <- model %>% disable("IIV")
  expect_equal((model@parameters %>% find(Omega(name="KA")))@value, 0)
  expect_equal((model@parameters %>% find(Omega(name="CL")))@value, 0)
  expect_equal((model@parameters %>% find(Omega(name="V2")))@value, 0)
  expect_equal((model@parameters %>% find(Omega(name="V3")))@value, 0)
  expect_equal((model@parameters %>% find(Omega(name="Q")))@value, 0)
  expect_equal((model@parameters %>% find(Sigma(name="PROP")))@value, 0.025)
  
  model <- model %>% disable("RUV")
  expect_equal((model@parameters %>% find(Sigma(name="PROP")))@value, 0)
  
  expect_error(model %>% disable("SOMETHING"), regexp="Only these variabilities can be disabled")
})

test_that("Disable method (VARCOV)", {
  
  model <- model_suite$testing$other$my_model1
  expect_equal(model@parameters@varcov %>% length(), 49) # 7*7 matrix
  
  model <- model %>% disable("VARCOV")
  expect_equal(model@parameters@varcov %>% length(), 0)
})

test_that("Disable method (VARCOV_OMEGA & VARCOV_SIGMA)", {
  
  model <- model_suite$testing$other$my_model1
  expect_equal(model@parameters@varcov %>% length(), 49) # 7*7 matrix
  
  model <- model %>% disable("VARCOV_OMEGA")
  expect_equal(model@parameters@varcov %>% length(), 25) # 2 OMEGA's removed
  
  model <- model %>% disable("VARCOV_SIGMA")
  expect_equal(model@parameters@varcov %>% length(), 16) # 1 SIGMA removed
  
  # All at once
  model <- model_suite$testing$other$my_model1
  model <- model %>% disable(c("VARCOV_OMEGA", "VARCOV_SIGMA"))
  expect_equal(model@parameters@varcov %>% length(), 16)
})

test_that("Disable method (IOV)", {
  model <- read.campsis(paste0(testFolder, "custom/", "model1_omega_fixed"))
  model <- model %>% disable("IOV")
  
  omega4 <- model@parameters %>% getByIndex(Omega(index=4, index2=4))
  expect_true(omega4@value != 0)
  
  omega5 <- model@parameters %>% getByIndex(Omega(index=5, index2=5))
  expect_true(omega5@value == 0)
  
  omega6 <- model@parameters %>% getByIndex(Omega(index=6, index2=6))
  expect_true(omega6@value == 0)
})

test_that("Fix omega method is working", {
  
  # 'Unfix' OMEGA matrix
  original_model <- read.campsis(paste0(testFolder, "custom/", "model1_omega_fixed"))
  list <- original_model@parameters@list %>% purrr::map(.f=function(x) {
    if (is(x, "omega")) {
      if(isTRUE(x@same)) {
        x@value <- as.numeric(NA)
      }
      x@same <- as.logical(NA)
    }
    return(x)
  })
  model_not_fixed <- original_model
  model_not_fixed@parameters@list <- list
  
  # Fix OMEGA
  model_fixed <- model_not_fixed
  model_fixed@parameters <- model_fixed@parameters %>% fixOmega()
  
  expect_equal(original_model, model_fixed)
})

test_that("Name column is optional", {
  
  model <- read.campsis(paste0(testFolder, "custom/", "advan1_trans1_no_name"))
  names <- (model@parameters %>% select("theta"))@list %>% purrr::map_chr(.f=~.x@name)
  expect_true(all(is.na(names)))
})

test_that("THETA indexes validation", {
  # 2 THETAS OK
  theta1 <- Theta(index=1, value=0)
  theta2 <- Theta(index=2, value=0)
  thetas <- Parameters() %>% add(theta1) %>% add(theta2)
  expect_equal(thetas %>% length(), 2)
  expect_true(validObject(thetas))
  
  # Wrong starting index
  thetas <- Parameters() %>% add(Theta(index=2, value=0))
  expect_error(validObject(thetas))
  
  # NA value
  thetas <- Parameters() %>% add(Theta(index=1, value=NA))
  expect_error(validObject(thetas))
  
  # Index 2 missing
  theta1 <- Theta(index=1, value=0)
  theta2 <- Theta(index=3, value=0)
  thetas <- Parameters() %>% add(theta1) %>% add(theta2)
  expect_equal(thetas %>% length(), 2)
  expect_error(validObject(thetas))
})

test_that("OMEGA indexes validation", {
  # 2 OMEGA OK
  omega1 <- Omega(index=1, index2=1, value=0)
  omega2 <- Omega(index=2, index2=2, value=0)
  omegas <- Parameters() %>% add(omega1) %>% add(omega2)
  expect_equal(omegas %>% length(), 2)
  expect_true(validObject(omegas))
  
  # Wrong starting index
  omegas <- Parameters() %>% add(Omega(index=2, index2=2, value=0))
  expect_error(validObject(omegas))
  
  # NA value
  omegas <- Parameters() %>% add(Omega(index=1, index2=1, value=NA))
  expect_error(validObject(omegas))
  
  # Index 2 missing
  omega1 <- Omega(index=1, index2=1, value=0)
  omega2 <- Omega(index=3, index2=3, value=0)
  omegas <- Parameters() %>% add(omega1) %>% add(omega2)
  expect_equal(omegas %>% length(), 2)
  expect_error(validObject(omegas))
})

test_that("SIGMA indexes validation", {
  # 2 SIGMA OK
  sigma1 <- Sigma(index=1, index2=1, value=0)
  sigma2 <- Sigma(index=2, index2=2, value=0)
  sigmas <- Parameters() %>% add(sigma1) %>% add(sigma2)
  expect_equal(sigmas %>% length(), 2)
  expect_true(validObject(sigmas))
  
  # Wrong starting index
  sigmas <- Parameters() %>% add(Sigma(index=2, index2=2, value=0))
  expect_error(validObject(sigmas))
  
  # NA value
  sigmas <- Parameters() %>% add(Sigma(index=1, index2=1, value=NA))
  expect_error(validObject(sigmas))
  
  # Index 2 missing
  sigma1 <- Sigma(index=1, index2=1, value=0)
  sigma2 <- Sigma(index=3, index2=3, value=0)
  sigmas <- Parameters() %>% add(sigma1) %>% add(sigma2)
  expect_equal(sigmas %>% length(), 2)
  expect_error(validObject(sigmas))
})

test_that("Add parameters with NA indexes", {
  # Thetas
  parameters <- Parameters()
  parameters <- parameters %>% add(Theta(value=0))
  parameters <- parameters %>% add(Theta(value=0))
  parameters <- parameters %>% add(Theta(value=0))
  
  expect_equal(parameters %>% getByIndex(Theta(index=1)) %>% length(), 1)
  expect_equal(parameters %>% getByIndex(Theta(index=2)) %>% length(), 1)
  expect_equal(parameters %>% getByIndex(Theta(index=3)) %>% length(), 1)
  expect_true(validObject(parameters))
  
  # Omegas
  parameters <- Parameters()
  parameters <- parameters %>% add(Omega(value=0))
  parameters <- parameters %>% add(Omega(value=0))
  parameters <- parameters %>% add(Omega(value=0))
  
  expect_equal(parameters %>% getByIndex(Omega(index=1, index2=1)) %>% length(), 1)
  expect_equal(parameters %>% getByIndex(Omega(index=2, index2=2)) %>% length(), 1)
  expect_equal(parameters %>% getByIndex(Omega(index=3, index2=3)) %>% length(), 1)
  expect_true(validObject(parameters))
  
  # Sigmas
  parameters <- Parameters()
  parameters <- parameters %>% add(Sigma(value=0))
  parameters <- parameters %>% add(Sigma(value=0))
  parameters <- parameters %>% add(Sigma(value=0))
  
  expect_equal(parameters %>% getByIndex(Sigma(index=1, index2=1)) %>% length(), 1)
  expect_equal(parameters %>% getByIndex(Sigma(index=2, index2=2)) %>% length(), 1)
  expect_equal(parameters %>% getByIndex(Sigma(index=3, index2=3)) %>% length(), 1)
  expect_true(validObject(parameters))
})

test_that("Replace parameters without specifying the index", {
  # Thetas
  parameters <- Parameters()
  parameters <- parameters %>% add(Theta(name="X1", value=0))
  parameters <- parameters %>% add(Theta(name="X2", value=0))
  parameters <- parameters %>% add(Theta(name="X3", value=0))
  parameters <- parameters %>% replace(Theta(name="X1", value=10))
  
  expect_equal((parameters %>% find(Theta(name="X1")))@value, 10)
  
  # Omegas
  parameters <- Parameters()
  parameters <- parameters %>% add(Omega(name="X1", value=0))
  parameters <- parameters %>% add(Omega(name="X2", value=0))
  parameters <- parameters %>% add(Omega(name="X3", value=0))
  parameters <- parameters %>% replace(Omega(name="X1", value=10))
  
  expect_equal((parameters %>% find(Omega(name="X1")))@value, 10)
  
  # Sigmas
  parameters <- Parameters()
  parameters <- parameters %>% add(Sigma(name="X1", value=0))
  parameters <- parameters %>% add(Sigma(name="X2", value=0))
  parameters <- parameters %>% add(Sigma(name="X3", value=0))
  parameters <- parameters %>% replace(Sigma(name="X1", value=10))
  
  expect_equal((parameters %>% find(Sigma(name="X1")))@value, 10)
})

test_that("Add all method works well", {
  # Use c() operator and add
  parameters1 <- Parameters()
  parameters1 <- parameters1 %>% add(c(Theta(value=0), Theta(value=0), Theta(value=0)))
  
  expect_equal(parameters1 %>% length(), 3)
  
  # Use list() operator and add
  parameters2 <- Parameters()
  parameters2 <- parameters2 %>% add(list(Theta(value=0), Theta(value=0), Theta(value=0)))
  
  expect_equal(parameters2 %>% length(), 3)
  expect_equal(parameters1, parameters2)
})

test_that("Max index on empty list works and returns an integer", {
  parameters <- Parameters()
  index <- parameters %>% maxIndex()
  expect_true(is.integer(index))
  expect_equal(index, 0)
})

test_that("Parameters encoded with locale 'French' (semi-colon used as delimiter in CSV file) can be read properly", {
  
  # Model with parameters that were saved into CSV files on laptop with locale French
  # This model correspond to advan1_trans1
  model <- read.campsis(paste0(testFolder, "custom/", "csv_locale_french"))

  # Let's compare it with original model from model library
  expect_equal(model, model_suite$testing$nonmem$advan1_trans1)
})

test_that("Standardise method works as expected", {
  
  params1 <- Parameters() %>%
    add(Omega(name="CL", value=0.2, type="sd")) %>%
    add(Omega(name="V", value=0.3^2, type="var")) %>%
    add(Omega(name="CL_V", index=1, index2=2, value=0.25, type="cor"))
  
  params2 <- Parameters() %>%
    add(Omega(name="CL", value=0.2, type="sd")) %>%
    add(Omega(name="V", value=0.3^2, type="var")) %>%
    add(Omega(name="CL_V", index=1, index2=2, value=0.015, type="covar"))
  
  params_expected <- Parameters() %>%
    add(Omega(name="CL", value=0.2^2, type="var")) %>%
    add(Omega(name="V", value=0.3^2, type="var")) %>%
    add(Omega(name="CL_V", index=1, index2=2, value=0.015, type="covar"))
  
  expect_equal(params1 %>% standardise(), params_expected)
  expect_equal(params2 %>% standardise(), params_expected)
})