aboutsummaryrefslogtreecommitdiff
path: root/R/illparms.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2023-02-13 05:19:08 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2023-02-13 05:19:08 +0100
commit8d1a84ac2190538ed3bac53a303064e281595868 (patch)
treeacb894d85ab7ec87c4911c355a5264a77e08e34b /R/illparms.R
parent51d63256a7b3020ee11931d61b4db97b9ded02c0 (diff)
parent4200e566ad2600f56bc3987669aeab88582139eb (diff)
Merge branch 'main' into custom_lsoda_call
Diffstat (limited to 'R/illparms.R')
-rw-r--r--R/illparms.R14
1 files changed, 13 insertions, 1 deletions
diff --git a/R/illparms.R b/R/illparms.R
index 01e75cf1..eef4bd33 100644
--- a/R/illparms.R
+++ b/R/illparms.R
@@ -20,6 +20,9 @@
#' @param random For hierarchical fits, should random effects be tested?
#' @param errmod For hierarchical fits, should error model parameters be
#' tested?
+#' @param slopes For hierarchical [saem] fits using saemix as backend,
+#' should slope parameters in the covariate model(starting with 'beta_') be
+#' tested?
#' @return For [mkinfit] or [saem] objects, a character vector of parameter
#' names. For [mmkin] or [mhmkin] objects, a matrix like object of class
#' 'illparms.mmkin' or 'illparms.mhmkin'.
@@ -92,7 +95,7 @@ print.illparms.mmkin <- function(x, ...) {
#' @rdname illparms
#' @export
-illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, ...) {
+illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, slopes = TRUE, ...) {
if (inherits(object$so, "try-error")) {
ill_parms <- NA
} else {
@@ -106,6 +109,15 @@ illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod
ill_parms_errmod <- ints$errmod[, "lower"] < 0 & ints$errmod[, "est."] > 0
ill_parms <- c(ill_parms, names(which(ill_parms_errmod)))
}
+ if (slopes) {
+ if (is.null(object$so)) stop("Slope testing is only implemented for the saemix backend")
+ slope_names <- grep("^beta_", object$so@model@name.fixed, value = TRUE)
+ ci <- object$so@results@conf.int
+ rownames(ci) <- ci$name
+ slope_ci <- ci[slope_names, ]
+ ill_parms_slopes <- slope_ci[, "lower"] < 0 & slope_ci[, "estimate"] > 0
+ ill_parms <- c(ill_parms, slope_names[ill_parms_slopes])
+ }
}
class(ill_parms) <- "illparms.saem.mmkin"
return(ill_parms)

Contact - Imprint