aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2020-11-05 13:56:35 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2020-11-05 14:56:10 +0100
commit2f24fe0ce70d040e491619d7f2413fc902e433f1 (patch)
tree107501081e80c5149f0a688b4cfa78b8a0f7a933
parent9298a503d8de99dad1f61d6eb8bc228dd4acce6b (diff)
Fix mean_degparms() if only one optimised parameter
-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