From 4c868d65be04c8ee3fedc89d28d0e7d8c5da05e0 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 28 Oct 2022 10:31:16 +0200 Subject: Rename 'convergence' method to 'status' The reason is that it is misleading in the case of saem.mmkin objects, because convergence is not really checked there. --- NAMESPACE | 15 ++++++----- R/convergence.R | 71 ---------------------------------------------------- R/mhmkin.R | 9 +++---- R/mmkin.R | 2 +- R/multistart.R | 12 ++++----- R/status.R | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++ R/summary.mmkin.R | 8 +++--- man/convergence.Rd | 39 ----------------------------- man/status.Rd | 38 ++++++++++++++++++++++++++++ man/summary.mmkin.Rd | 2 +- 10 files changed, 131 insertions(+), 135 deletions(-) delete mode 100644 R/convergence.R create mode 100644 R/status.R delete mode 100644 man/convergence.Rd create mode 100644 man/status.Rd diff --git a/NAMESPACE b/NAMESPACE index 8ffa0425..37b6c74d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,10 +13,6 @@ S3method(aw,mmkin) S3method(aw,multistart) S3method(best,default) S3method(confint,mkinfit) -S3method(convergence,mhmkin) -S3method(convergence,mmkin) -S3method(convergence,multistart) -S3method(convergence,multistart.saem.mmkin) S3method(f_time_norm_focus,mkindsg) S3method(f_time_norm_focus,numeric) S3method(illparms,mhmkin) @@ -44,9 +40,6 @@ S3method(plot,mixed.mmkin) S3method(plot,mkinfit) S3method(plot,mmkin) S3method(plot,nafta) -S3method(print,convergence.mhmkin) -S3method(print,convergence.mmkin) -S3method(print,convergence.multistart) S3method(print,illparms.mhmkin) S3method(print,illparms.mmkin) S3method(print,mhmkin) @@ -59,12 +52,18 @@ S3method(print,multistart) S3method(print,nafta) S3method(print,nlme.mmkin) S3method(print,saem.mmkin) +S3method(print,status.mhmkin) +S3method(print,status.mmkin) +S3method(print,status.multistart) S3method(print,summary.mkinfit) S3method(print,summary.mmkin) S3method(print,summary.nlme.mmkin) S3method(print,summary.saem.mmkin) S3method(residuals,mkinfit) S3method(saem,mmkin) +S3method(status,mmkin) +S3method(status,multistart) +S3method(status,multistart.saem.mmkin) S3method(summary,mkinfit) S3method(summary,mmkin) S3method(summary,nlme.mmkin) @@ -87,7 +86,6 @@ export(add_err) export(aw) export(backtransform_odeparms) export(best) -export(convergence) export(create_deg_func) export(endpoints) export(f_time_norm_focus) @@ -138,6 +136,7 @@ export(saemix_model) export(set_nd_nq) export(set_nd_nq_focus) export(sigma_twocomp) +export(status) export(transform_odeparms) export(which.best) import(deSolve) diff --git a/R/convergence.R b/R/convergence.R deleted file mode 100644 index e75bb1b1..00000000 --- a/R/convergence.R +++ /dev/null @@ -1,71 +0,0 @@ -#' Method to get convergence information -#' -#' @param object The object to investigate -#' @param x The object to be printed -#' @param \dots For potential future extensions -#' @return For [mkinfit] objects, a character vector containing -#' For [mmkin] objects, an object of class 'convergence.mmkin' with a -#' suitable printing method. -#' @export -convergence <- function(object, ...) -{ - UseMethod("convergence", object) -} - -#' @rdname convergence -#' @export -#' @examples -#' \dontrun{ -#' fits <- mmkin( -#' c("SFO", "FOMC"), -#' list("FOCUS A" = FOCUS_2006_A, -#' "FOCUS B" = FOCUS_2006_C), -#' quiet = TRUE) -#' convergence(fits) -#' } -convergence.mmkin <- function(object, ...) { - all_summary_warnings <- character() - sww <- 0 # Counter for Shapiro-Wilks warnings - - result <- lapply(object, - function(fit) { - if (inherits(fit, "try-error")) return("E") - sw <- fit$summary_warnings - swn <- names(sw) - if (length(sw) > 0) { - if (any(grepl("S", swn))) { - sww <<- sww + 1 - swn <- gsub("S", paste0("S", sww), swn) - } - warnstring <- paste(swn, collapse = ", ") - names(sw) <- swn - all_summary_warnings <<- c(all_summary_warnings, sw) - return(warnstring) - } else { - return("OK") - } - }) - result <- unlist(result) - dim(result) <- dim(object) - dimnames(result) <- dimnames(object) - - u_swn <- unique(names(all_summary_warnings)) - attr(result, "unique_warnings") <- all_summary_warnings[u_swn] - class(result) <- "convergence.mmkin" - return(result) -} - -#' @rdname convergence -#' @export -print.convergence.mmkin <- function(x, ...) { - u_w <- attr(x, "unique_warnings") - attr(x, "unique_warnings") <- NULL - class(x) <- NULL - print(x, quote = FALSE) - cat("\n") - for (i in seq_along(u_w)) { - cat(names(u_w)[i], ": ", u_w[i], "\n", sep = "") - } - if (any(x == "OK")) cat("OK: No warnings\n") - if (any(x == "E")) cat("E: Error\n") -} diff --git a/R/mhmkin.R b/R/mhmkin.R index 542bddf7..47b84b9d 100644 --- a/R/mhmkin.R +++ b/R/mhmkin.R @@ -133,11 +133,10 @@ mhmkin.list <- function(objects, backend = "saemix", print.mhmkin <- function(x, ...) { cat(" object\n") cat("Status of individual fits:\n\n") - print(convergence(x)) + print(status(x)) } -#' @export -convergence.mhmkin <- function(object, ...) { +status.mhmkin <- function(object, ...) { if (inherits(object[[1]], "saem.mmkin")) { test_func <- function(fit) { if (inherits(fit$so, "try-error")) { @@ -160,12 +159,12 @@ convergence.mhmkin <- function(object, ...) { dim(result) <- dim(object) dimnames(result) <- dimnames(object) - class(result) <- "convergence.mhmkin" + class(result) <- "status.mhmkin" return(result) } #' @export -print.convergence.mhmkin <- function(x, ...) { +print.status.mhmkin <- function(x, ...) { class(x) <- NULL print(x, quote = FALSE) cat("\n") diff --git a/R/mmkin.R b/R/mmkin.R index 247fd5fa..01e53290 100644 --- a/R/mmkin.R +++ b/R/mmkin.R @@ -171,7 +171,7 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, print.mmkin <- function(x, ...) { cat(" object\n") cat("Status of individual fits:\n\n") - print(convergence(x)) + print(status(x)) } #' @export diff --git a/R/multistart.R b/R/multistart.R index fc2dcd7d..29ccdc44 100644 --- a/R/multistart.R +++ b/R/multistart.R @@ -112,7 +112,7 @@ multistart.saem.mmkin <- function(object, n = 50, cores = 1, } #' @export -convergence.multistart <- function(object, ...) { +status.multistart <- function(object, ...) { all_summary_warnings <- character() result <- lapply(object, @@ -124,12 +124,12 @@ convergence.multistart <- function(object, ...) { }) result <- unlist(result) - class(result) <- "convergence.multistart" + class(result) <- "status.multistart" return(result) } #' @export -convergence.multistart.saem.mmkin <- function(object, ...) { +status.multistart.saem.mmkin <- function(object, ...) { all_summary_warnings <- character() result <- lapply(object, @@ -141,12 +141,12 @@ convergence.multistart.saem.mmkin <- function(object, ...) { }) result <- unlist(result) - class(result) <- "convergence.multistart" + class(result) <- "status.multistart" return(result) } #' @export -print.convergence.multistart <- function(x, ...) { +print.status.multistart <- function(x, ...) { class(x) <- NULL print(table(x, dnn = NULL)) if (any(x == "OK")) cat("OK: Fit terminated successfully\n") @@ -157,7 +157,7 @@ print.convergence.multistart <- function(x, ...) { #' @export print.multistart <- function(x, ...) { cat(" object with", length(x), "fits:\n") - print(convergence(x)) + print(status(x)) } #' @rdname multistart diff --git a/R/status.R b/R/status.R new file mode 100644 index 00000000..44d2a9bc --- /dev/null +++ b/R/status.R @@ -0,0 +1,70 @@ +#' Method to get status information for fit array objects +#' +#' @param object The object to investigate +#' @param x The object to be printed +#' @param \dots For potential future extensions +#' @return An object with the same dimensions as the fit array +#' suitable printing method. +#' @export +status <- function(object, ...) +{ + UseMethod("status", object) +} + +#' @rdname status +#' @export +#' @examples +#' \dontrun{ +#' fits <- mmkin( +#' c("SFO", "FOMC"), +#' list("FOCUS A" = FOCUS_2006_A, +#' "FOCUS B" = FOCUS_2006_C), +#' quiet = TRUE) +#' status(fits) +#' } +status.mmkin <- function(object, ...) { + all_summary_warnings <- character() + sww <- 0 # Counter for Shapiro-Wilks warnings + + result <- lapply(object, + function(fit) { + if (inherits(fit, "try-error")) return("E") + sw <- fit$summary_warnings + swn <- names(sw) + if (length(sw) > 0) { + if (any(grepl("S", swn))) { + sww <<- sww + 1 + swn <- gsub("S", paste0("S", sww), swn) + } + warnstring <- paste(swn, collapse = ", ") + names(sw) <- swn + all_summary_warnings <<- c(all_summary_warnings, sw) + return(warnstring) + } else { + return("OK") + } + }) + result <- unlist(result) + dim(result) <- dim(object) + dimnames(result) <- dimnames(object) + + u_swn <- unique(names(all_summary_warnings)) + attr(result, "unique_warnings") <- all_summary_warnings[u_swn] + class(result) <- "status.mmkin" + return(result) +} + +#' @rdname status +#' @export +print.status.mmkin <- function(x, ...) { + u_w <- attr(x, "unique_warnings") + attr(x, "unique_warnings") <- NULL + class(x) <- NULL + print(x, quote = FALSE) + cat("\n") + for (i in seq_along(u_w)) { + cat(names(u_w)[i], ": ", u_w[i], "\n", sep = "") + } + if (any(x == "OK")) cat("OK: No warnings\n") + if (any(x == "E")) cat("E: Error\n") +} diff --git a/R/summary.mmkin.R b/R/summary.mmkin.R index 5f4a048b..06472e18 100644 --- a/R/summary.mmkin.R +++ b/R/summary.mmkin.R @@ -1,6 +1,6 @@ #' Summary method for class "mmkin" #' -#' Shows convergence information on the [mkinfit] objects contained in the object +#' Shows status information on the [mkinfit] objects contained in the object #' and gives an overview of ill-defined parameters calculated by [illparms]. #' #' @param object an object of class [mmkin] @@ -24,7 +24,7 @@ summary.mmkin <- function(object, conf.level = 0.95, ...) { err_mod = object[[1, 1]]$err_mod, time = attr(object, "time"), illparms = illparms(object), - convergence = convergence(object) + status = status(object) ) class(ans) <- c("summary.mmkin") @@ -43,8 +43,8 @@ print.summary.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ... } cat("Fitted in", x$time[["elapsed"]], "s\n") - cat("\nConvergence:\n") - print(x$convergence) + cat("\nStatus:\n") + print(x$status) if (any(x$illparms != "")) { cat("\nIll-defined parameters:\n") diff --git a/man/convergence.Rd b/man/convergence.Rd deleted file mode 100644 index 635eb9ae..00000000 --- a/man/convergence.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/convergence.R -\name{convergence} -\alias{convergence} -\alias{convergence.mmkin} -\alias{print.convergence.mmkin} -\title{Method to get convergence information} -\usage{ -convergence(object, ...) - -\method{convergence}{mmkin}(object, ...) - -\method{print}{convergence.mmkin}(x, ...) -} -\arguments{ -\item{object}{The object to investigate} - -\item{\dots}{For potential future extensions} - -\item{x}{The object to be printed} -} -\value{ -For \link{mkinfit} objects, a character vector containing -For \link{mmkin} objects, an object of class 'convergence.mmkin' with a -suitable printing method. -} -\description{ -Method to get convergence information -} -\examples{ -\dontrun{ -fits <- mmkin( - c("SFO", "FOMC"), - list("FOCUS A" = FOCUS_2006_A, - "FOCUS B" = FOCUS_2006_C), - quiet = TRUE) -convergence(fits) -} -} diff --git a/man/status.Rd b/man/status.Rd new file mode 100644 index 00000000..8ff3531b --- /dev/null +++ b/man/status.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/status.R +\name{status} +\alias{status} +\alias{status.mmkin} +\alias{print.status.mmkin} +\title{Method to get status information for fit array objects} +\usage{ +status(object, ...) + +\method{status}{mmkin}(object, ...) + +\method{print}{status.mmkin}(x, ...) +} +\arguments{ +\item{object}{The object to investigate} + +\item{\dots}{For potential future extensions} + +\item{x}{The object to be printed} +} +\value{ +An object with the same dimensions as the fit array +suitable printing method. +} +\description{ +Method to get status information for fit array objects +} +\examples{ +\dontrun{ +fits <- mmkin( + c("SFO", "FOMC"), + list("FOCUS A" = FOCUS_2006_A, + "FOCUS B" = FOCUS_2006_C), + quiet = TRUE) +status(fits) +} +} diff --git a/man/summary.mmkin.Rd b/man/summary.mmkin.Rd index 69245621..32e5824f 100644 --- a/man/summary.mmkin.Rd +++ b/man/summary.mmkin.Rd @@ -21,7 +21,7 @@ \item{digits}{number of digits to use for printing} } \description{ -Shows convergence information on the \link{mkinfit} objects contained in the object +Shows status information on the \link{mkinfit} objects contained in the object and gives an overview of ill-defined parameters calculated by \link{illparms}. } \examples{ -- cgit v1.2.1