aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/nlme.R12
1 files changed, 7 insertions, 5 deletions
diff --git a/R/nlme.R b/R/nlme.R
index e2184ae1..8810fab3 100644
--- a/R/nlme.R
+++ b/R/nlme.R
@@ -134,12 +134,14 @@ nlme_function <- function(object) {
#' @export
mean_degparms <- function(object, random = FALSE) {
if (nrow(object) > 1) stop("Only row objects allowed")
- degparm_mat_trans <- sapply(object, parms, transformed = TRUE)
- mean_degparm_names <- setdiff(rownames(degparm_mat_trans), names(object[[1]]$errparms))
- fixed <- apply(degparm_mat_trans[mean_degparm_names, ], 1, mean)
+ 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) {
- degparm_mat_trans[mean_degparm_names, ]
- random <- t(apply(degparm_mat_trans[mean_degparm_names, ], 2, function(column) column - fixed))
+ 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 {

Contact - Imprint