tests/testthat/test-meta-method.R

In latrend: A Framework for Clustering Longitudinal Data

method = lcMethodLMKM(Value ~ Assessment, id = 'Traj', time = 'Assessment', nClusters = 2)

setClass('lcMethodConv', contains = 'lcMethod')

lcMethodConv = function(
  response = 'Value',
  time = 'Assessment',
  id = 'Traj',
  nClusters = 1,
  nAttempts = 1,
  ...
) {
  mc = match.call.all()
  mc$Class = 'lcMethodConv'
  do.call(new, as.list(mc))
}

setMethod('preFit', 'lcMethodConv', function(method, data, envir, verbose) {
  convAttempts <<- 0
  callNextMethod()
})

setMethod('fit', 'lcMethodConv', function(method, data, envir, verbose) {
  convAttempts <<- convAttempts + 1
  lcModelPartition(
    data = data,
    response = method$response,
    trajectoryAssignments = rep(1, uniqueN(data[[method$id]])),
    converged = convAttempts >= method$nAttempts
  )
})


# tests ####
test_that('specify converged', {
  metaMethod = lcFitConverged(method)
  expect_s4_class(metaMethod, 'lcFitConverged')
  expect_true(has_lcMethod_args(metaMethod, 'maxRep'))
})


test_that('specify converged with maxRep', {
  metaMethod = lcFitConverged(method, maxRep = 13)
  expect_true(has_lcMethod_args(metaMethod, 'maxRep'))
  expect_equal(metaMethod$maxRep, 13)
})


test_that('meta method class', {
  metaMethod = lcFitConverged(method)

  expect_output(print(metaMethod), 'encapsulating')
  expect_output(show(metaMethod), 'encapsulating')

  expect_equal(getName(metaMethod), getName(method))
  expect_equal(getShortName(metaMethod), getShortName(method))
  expect_equal(getLabel(metaMethod), getLabel(method))
  expect_equal(getLcMethod(metaMethod), method)

  expect_equal(idVariable(metaMethod), idVariable(method))
  expect_equal(timeVariable(metaMethod), timeVariable(method))
  expect_equal(responseVariable(metaMethod), responseVariable(method))

  expect_equal(
    getCall(metaMethod),
    call('lcFitConverged', method = getCall(method), maxRep = Inf)
  )
})


test_that('meta converged fit', {
  metaMethod = lcFitConverged(mRandom)

  expect_no_warning({
    model = latrend(metaMethod, testLongData)
  })
})


test_that('meta converged fit until converged', {
  metaMethod = lcFitConverged(lcMethodConv(nAttempts = 2), maxRep = 3)

  # workaround because testthat::expect_message() is failing to capture the output...
  out = capture.output({
    model = latrend(metaMethod, testLongData, verbose = TRUE)
  }, type = 'message')
  expect_match(paste0(out, collapse = '\n'), regexp = 'attempt 2')
  expect_true(converged(model))
})


test_that('meta converged fit always fails', {
  metaMethod = lcFitConverged(lcMethodConv(nAttempts = 3), maxRep = 2)
  expect_warning({
    model = latrend(metaMethod, testLongData)
  }, regexp = 'Failed to obtain converged')

  expect_false(converged(model))
})


test_that('meta converged fit with seed on first attempt', {
  metaMethod = lcFitConverged(lcMethodConv(nAttempts = 1, seed = 13))
  model = latrend(metaMethod, testLongData)

  expect_equal(getLcMethod(model)$seed, 13)
  expect_equal(
    getCall(model),
    call(
      'latrend',
      method = call('lcFitConverged', method = getCall(getLcMethod(model)), maxRep = Inf),
      data = quote(testLongData),
      envir = NULL
    )
  )
})


test_that('meta converged fit different seed on second attempt', {
  metaMethod = lcFitConverged(lcMethodConv(nAttempts = 2, seed = 13))
  model = latrend(metaMethod, testLongData)

  expect_true(getLcMethod(model)$seed != 13)
  expect_equal(
    getCall(model),
    call(
      'latrend',
      method = getCall(metaMethod),
      data = quote(testLongData),
      envir = NULL
    )
  )
})


test_that('meta update passthrough', {
  metaMethod = lcFitConverged(lcMethodLMKM(Value ~ Assessment, nClusters = 2), maxRep = 2)
  model = latrend(metaMethod, data = testLongData, nClusters = 3)

  expect_equal(nClusters(model), 3L)
})