diff options
author | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-01 09:46:33 +0100 |
---|---|---|
committer | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-01 09:46:33 +0100 |
commit | fd4bd411df739903279d8b52faa19d5059afbda7 (patch) | |
tree | ca1ea04a1d6e54949e5d69147d5ac253efaf95d7 /R | |
parent | 300aa6ec27529f46deda07874566dc8fcee4e6e7 (diff) |
Improved printing for illparms()
For the case of single fits and no ill-defined parameters found
Diffstat (limited to 'R')
-rw-r--r-- | R/illparms.R | 24 |
1 files changed, 20 insertions, 4 deletions
diff --git a/R/illparms.R b/R/illparms.R index 931d8f05..003c6db1 100644 --- a/R/illparms.R +++ b/R/illparms.R @@ -22,8 +22,9 @@ #' tested? #' @return For [mkinfit] or [saem] objects, a character vector of parameter #' names. For [mmkin] or [mhmkin] objects, a matrix like object of class -#' 'illparms.mmkin' or 'illparms.mhmkin'. The latter objects have a suitable -#' printing method. +#' 'illparms.mmkin' or 'illparms.mhmkin'. +#' @note All objects have printing methods. For the single fits, printing +#' does not output anything in the case no ill-defined parameters are found. #' @export illparms <- function(object, ...) { @@ -39,7 +40,18 @@ illparms.mkinfit <- function(object, conf.level = 0.95, ...) { p_values <- suppressWarnings(summary(object)$bpar[, "Pr(>t)"]) na <- is.na(p_values) failed <- p_values > 1 - conf.level - names(parms(object))[na | failed] + ret <- names(parms(object))[na | failed] + class(ret) <- "illparms.mkinfit" + return(ret) +} + +#' @rdname +#' @export +print.illparms.mkinfit <- function(x, ...) { + class(x) <- NULL + if (length(x) > 0) { + print(as.character(x)) + } } #' @rdname illparms @@ -82,7 +94,7 @@ print.illparms.mmkin <- function(x, ...) { #' @export illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, ...) { if (inherits(object, "try-error")) { - return(NA) + failed <- NA } else { ints <- intervals(object, conf.level = conf.level) failed <- NULL @@ -95,9 +107,13 @@ illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod failed <- c(failed, names(which(failed_errmod))) } } + class(failed) <- "illparms.saem.mmkin" return(failed) } +#' @export +print.illparms.saem.mmkin <- print.illparms.mkinfit + #' @rdname illparms #' @export illparms.mhmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, ...) { |