aboutsummaryrefslogtreecommitdiff
path: root/R/nlme.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-02-08 17:17:29 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2022-02-08 17:17:29 +0100
commit0fa8a770812775d697717ad723f7f61fb04b7fef (patch)
tree17473ddf787541745d47dab063bc643ec59a9557 /R/nlme.R
parentd081384ddcb75a9f92fad33e4e3f6d6796f98e67 (diff)
parentc0638c84568d475b3b059e2c6e593e6f03b846bc (diff)
Merge branch 'nlmixr'
Diffstat (limited to 'R/nlme.R')
-rw-r--r--R/nlme.R26
1 files changed, 1 insertions, 25 deletions
diff --git a/R/nlme.R b/R/nlme.R
index 9215aab0..8762f137 100644
--- a/R/nlme.R
+++ b/R/nlme.R
@@ -36,7 +36,7 @@
#' nlme_f <- nlme_function(f)
#' # These assignments are necessary for these objects to be
#' # visible to nlme and augPred when evaluation is done by
-#' # pkgdown to generated the html docs.
+#' # pkgdown to generate the html docs.
#' assign("nlme_f", nlme_f, globalenv())
#' assign("grouped_data", grouped_data, globalenv())
#'
@@ -125,30 +125,6 @@ nlme_function <- function(object) {
}
#' @rdname nlme
-#' @return If random is FALSE (default), a named vector containing mean values
-#' of the fitted degradation model parameters. If random is TRUE, a list with
-#' fixed and random effects, in the format required by the start argument of
-#' nlme for the case of a single grouping variable ds.
-#' @param random Should a list with fixed and random effects be returned?
-#' @export
-mean_degparms <- function(object, random = FALSE) {
- if (nrow(object) > 1) stop("Only row objects allowed")
- parm_mat_trans <- sapply(object, parms, transformed = TRUE)
- mean_degparm_names <- setdiff(rownames(parm_mat_trans), names(object[[1]]$errparms))
- degparm_mat_trans <- parm_mat_trans[mean_degparm_names, , drop = FALSE]
- fixed <- apply(degparm_mat_trans, 1, mean)
- if (random) {
- random <- t(apply(degparm_mat_trans[mean_degparm_names, , drop = FALSE], 2, function(column) column - fixed))
- # If we only have one parameter, apply returns a vector so we get a single row
- if (nrow(degparm_mat_trans) == 1) random <- t(random)
- rownames(random) <- levels(nlme_data(object)$ds)
- return(list(fixed = fixed, random = list(ds = random)))
- } else {
- return(fixed)
- }
-}
-
-#' @rdname nlme
#' @importFrom purrr map_dfr
#' @return A \code{\link{groupedData}} object
#' @export

Contact - Imprint