From f820bf5b91be0f589de16c3e3250f5f79672df75 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 28 Oct 2022 13:39:15 +0200 Subject: Rename parhist to parplot and make it generic That parhist name was not the brightest idea, as it does not show histograms. --- R/llhist.R | 3 +- R/multistart.R | 6 ++-- R/parhist.R | 99 ----------------------------------------------------- R/parplot.R | 105 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ R/saem.R | 2 +- 5 files changed, 111 insertions(+), 104 deletions(-) delete mode 100644 R/parhist.R create mode 100644 R/parplot.R (limited to 'R') diff --git a/R/llhist.R b/R/llhist.R index 22e3aa08..e158495d 100644 --- a/R/llhist.R +++ b/R/llhist.R @@ -25,6 +25,7 @@ llhist <- function(object, breaks = "Sturges", lpos = "topleft", main = "", stop("llhist is only implemented for multistart.saem.mmkin objects") } + ll_orig <- logLik(attr(object, "orig")) ll <- stats::na.omit(sapply(object, llfunc)) par(las = 1) @@ -34,7 +35,7 @@ llhist <- function(object, breaks = "Sturges", lpos = "topleft", main = "", freq_factor <- h$counts[1] / h$density[1] - abline(v = logLik(attr(object, "orig")), col = 2) + abline(v = ll_orig, col = 2) legend(lpos, inset = c(0.05, 0.05), bty = "n", lty = 1, col = c(2), diff --git a/R/multistart.R b/R/multistart.R index 29ccdc44..14683c11 100644 --- a/R/multistart.R +++ b/R/multistart.R @@ -17,7 +17,7 @@ #' @param x The multistart object to print #' @return A list of [saem.mmkin] objects, with class attributes #' 'multistart.saem.mmkin' and 'multistart'. -#' @seealso [parhist], [llhist] +#' @seealso [parplot], [llhist] #' #' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical #' identifiability in the frame of nonlinear mixed effects models: the example @@ -40,7 +40,7 @@ #' f_mmkin <- mmkin("DFOP", dmta_ds, error_model = "tc", cores = 7, quiet = TRUE) #' f_saem_full <- saem(f_mmkin) #' f_saem_full_multi <- multistart(f_saem_full, n = 16, cores = 16) -#' parhist(f_saem_full_multi, lpos = "bottomleft") +#' parplot(f_saem_full_multi, lpos = "bottomleft") #' illparms(f_saem_full) #' #' f_saem_reduced <- update(f_saem_full, no_random_effect = "log_k2") @@ -52,7 +52,7 @@ #' cl <- makePSOCKcluster(12) #' clusterExport(cl, "f_mmkin") #' f_saem_reduced_multi <- multistart(f_saem_reduced, n = 16, cluster = cl) -#' parhist(f_saem_reduced_multi, lpos = "topright") +#' parplot(f_saem_reduced_multi, lpos = "topright") #' } multistart <- function(object, n = 50, cores = if (Sys.info()["sysname"] == "Windows") 1 else parallel::detectCores(), diff --git a/R/parhist.R b/R/parhist.R deleted file mode 100644 index 0f9c9964..00000000 --- a/R/parhist.R +++ /dev/null @@ -1,99 +0,0 @@ -#' Plot parameter distributions from multistart objects -#' -#' Produces a boxplot with all parameters from the multiple runs, scaled -#' either by the parameters of the run with the highest likelihood, -#' or by their medians as proposed in the paper by Duchesne et al. (2021). -#' -#' @param object The [multistart] object -#' @param llmin The minimum likelihood of objects to be shown -#' @param scale By default, scale parameters using the best available fit. -#' If 'median', parameters are scaled using the median parameters from all fits. -#' @param main Title of the plot -#' @param lpos Positioning of the legend. -#' @param \dots Passed to [boxplot] -#' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical -#' identifiability in the frame of nonlinear mixed effects models: the example -#' of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478. -#' doi: 10.1186/s12859-021-04373-4. -#' @seealso [multistart] -#' @importFrom stats median -#' @export -parhist <- function(object, llmin = -Inf, scale = c("best", "median"), - lpos = "bottomleft", main = "", ...) -{ - oldpar <- par(no.readonly = TRUE) - on.exit(par(oldpar, no.readonly = TRUE)) - - orig <- attr(object, "orig") - orig_parms <- parms(orig) - start_parms <- orig$mean_dp_start - all_parms <- parms(object) - - if (inherits(object, "multistart.saem.mmkin")) { - llfunc <- function(object) { - if (inherits(object$so, "try-error")) return(NA) - else return(logLik(object$so)) - } - } else { - stop("parhist is only implemented for multistart.saem.mmkin objects") - } - ll <- sapply(object, llfunc) - selected <- which(ll > llmin) - selected_parms <- all_parms[selected, ] - - par(las = 1) - if (orig$transformations == "mkin") { - degparm_names_transformed <- names(start_parms) - degparm_index <- which(names(orig_parms) %in% degparm_names_transformed) - orig_parms[degparm_names_transformed] <- backtransform_odeparms( - orig_parms[degparm_names_transformed], - orig$mmkin[[1]]$mkinmod, - transform_rates = orig$mmkin[[1]]$transform_rates, - transform_fractions = orig$mmkin[[1]]$transform_fractions) - start_parms <- backtransform_odeparms(start_parms, - orig$mmkin[[1]]$mkinmod, - transform_rates = orig$mmkin[[1]]$transform_rates, - transform_fractions = orig$mmkin[[1]]$transform_fractions) - degparm_names <- names(start_parms) - - names(orig_parms) <- c(degparm_names, names(orig_parms[-degparm_index])) - - selected_parms[, degparm_names_transformed] <- - t(apply(selected_parms[, degparm_names_transformed], 1, backtransform_odeparms, - orig$mmkin[[1]]$mkinmod, - transform_rates = orig$mmkin[[1]]$transform_rates, - transform_fractions = orig$mmkin[[1]]$transform_fractions)) - colnames(selected_parms)[1:length(degparm_names)] <- degparm_names - } - - scale <- match.arg(scale) - parm_scale <- switch(scale, - best = selected_parms[which.best(object[selected]), ], - median = apply(selected_parms, 2, median) - ) - - # Boxplots of all scaled parameters - selected_scaled_parms <- t(apply(selected_parms, 1, function(x) x / parm_scale)) - boxplot(selected_scaled_parms, log = "y", main = main, , - ylab = "Normalised parameters", ...) - - # Show starting parameters - start_scaled_parms <- rep(NA_real_, length(orig_parms)) - names(start_scaled_parms) <- names(orig_parms) - start_scaled_parms[names(start_parms)] <- - start_parms / parm_scale[names(start_parms)] - points(start_scaled_parms, col = 3, cex = 3) - - # Show parameters of original run - orig_scaled_parms <- orig_parms / parm_scale - points(orig_scaled_parms, col = 2, cex = 2) - - abline(h = 1, lty = 2) - - legend(lpos, inset = c(0.05, 0.05), bty = "n", - pch = 1, col = 3:1, lty = c(NA, NA, 1), - legend = c( - "Starting parameters", - "Original run", - "Multistart runs")) -} diff --git a/R/parplot.R b/R/parplot.R new file mode 100644 index 00000000..627a4eb8 --- /dev/null +++ b/R/parplot.R @@ -0,0 +1,105 @@ +#' Plot parameter variability of multistart objects +#' +#' Produces a boxplot with all parameters from the multiple runs, scaled +#' either by the parameters of the run with the highest likelihood, +#' or by their medians as proposed in the paper by Duchesne et al. (2021). +#' +#' @param object The [multistart] object +#' @param llmin The minimum likelihood of objects to be shown +#' @param scale By default, scale parameters using the best available fit. +#' If 'median', parameters are scaled using the median parameters from all fits. +#' @param main Title of the plot +#' @param lpos Positioning of the legend. +#' @param \dots Passed to [boxplot] +#' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical +#' identifiability in the frame of nonlinear mixed effects models: the example +#' of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478. +#' doi: 10.1186/s12859-021-04373-4. +#' @seealso [multistart] +#' @importFrom stats median +#' @export +parplot <- function(object, ...) { + UseMethod("parplot") +} + +#' @rdname parplot +#' @export +parplot.multistart.saem.mmkin <- function(object, llmin = -Inf, scale = c("best", "median"), + lpos = "bottomleft", main = "", ...) +{ + oldpar <- par(no.readonly = TRUE) + on.exit(par(oldpar, no.readonly = TRUE)) + + orig <- attr(object, "orig") + orig_parms <- parms(orig) + start_parms <- orig$mean_dp_start + all_parms <- parms(object) + + if (inherits(object, "multistart.saem.mmkin")) { + llfunc <- function(object) { + if (inherits(object$so, "try-error")) return(NA) + else return(logLik(object$so)) + } + } else { + stop("parplot is only implemented for multistart.saem.mmkin objects") + } + ll <- sapply(object, llfunc) + selected <- which(ll > llmin) + selected_parms <- all_parms[selected, ] + + par(las = 1) + if (orig$transformations == "mkin") { + degparm_names_transformed <- names(start_parms) + degparm_index <- which(names(orig_parms) %in% degparm_names_transformed) + orig_parms[degparm_names_transformed] <- backtransform_odeparms( + orig_parms[degparm_names_transformed], + orig$mmkin[[1]]$mkinmod, + transform_rates = orig$mmkin[[1]]$transform_rates, + transform_fractions = orig$mmkin[[1]]$transform_fractions) + start_parms <- backtransform_odeparms(start_parms, + orig$mmkin[[1]]$mkinmod, + transform_rates = orig$mmkin[[1]]$transform_rates, + transform_fractions = orig$mmkin[[1]]$transform_fractions) + degparm_names <- names(start_parms) + + names(orig_parms) <- c(degparm_names, names(orig_parms[-degparm_index])) + + selected_parms[, degparm_names_transformed] <- + t(apply(selected_parms[, degparm_names_transformed], 1, backtransform_odeparms, + orig$mmkin[[1]]$mkinmod, + transform_rates = orig$mmkin[[1]]$transform_rates, + transform_fractions = orig$mmkin[[1]]$transform_fractions)) + colnames(selected_parms)[1:length(degparm_names)] <- degparm_names + } + + scale <- match.arg(scale) + parm_scale <- switch(scale, + best = selected_parms[which.best(object[selected]), ], + median = apply(selected_parms, 2, median) + ) + + # Boxplots of all scaled parameters + selected_scaled_parms <- t(apply(selected_parms, 1, function(x) x / parm_scale)) + boxplot(selected_scaled_parms, log = "y", main = main, , + ylab = "Normalised parameters", ...) + + # Show starting parameters + start_scaled_parms <- rep(NA_real_, length(orig_parms)) + names(start_scaled_parms) <- names(orig_parms) + start_scaled_parms[names(start_parms)] <- + start_parms / parm_scale[names(start_parms)] + points(start_scaled_parms, col = 3, cex = 3) + + # Show parameters of original run + orig_scaled_parms <- orig_parms / parm_scale + points(orig_scaled_parms, col = 2, cex = 2) + + abline(h = 1, lty = 2) + + legend(lpos, inset = c(0.05, 0.05), bty = "n", + pch = 1, col = 3:1, lty = c(NA, NA, 1), + legend = c( + "Starting parameters", + "Original run", + "Multistart runs")) +} diff --git a/R/saem.R b/R/saem.R index cf67b8e1..090ed3bf 100644 --- a/R/saem.R +++ b/R/saem.R @@ -726,7 +726,7 @@ saemix_data <- function(object, covariates = NULL, verbose = FALSE, ...) { #' @param \dots Passed to [saemix::logLik.SaemixObject] #' @param method Passed to [saemix::logLik.SaemixObject] #' @export -logLik.saem.mmkin <- function(object, ..., method = c("lin", "is", "gq")) { +logLik.saem.mmkin <- function(object, ..., method = c("is", "lin", "gq")) { method <- match.arg(method) return(logLik(object$so, method = method)) } -- cgit v1.2.1