options(deparse.max.lines=5)
options(latrend.id = 'Traj')
options(latrend.time = 'Assessment')
options(latrend.verbose = R.utils::Verbose())
options(latrend.warnModelDataClusterColumn = FALSE)
options(latrend.warnNewDataClusterColumn = FALSE)
options(latrend.warnTrajectoryLength = 0)
DEFAULT_LATREND_TESTS = c('method', 'basic', 'fitted', 'predict', 'cluster-single', 'cluster-three', 'data-na', 'data-varlen')
foreach::registerDoSEQ()
# remove kml cld file from possible previous failed run
if (file.exists('cld.Rdata')) {
file.remove('cld.Rdata')
}
# one of the cluster methods is altering the RNG kind, so reset it for each context
rngReset = function() {
RNGkind('Mersenne-Twister', 'Inversion', 'Rejection')
}
mixt_file = file.path('..', '..', 'MixTVEM.R')
if(file.exists(mixt_file)) {
source(mixt_file)
}
expect_valid_lcModel = function(object) {
expect_s4_class(object, 'lcModel')
expect_true(is.count(nClusters(object)))
# clusters
# change cluster names to ensure the model implementations correctly handle this
clusNames = paste0('T', seq_len(nClusters(object)))
clusterNames(object) = clusNames
expect_is(clusterNames(object), 'character')
expect_length(clusterNames(object), nClusters(object))
expect_equal(clusterNames(object), clusNames)
expect_is(clusterSizes(object), 'integer')
expect_true(all(clusterSizes(object) >= 0))
expect_is(clusterProportions(object), 'numeric')
expect_gte(min(clusterProportions(object)), 0)
expect_lte(max(clusterProportions(object)), 1)
expect_is(getCall(object), 'call')
expect_is(getName(object), 'character')
expect_is(getShortName(object), 'character')
expect_is(idVariable(object), 'character')
expect_is(timeVariable(object), 'character')
expect_is(responseVariable(object), 'character')
expect_is(coef(object), c('numeric', 'matrix', 'list', 'NULL'), label='coef')
expect_is(converged(object), c('logical', 'numeric', 'integer'), label='converged')
expect_true(is.count(nobs(object)))
expect_true(is.count(nIds(object)))
expect_length(ids(object), nIds(object))
expect_true(is.numeric(time(object)))
expect_gt(length(time(object)), 0)
expect_is(deviance(object), 'numeric')
expect_true(is.numeric(df.residual(object)))
expect_is(logLik(object), 'logLik')
expect_is(sigma(object), 'numeric')
expect_gte(estimationTime(object), 0)
expect_is(formula(object), 'formula')
# model.data
expect_is(model.data(object), 'data.frame')
expect_true(has_name(model.data(object), c(
idVariable(object),
timeVariable(object),
responseVariable(object))))
# Posterior
pp = postprob(object)
expect_true(is_valid_postprob(pp, object))
clus = trajectoryAssignments(object)
expect_is(clus, 'factor')
expect_length(clus, nIds(object))
expect_gte(min(as.integer(clus)), 1)
expect_lte(max(as.integer(clus)), nIds(object))
# Predict
# cluster-specific prediction
pred = predict(object, newdata=data.frame(Cluster='T1', Assessment=time(object)[c(1,3)]))
expect_is(pred, 'data.frame', info='predictClusterTime')
expect_true('Fit' %in% names(pred), info='predictClusterTime')
expect_equal(nrow(pred), 2, info='predictClusterTime')
# prediction for all clusters; list of data.frames
pred2 = predict(object, newdata=data.frame(Assessment=time(object)[c(1,3)]))
expect_is(pred2, 'list', info='predictTime')
expect_length(pred2, nClusters(object))
expect_true('Fit' %in% names(pred2$T1), info='predictTime')
# id-specific prediction for a specific cluster; data.frame
pred3 = predict(object, newdata=data.frame(Cluster=rep('T1', 4),
Traj=c(ids(object)[c(1,1,2)], tail(ids(object), 1)),
Assessment=c(time(object)[c(1,3,1,1)])))
expect_is(pred3, 'data.frame', info='predictClusterIdTime')
expect_true('Fit' %in% names(pred3), info='predictClusterIdTime')
expect_equal(nrow(pred3), 4, info='predictClusterIdTime')
# id-specific prediction for all clusters; list of data.frames
pred4 = predict(object, newdata=data.frame(Traj=c(ids(object)[c(1,1,2)], tail(ids(object), 1)),
Assessment=c(time(object)[c(1,3,1,1)])))
expect_is(pred4, 'list', info='predictIdTime')
expect_length(pred4, nClusters(object))
expect_true('Fit' %in% names(pred4$T1), info='predictIdTime')
fitted(object, clusters=trajectoryAssignments(object)) %>%
expect_is(c('NULL', 'numeric'), info='fittedClusters')
fitted(object, clusters=NULL) %>%
expect_is(c('NULL', 'matrix'), info='fittedNull')
predNul = predict(object, newdata=NULL)
expect_is(predNul, 'list', info='predictNull')
expect_length(predNul, nClusters(object))
expect_true('Fit' %in% names(predNul$T1), info='predictNull')
# predictForCluster
predClus = predictForCluster(
object,
newdata = data.frame(Assessment = time(object)[c(1,3)]),
cluster = 'T1'
)
expect_is(predClus, 'numeric', info='predictForCluster')
expect_length(predClus, 2)
# empty predictForCluster prediction
predClusNull = predictForCluster(object, cluster = 'T1')
predClusNull2 = predictForCluster(object, newdata = NULL, cluster = 'T1')
predClusFitted = predictForCluster(object, newdata = model.data(object), cluster = 'T1')
expect_equal(predClusNull, predClusNull2)
expect_equal(predClusNull2, predClusFitted)
residuals(object, clusters=trajectoryAssignments(object)) %>%
expect_is(c('NULL', 'numeric'), label='residuals')
residuals(object, clusters=NULL) %>%
expect_is(c('NULL', 'matrix'), label='residuals')
# Derivative predict
ctPred = clusterTrajectories(object)
expect_is(ctPred, 'data.frame', label='clusterTrajectories')
fittedTrajectories(object) %>%
expect_is(c('NULL', 'data.frame'), label='fittedTrajectories')
trajectories(object) %>%
expect_is('data.frame', label='trajectories')
if (requireNamespace('ggplot2', quietly = TRUE)) {
expect_true(is.ggplot(plot(object)))
}
# Misc
summary(object) %>%
expect_is('lcSummary')
expect_output(print(object))
newObject = strip(object)
expect_is(newObject, class(object))
return(object)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.