1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
#' 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).
#'
#' Starting values of degradation model parameters and error model parameters
#' are shown as green circles. The results obtained in the original run
#' are shown as red circles.
#'
#' @param object The [multistart] object
#' @param llmin The minimum likelihood of objects to be shown
#' @param llquant Fractional value for selecting only the fits with higher
#' likelihoods. Overrides 'llmin'.
#' @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, llquant = NA,
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_degparms <- 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)
if (!is.na(llquant[1])) {
if (llmin != -Inf) warning("Overriding 'llmin' because 'llquant' was specified")
llmin <- quantile(ll, 1 - llquant)
}
selected <- which(ll > llmin)
selected_parms <- all_parms[selected, ]
par(las = 1)
if (orig$transformations == "mkin") {
degparm_names_transformed <- names(start_degparms)
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_degparms <- backtransform_odeparms(start_degparms,
orig$mmkin[[1]]$mkinmod,
transform_rates = orig$mmkin[[1]]$transform_rates,
transform_fractions = orig$mmkin[[1]]$transform_fractions)
degparm_names <- names(start_degparms)
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
}
start_errparms <- orig$so@model@error.init
names(start_errparms) <- orig$so@model@name.sigma
start_omegaparms <- orig$so@model@omega.init
start_parms <- c(start_degparms, start_errparms)
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(
"Original start",
"Original results",
"Multistart runs"))
}
|
