diff --git a/NAMESPACE b/NAMESPACE index 021bd645..831140ee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,33 +1,26 @@ # Generated by roxygen2: do not edit by hand S3method("[",lcModels) -S3method(as.data.frame,lcMethod) +S3method(R.utils::evaluate,lcMethod) S3method(as.data.frame,lcMethods) S3method(as.data.frame,lcModels) -S3method(as.list,lcMethod) S3method(as.list,lcModels) -S3method(coef,lcModel) +S3method(base::as.character,lcMetaMethod) +S3method(base::as.character,lcMethod) +S3method(base::as.data.frame,lcMethod) +S3method(base::as.list,lcMethod) +S3method(base::merge,formula) +S3method(base::print,lcMethod) S3method(coef,lcModelCrimCV) S3method(coef,lcModelFlexmix) S3method(coef,lcModelFunFEM) S3method(coef,lcModelLMKM) -S3method(coef,lcModelMixAK_GLMM) S3method(coef,lcModelMixTVEM) S3method(coef,lcModelMixtoolsGMM) -S3method(deviance,lcModel) -S3method(deviance,lcModelMixAK_GLMM) -S3method(df.residual,lcModel) -S3method(evaluate,lcMethod) S3method(fitted,lcApproxModel) -S3method(fitted,lcModel) S3method(fitted,lcModelFlexmix) S3method(fitted,lcModelFunFEM) S3method(fitted,lcModelLcmmGMM) -S3method(formula,lcMethod) -S3method(formula,lcModel) -S3method(getCall,lcMetaMethod) -S3method(getCall,lcMethod) -S3method(getCall,lcModel) S3method(logLik,lcModel) S3method(logLik,lcModelCrimCV) S3method(logLik,lcModelFlexmix) @@ -41,25 +34,39 @@ S3method(logLik,lcModelMixtoolsRM) S3method(max,lcModels) S3method(min,lcModels) S3method(model.data,lcModel) -S3method(model.frame,lcModel) S3method(model.matrix,lcModelLcmmGMM) -S3method(nobs,lcModel) S3method(nobs,lcModelLcmmGMM) -S3method(predict,lcModel) S3method(predict,lcModelMixTVEM) -S3method(print,lcMethod) S3method(print,lcModels) -S3method(residuals,lcModel) -S3method(sigma,lcModel) S3method(sigma,lcModelLcmmGMM) S3method(sigma,lcModelMixTVEM) S3method(sigma,lcModelMixtoolsGMM) +S3method(stats::coef,GLMM_MCMC) +S3method(stats::coef,lcModel) +S3method(stats::coef,lcModelMixAK_GLMM) +S3method(stats::coef,lcModelMixAK_GLMMlist) +S3method(stats::deviance,GLMM_MCMC) +S3method(stats::deviance,lcModel) +S3method(stats::deviance,lcModelMixAK_GLMM) +S3method(stats::deviance,lcModelMixAK_GLMMlist) +S3method(stats::df.residual,lcModel) +S3method(stats::fitted,lcModel) +S3method(stats::formula,lcMethod) +S3method(stats::formula,lcModel) +S3method(stats::getCall,lcMetaMethod) +S3method(stats::getCall,lcMethod) +S3method(stats::getCall,lcModel) +S3method(stats::model.frame,lcModel) +S3method(stats::nobs,lcModel) +S3method(stats::predict,lcModel) +S3method(stats::residuals,lcModel) +S3method(stats::sigma,lcModel) +S3method(stats::time,lcModel) +S3method(stats::update,lcMetaMethod) +S3method(stats::update,lcModel) S3method(subset,lcModels) S3method(summary,lcModel) -S3method(time,lcModel) -S3method(update,lcMetaMethod) S3method(update,lcMethod) -S3method(update,lcModel) export("clusterNames<-") export(APPA) export(OCC) @@ -262,13 +269,6 @@ importFrom(stats,getCall) importFrom(stats,logLik) importFrom(stats,mahalanobis) importFrom(stats,model.frame) -importFrom(stats,model.matrix) -importFrom(stats,nobs) -importFrom(stats,predict) -importFrom(stats,residuals) -importFrom(stats,sigma) -importFrom(stats,time) -importFrom(stats,update) importFrom(stats,weighted.mean) importFrom(utils,capture.output) importFrom(utils,combn) diff --git a/R/formula.R b/R/formula.R index 58fddced..1c457686 100644 --- a/R/formula.R +++ b/R/formula.R @@ -2,6 +2,7 @@ is.formula = function(x) { inherits(x, 'formula') } + hasResponse = function(f) { if (is.formula(f)) { tt = terms(f) @@ -11,6 +12,7 @@ hasResponse = function(f) { attr(tt, 'response') != 0 } + hasIntercept = function(f) { if (is.formula(f)) { tt = terms(f) @@ -20,10 +22,12 @@ hasIntercept = function(f) { attr(tt, 'intercept') != 0 } + hasSingleResponse = function(f) { hasResponse(f) && length(getResponse(f)) == 1 } + getResponse = function(f) { if (hasResponse(f)) { update(f, . ~ 1) %>% all.vars() @@ -33,22 +37,26 @@ getResponse = function(f) { } } + getREterms = function(f) { .loadOptionalPackage('lme4') terms = lme4::findbars(f) } + REtermAsFormula = function(term) { assert_that(is.call(term)) assert_that(!is.formula(term)) as.character(term)[2] %>% reformulate } + getREGroupName = function(term) { assert_that(is.call(term)) as.character(term)[3] } + getCovariates = function(f) { if(is.null(f)) { character() @@ -57,14 +65,17 @@ getCovariates = function(f) { } } + hasCovariates = function(f) { length(getCovariates(f)) > 0 } + hasRE = function(f) { length(getREterms(f)) > 0 } + addInteraction = function(f, var) { assert_that(is.formula(f)) assert_that(is.character(var)) @@ -91,6 +102,8 @@ addInteraction = function(f, var) { } } + +#' @exportS3Method base::merge merge.formula = function(x, y, ...) { assert_that(is.formula(x)) assert_that(is.formula(y)) @@ -115,6 +128,7 @@ merge.formula = function(x, y, ...) { } } + dropResponse = function(f) { if (hasResponse(f)) { update(f, NULL ~ .) @@ -123,6 +137,7 @@ dropResponse = function(f) { } } + dropIntercept = function(f) { if (hasIntercept(f)) { update(f, ~ .+-1) @@ -131,6 +146,7 @@ dropIntercept = function(f) { } } + #' @noRd #' @importFrom stats drop.terms #' @title Drop random-effects component from a formula @@ -184,6 +200,7 @@ getSpecialTerms = function(f, special) { vapply(deparse, FUN.VALUE = '') } + #' @noRd #' @title Get special terms as formula #' @details An intercept is added unless the formula contains a special removing it, e.g. time(0) @@ -203,6 +220,7 @@ getSpecialFormula = function(f, special) { } } + dropSpecial = function(f, special) { assert_that(is.scalar(special)) tt = terms(f, specials = special) diff --git a/R/meta-method.R b/R/meta-method.R index 8963dcd5..63d9e4f4 100644 --- a/R/meta-method.R +++ b/R/meta-method.R @@ -19,6 +19,8 @@ setClass( slots = c(method = 'lcMethod') ) + +#' @exportS3Method base::as.character as.character.lcMetaMethod = function(x, ...) { c( sprintf('%s encapsulating:', class(x)[1]), @@ -28,7 +30,8 @@ as.character.lcMetaMethod = function(x, ...) { ) } -#' @export + +#' @exportS3Method stats::getCall getCall.lcMetaMethod = function(x, ...) { do.call( call, @@ -42,6 +45,7 @@ getCall.lcMetaMethod = function(x, ...) { ) } + #' @export #' @rdname interface-metaMethods setMethod('compose', 'lcMetaMethod', function(method, envir = NULL) { @@ -50,6 +54,7 @@ setMethod('compose', 'lcMetaMethod', function(method, envir = NULL) { newMethod }) + #' @export #' @rdname interface-metaMethods setMethod('getLcMethod', 'lcMetaMethod', function(object, ...) { @@ -60,49 +65,67 @@ setMethod('getLcMethod', 'lcMetaMethod', function(object, ...) { object@method }) + #' @export #' @rdname interface-metaMethods -setMethod('getName', 'lcMetaMethod', function(object, ...) getName(getLcMethod(object), ...)) +setMethod('getName', 'lcMetaMethod', + function(object, ...) getName(getLcMethod(object), ...) +) + #' @export #' @rdname interface-metaMethods -setMethod('getShortName', 'lcMetaMethod', function(object, ...) getShortName(getLcMethod(object), ...)) +setMethod('getShortName', 'lcMetaMethod', + function(object, ...) getShortName(getLcMethod(object), ...) +) + #' @export #' @rdname interface-metaMethods setMethod('idVariable', 'lcMetaMethod', function(object, ...) idVariable(getLcMethod(object), ...)) + #' @export #' @rdname interface-metaMethods setMethod('preFit', 'lcMetaMethod', function(method, data, envir, verbose) { preFit(getLcMethod(method), data = data, envir = envir, verbose = verbose) }) + #' @export #' @rdname interface-metaMethods setMethod('prepareData', 'lcMetaMethod', function(method, data, verbose) { prepareData(getLcMethod(method), data = data, verbose = verbose) }) + #' @export #' @rdname interface-metaMethods setMethod('fit', 'lcMetaMethod', function(method, data, envir, verbose) { fit(getLcMethod(method), data = data, envir = envir, verbose = verbose) }) + #' @export #' @rdname interface-metaMethods setMethod('postFit', 'lcMetaMethod', function(method, data, model, envir, verbose) { postFit(getLcMethod(method), data = data, model = model, envir = envir, verbose = verbose) }) + #' @export #' @rdname interface-metaMethods -setMethod('responseVariable', 'lcMetaMethod', function(object, ...) responseVariable(getLcMethod(object), ...)) +setMethod('responseVariable', 'lcMetaMethod', + function(object, ...) responseVariable(getLcMethod(object), ...) +) + #' @export #' @rdname interface-metaMethods -setMethod('timeVariable', 'lcMetaMethod', function(object, ...) timeVariable(getLcMethod(object), ...)) +setMethod('timeVariable', 'lcMetaMethod', + function(object, ...) timeVariable(getLcMethod(object), ...) +) + #' @export #' @rdname interface-metaMethods @@ -110,7 +133,8 @@ setMethod('validate', 'lcMetaMethod', function(method, data, envir = NULL, ...) validate(getLcMethod(method), data = data, envir = envir, ...) }) -#' @export + +#' @exportS3Method stats::update #' @rdname interface-metaMethods #' @inheritParams update.lcMethod update.lcMetaMethod = function(object, ...) { diff --git a/R/method.R b/R/method.R index 5454bc8d..1b66b28b 100644 --- a/R/method.R +++ b/R/method.R @@ -287,6 +287,7 @@ as.lcMethod = function(x, ..., envir = parent.frame()) { } +#' @exportS3Method base::as.character as.character.lcMethod = function(x, ..., eval = FALSE, width = 40, prefix = '', envir = NULL) { assert_that( is.lcMethod(x), @@ -333,7 +334,7 @@ as.character.lcMethod = function(x, ..., eval = FALSE, width = 40, prefix = '', } -#' @export +#' @exportS3Method base::as.list #' @title Extract the method arguments as a list #' @param x The `lcMethod` object. #' @param ... Additional arguments. @@ -400,7 +401,7 @@ as.list.lcMethod = function(x, ..., args = names(x), eval = TRUE, expand = FALSE } -#' @export +#' @exportS3Method base::as.data.frame #' @title Convert lcMethod arguments to a list of atomic types #' @description Converts the arguments of a `lcMethod` to a named `list` of [atomic] types. #' @inheritParams as.list.lcMethod @@ -557,7 +558,7 @@ setMethod('fit', 'lcMethod', function(method, data, envir, verbose) { }) -#' @export +#' @exportS3Method stats::formula #' @title Extract formula #' @description Extracts the associated `formula` for the given distributional parameter. #' @inheritParams as.list.lcMethod @@ -589,7 +590,7 @@ formula.lcMethod = function(x, what = 'mu', envir = NULL, ...) { -#' @export +#' @exportS3Method stats::getCall getCall.lcMethod = function(x, ...) { assert_that(is.lcMethod(x)) do.call(call, c(class(x)[1], eapply(x@arguments, enquote))) @@ -933,7 +934,7 @@ setMethod('postFit', 'lcMethod', function(method, data, model, envir, verbose) { }) -#' @export +#' @exportS3Method base::print #' @title Print the arguments of an lcMethod object #' @param x The `lcMethod` object. #' @param eval Whether to print the evaluated argument values. @@ -946,8 +947,8 @@ print.lcMethod = function(x, ..., eval = FALSE, width = 40, envir = NULL) { } +#' @exportS3Method R.utils::evaluate #' @importFrom R.utils evaluate -#' @export #' @title Substitute the call arguments for their evaluated values #' @description Substitutes the call arguments if they can be evaluated without error. #' @inheritParams as.list.lcMethod diff --git a/R/model.R b/R/model.R index 3985361c..f86fb13e 100644 --- a/R/model.R +++ b/R/model.R @@ -1,5 +1,4 @@ #' @include method.R trajectories.R latrend.R -#' @importFrom stats coef deviance df.residual getCall logLik model.frame model.matrix predict residuals sigma time update # Model #### #' @name lcModel @@ -316,7 +315,7 @@ setMethod('clusterProportions', 'lcModel', function(object, ...) { }) -#' @export +#' @exportS3Method stats::coef #' @importFrom stats coef #' @title Extract lcModel coefficients #' @description Extract the coefficients of the `lcModel` object, if defined. @@ -377,7 +376,7 @@ setMethod('converged', 'lcModel', function(object, ...) { }) -#' @export +#' @exportS3Method stats::deviance #' @importFrom stats deviance #' @title lcModel deviance #' @description Get the deviance of the fitted `lcModel` object. @@ -399,7 +398,7 @@ deviance.lcModel = function(object, ...) { } -#' @export +#' @exportS3Method stats::df.residual #' @importFrom stats df.residual #' @title Extract the residual degrees of freedom from a lcModel #' @param object The `lcModel` object. @@ -474,7 +473,7 @@ setMethod('externalMetric', c('lcModel', 'lcModel'), function(object, object2, n }) -#' @export +#' @exportS3Method stats::fitted #' @importFrom stats fitted #' @title Extract lcModel fitted values #' @description Returns the cluster-specific fitted values for the given `lcModel` object. @@ -579,7 +578,7 @@ setMethod('fittedTrajectories', 'lcModel', function(object, at, what, clusters, }) -#' @export +#' @exportS3Method stats::formula #' @importFrom stats formula #' @title Extract the formula of a lcModel #' @description Get the formula associated with the fitted `lcModel` object. @@ -613,7 +612,7 @@ formula.lcModel = function(x, what = 'mu', ...) { } -#' @export +#' @exportS3Method stats::getCall #' @importFrom stats getCall #' @title Get the model call #' @description Extract the `call` that was used to fit the given `lcModel` object. @@ -785,7 +784,7 @@ setMethod('metric', 'lcModel', function(object, name, ...) { }) -#' @export +#' @exportS3Method stats::model.frame #' @importFrom stats model.frame #' @title Extract model training data #' @description See [stats::model.frame()] for more details. @@ -923,8 +922,7 @@ setMethod('nClusters', 'lcModel', function(object, ...) { }) -#' @export -#' @importFrom stats nobs +#' @exportS3Method stats::nobs #' @title Number of observations used for the lcModel fit #' @description Extracts the number of observations that contributed information towards fitting the cluster trajectories of the respective `lcModel` object. #' Therefore, only non-missing response observations count towards the number of observations. @@ -951,9 +949,8 @@ nobs.lcModel = function(object, ...) { } -#' @export +#' @exportS3Method stats::predict #' @rdname predict.lcModel -#' @importFrom stats predict #' @title lcModel predictions #' @description Predicts the expected trajectory observations at the given time for each cluster. #' @section Implementation: @@ -1553,8 +1550,7 @@ setMethod('qqPlot', 'lcModel', function(object, byCluster = FALSE, ...) { }) -#' @export -#' @importFrom stats residuals +#' @exportS3Method stats::residuals #' @title Extract lcModel residuals #' @description Extract the residuals for a fitted `lcModel` object. #' By default, residuals are computed under the most likely cluster assignment for each trajectory. @@ -1631,8 +1627,7 @@ setMethod('show', 'lcModel', function(object) { }) -#' @export -#' @importFrom stats sigma +#' @exportS3Method stats::sigma #' @title Extract residual standard deviation from a lcModel #' @description Extracts or estimates the residual standard deviation. If [sigma()] is not defined for a model, it is estimated from the residual error vector. #' @param object The `lcModel` object. @@ -1703,8 +1698,7 @@ setMethod('strip', 'lcModel', function(object, ..., classes = 'formula') { setMethod('timeVariable', 'lcModel', function(object) object@time) -#' @export -#' @importFrom stats time +#' @exportS3Method stats::time #' @title Sampling times of a lcModel #' @description Extract the sampling times on which the `lcModel` was fitted. #' @param x The `lcModel` object. @@ -1803,8 +1797,7 @@ setMethod('trajectoryAssignments', 'lcModel', function(object, strategy = which. }) -#' @export -#' @importFrom stats update +#' @exportS3Method stats::update #' @title Update a lcModel #' @description Fit a new model with modified arguments from the current model. #' @param object The `lcModel` object. diff --git a/R/modelMixAK_GLMM.R b/R/modelMixAK_GLMM.R index 253b28cf..f575d09c 100644 --- a/R/modelMixAK_GLMM.R +++ b/R/modelMixAK_GLMM.R @@ -18,9 +18,11 @@ setMethod('postprob', 'lcModelMixAK_GLMM', function(object, ...) { #. predictForCluster #### #' @rdname interface-mixAK #' @inheritParams predictForCluster -setMethod('predictForCluster', 'lcModelMixAK_GLMM', function(object, newdata, cluster, what = 'mu', ...) { - predictForCluster(object@model, cluster = cluster, newdata = newdata, what = what, ...) -}) +setMethod('predictForCluster', 'lcModelMixAK_GLMM', + function(object, newdata, cluster, what = 'mu', ...) { + predictForCluster(object@model, cluster = cluster, newdata = newdata, what = what, ...) + } +) .predictForCluster_GLMM_MCMC = function(model, method, k, newdata, ...) { assert_that( @@ -42,34 +44,45 @@ setMethod('predictForCluster', 'lcModelMixAK_GLMM', function(object, newdata, cl pred[, k] } + #' @rdname interface-mixAK -setMethod('predictForCluster', 'lcModelMixAK_GLMM', function(object, newdata, cluster, what = 'mu', ...) { - .predictForCluster_GLMM_MCMC(object@model, - method = getLcMethod(object), - k = match(cluster, clusterNames(object)), - newdata = newdata, - ...) -}) +setMethod('predictForCluster', 'lcModelMixAK_GLMM', + function(object, newdata, cluster, what = 'mu', ...) { + .predictForCluster_GLMM_MCMC( + object@model, + method = getLcMethod(object), + k = match(cluster, clusterNames(object)), + newdata = newdata, + ... + ) + } +) + -#' @export +#' @exportS3Method stats::coef #' @rdname interface-mixAK #' @param stat The aggregate statistic to extract. The mean is used by default. coef.lcModelMixAK_GLMM = function(object, ..., stat = 'Mean') { coef(object@model, stat = stat) } + +#' @exportS3Method stats::coef coef.GLMM_MCMC = function(object, ..., stat = 'Mean') { c(object$summ.b.Mean[stat, ], object$summ.b.SDCorr[stat, ], sigma_eps = unname(object$summ.sigma_eps[stat])) } -#' @export + +#' @exportS3Method stats::deviance #' @rdname interface-mixAK deviance.lcModelMixAK_GLMM = function(object, ...) { deviance(object@model) } + +#' @exportS3Method stats::deviance deviance.GLMM_MCMC = function(object, ...) { mean(object$Deviance) } diff --git a/R/modelMixAK_GLMMlist.R b/R/modelMixAK_GLMMlist.R index 5e6e3b97..05e5d41b 100644 --- a/R/modelMixAK_GLMMlist.R +++ b/R/modelMixAK_GLMMlist.R @@ -10,22 +10,34 @@ setMethod('postprob', 'lcModelMixAK_GLMMlist', function(object, ...) { }) #' @rdname interface-mixAK -setMethod('predictForCluster', 'lcModelMixAK_GLMMlist', function(object, newdata, cluster, what = 'mu', ...) { +setMethod('predictForCluster', 'lcModelMixAK_GLMMlist', function( + object, newdata, cluster, what = 'mu', ... +) { models = getGLMM_MCMCs(object) k = match(cluster, clusterNames(object)) - Reduce('+', lapply(models, .predictForCluster_GLMM_MCMC, - k = k, - method = getLcMethod(object), - newdata = newdata, ...)) / length(models) + Reduce( + '+', + lapply( + models, + .predictForCluster_GLMM_MCMC, + k = k, + method = getLcMethod(object), + newdata = newdata, + ... + ) + ) / length(models) }) +#' @exportS3Method stats::coef coef.lcModelMixAK_GLMMlist = function(object, ...) { models = getGLMM_MCMCs(object) Reduce('+', lapply(models, coef, ...)) / length(models) } + +#' @exportS3Method stats::deviance deviance.lcModelMixAK_GLMMlist = function(object) { models = getGLMM_MCMCs(object) Reduce('+', lapply(models, deviance)) / length(models) diff --git a/man/latrend-generics.Rd b/man/latrend-generics.Rd index 7d7685d7..c640d6a6 100644 --- a/man/latrend-generics.Rd +++ b/man/latrend-generics.Rd @@ -81,9 +81,9 @@ trajectoryAssignments(object, ...) validate(method, data, envir, ...) -\S4method{getName}{`NULL`}(object, ...) +\S4method{getName}{NULL}(object, ...) -\S4method{getShortName}{`NULL`}(object, ...) +\S4method{getShortName}{NULL}(object, ...) } \arguments{ \item{object}{The object.} diff --git a/man/latrend-package.Rd b/man/latrend-package.Rd index edb5677a..cff8e8ad 100644 --- a/man/latrend-package.Rd +++ b/man/latrend-package.Rd @@ -3,7 +3,6 @@ \docType{package} \name{latrend-package} \alias{latrend-package} -\alias{_PACKAGE} \title{latrend: A Framework for Clustering Longitudinal Data} \description{ A framework for clustering longitudinal datasets in a standardized way. The package provides an interface to existing R packages for clustering longitudinal univariate trajectories, facilitating reproducible and transparent analyses. Additionally, standard tools are provided to support cluster analyses, including repeated estimation, model validation, and model assessment. The interface enables users to compare results between methods, and to implement and evaluate new methods with ease. The 'akmedoids' package is available from \url{https://github.com/MAnalytics/akmedoids}. diff --git a/man/transformFitted.Rd b/man/transformFitted.Rd index e562e01c..73d9bf99 100644 --- a/man/transformFitted.Rd +++ b/man/transformFitted.Rd @@ -10,7 +10,7 @@ \usage{ transformFitted(pred, model, clusters) -\S4method{transformFitted}{`NULL`,lcModel}(pred, model, clusters = NULL) +\S4method{transformFitted}{NULL,lcModel}(pred, model, clusters = NULL) \S4method{transformFitted}{matrix,lcModel}(pred, model, clusters = NULL) diff --git a/man/transformPredict.Rd b/man/transformPredict.Rd index 6c0e2422..fcf167cf 100644 --- a/man/transformPredict.Rd +++ b/man/transformPredict.Rd @@ -10,7 +10,7 @@ \usage{ transformPredict(pred, model, newdata) -\S4method{transformPredict}{`NULL`,lcModel}(pred, model, newdata) +\S4method{transformPredict}{NULL,lcModel}(pred, model, newdata) \S4method{transformPredict}{vector,lcModel}(pred, model, newdata)