From 7777ff3b019e54364947ff393e2dab782d7cfe3c Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Fri, 10 Apr 2020 08:26:44 +0200
Subject: Improve nlme function docs

---
 R/nlme.R | 67 ++++++++++++++++++++++++++++++++--------------------------------
 1 file changed, 33 insertions(+), 34 deletions(-)

(limited to 'R')

diff --git a/R/nlme.R b/R/nlme.R
index b17fe15a..79e4e9c1 100644
--- a/R/nlme.R
+++ b/R/nlme.R
@@ -1,14 +1,12 @@
 #' Estimation of parameter distributions from mmkin row objects
 #'
-#' This function sets up and attempts to fit a mixed effects model to
+#' These functions facilitate setting up a nonlinear mixed effects model for
 #' an mmkin row object. An mmkin row object is essentially a list of mkinfit
 #' objects that have been obtained by fitting the same model to a list of
 #' datasets.
 #'
 #' @param object An mmkin row object containing several fits of the same model to different datasets
 #' @import nlme
-#' @importFrom purrr map_dfr
-#' @return A named vector containing mean values of the fitted degradation model parameters
 #' @rdname nlme
 #' @examples
 #' sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)
@@ -45,7 +43,7 @@
 #' summary(m_nlme)
 #'
 #' \dontrun{
-#'   Test on some real data
+#'   # Test on some real data
 #'   ds_2 <- lapply(experimental_data_for_UBA_2019[6:10],
 #'    function(x) x$data[c("name", "time", "value")])
 #'   m_sfo_sfo <- mkinmod(parent = mkinsub("SFO", "A1"),
@@ -113,36 +111,7 @@
 #'
 #'   anova(f_nlme_fomc_sfo, f_nlme_sfo_sfo)
 #' }
-#' @export
-mean_degparms <- function(object) {
-  if (nrow(object) > 1) stop("Only row objects allowed")
-  p_mat_start_trans <- sapply(object, parms, transformed = TRUE)
-  mean_degparm_names <- setdiff(rownames(p_mat_start_trans), names(object[[1]]$errparms))
-  res <- apply(p_mat_start_trans[mean_degparm_names, ], 1, mean)
-  return(res)
-}
-
-#' @rdname nlme
-#' @importFrom purrr map_dfr
-#' @return A groupedData data object
-#' @export
-nlme_data <- function(object) {
-  if (nrow(object) > 1) stop("Only row objects allowed")
-  ds_names <- colnames(object)
-
-  ds_list <- lapply(object, function(x) x$data[c("time", "variable", "observed")])
-  names(ds_list) <- ds_names
-  ds_nlme <- purrr::map_dfr(ds_list, function(x) x, .id = "ds")
-  ds_nlme$variable <- as.character(ds_nlme$variable)
-  ds_nlme_renamed <- data.frame(ds = ds_nlme$ds, name = ds_nlme$variable,
-    time = ds_nlme$time, value = ds_nlme$observed,
-    stringsAsFactors = FALSE)
-  ds_nlme_grouped <- groupedData(value ~ time | ds, ds_nlme_renamed)
-  return(ds_nlme_grouped)
-}
-
-#' @rdname nlme
-#' @return A function that can be used with nlme
+#' @return A function that can be used with \code{link{nlme}}
 #' @export
 nlme_function <- function(object) {
   if (nrow(object) > 1) stop("Only row objects allowed")
@@ -211,3 +180,33 @@ nlme_function <- function(object) {
   model_function <- as.function(c(model_function_alist, model_function_body))
   return(model_function)
 }
+
+#' @rdname nlme
+#' @return A named vector containing mean values of the fitted degradation model parameters
+#' @export
+mean_degparms <- function(object) {
+  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))
+  res <- apply(degparm_mat_trans[mean_degparm_names, ], 1, mean)
+  return(res)
+}
+
+#' @rdname nlme
+#' @importFrom purrr map_dfr
+#' @return A \code{\link{groupedData}} object
+#' @export
+nlme_data <- function(object) {
+  if (nrow(object) > 1) stop("Only row objects allowed")
+  ds_names <- colnames(object)
+
+  ds_list <- lapply(object, function(x) x$data[c("time", "variable", "observed")])
+  names(ds_list) <- ds_names
+  ds_nlme <- purrr::map_dfr(ds_list, function(x) x, .id = "ds")
+  ds_nlme$variable <- as.character(ds_nlme$variable)
+  ds_nlme_renamed <- data.frame(ds = ds_nlme$ds, name = ds_nlme$variable,
+    time = ds_nlme$time, value = ds_nlme$observed,
+    stringsAsFactors = FALSE)
+  ds_nlme_grouped <- groupedData(value ~ time | ds, ds_nlme_renamed)
+  return(ds_nlme_grouped)
+}
-- 
cgit v1.2.1