# Xpose 4
# An R-based population pharmacokinetic/
# pharmacodynamic model building aid for NONMEM.
# Copyright (C) 1998-2004 E. Niclas Jonsson and Mats Karlsson.
# Copyright (C) 2005-2008 Andrew C. Hooker, Justin J. Wilkins,
# Mats O. Karlsson and E. Niclas Jonsson.
# Copyright (C) 2009-2010 Andrew C. Hooker, Mats O. Karlsson and
# E. Niclas Jonsson.
# This file is a part of Xpose 4.
# Xpose 4 is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public License
# as published by the Free Software Foundation, either version 3
# of the License, or (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Lesser General Public License for more details.
# You should have received a copy of the GNU Lesser General Public License
# along with this program. A copy can be cound in the R installation
# directory under \share\licenses. If not, see http://www.gnu.org/licenses/.
#' Additional model comparison plots, for Xpose 4
#'
#' This creates a stack of four plots, comparing absolute values of PRED,
#' absolute values of IPRED, delta CWRES (or WRES) and delta IWRES estimates
#' for the two specified model fits.
#'
#' Four model comparison plots are displayed in sequence.
#'
#' Conditional weighted residuals (CWRES) require some extra steps to
#' calculate. See \code{\link{compute.cwres}} for details.
#'
#' A wide array of extra options controlling xyplots are available. See
#' \code{\link{xpose.plot.default}} for details.
#'
#' @param object An xpose.data object.
#' @param object.ref An xpose.data object. If not supplied, the user will be
#' prompted.
#' @param inclZeroWRES Logical value indicating whether rows with WRES=0 is
#' included in the plot. The default is TRUE.
#' @param onlyfirst Logical value indicating whether only the first row per
#' individual is included in the plot.
#' @param subset A string giving the subset expression to be applied to the
#' data before plotting. See \code{\link{xsubset}}.
#' @param main The title of the plot. If \code{"Default"} then a default title
#' is plotted. Otherwise the value should be a string like \code{"my title"} or
#' \code{NULL} for no plot title.
#' @param force.wres Should we use the WRES in the plots instead of CWRES
#' (logical \code{TRUE} or \code{FALSE})
#' @param \dots Other arguments passed to \code{link{xpose.plot.default}}.
#' @return Returns a stack of plots comprising comparisons of absolute values
#' of PRED, absolute values of IPRED, absolute differences in CWRES (or WRES)
#' and absolute differences in IWRES for the two specified runs.
#' @author E. Niclas Jonsson, Mats Karlsson, Andrew Hooker & Justin Wilkins
#' @seealso \code{\link{xpose.plot.default}},
#' \code{\link{xpose.panel.default}}, \code{\link[lattice]{xyplot}},
#' \code{\link{compute.cwres}}, \code{\link{xpose.prefs-class}},
#' \code{\link{xpose.data-class}}
#' @keywords methods
#' @examples
#'
#' \dontrun{
#' ## We expect to find the required NONMEM run and table files for runs
#' ## 5 and 6 in the current working directory
#' xpdb5 <- xpose.data(5)
#' xpdb6 <- xpose.data(6)
#'
#' ## A vanilla plot, without prompts
#' add.model.comp(xpdb5, xpdb6, prompt = FALSE)
#'
#' ## Custom colours and symbols, no user IDs
#' add.model.comp(xpdb5, xpdb6, cex=0.6, pch=8, col=1, ids=NULL)
#' }
#'
#'
#' @export add.model.comp
"add.model.comp" <-
function(object,
object.ref = NULL,
onlyfirst = FALSE,
inclZeroWRES = FALSE,
subset = xsubset(object),
main="Default",
force.wres=FALSE,
#ref.default = ".ref.db",
...) {
if (is.null(object.ref)) {
ref.list <- get.refrunno()
if(exists(".ref.db")){
object.ref <- eval(parse(text=".ref.db"))
} else {
return()
}
if(any(is.null(ref.list)))
return()
}
if(dim(object@Data)[1] != dim(object.ref@Data)[1]) {
cat("The current database and the reference database do not have\n")
cat("the same number of lines!\n")
invisible()
return()
}
if(is.null(check.vars(c("idlab","pred","ipred","iwres","idv"),
object,silent=FALSE))) {
return()
}
use.cwres=TRUE
if(force.wres){
use.cwres=FALSE
if(is.null(check.vars(c("wres"),object,silent=FALSE))) return()
} else {
if(is.null(check.vars(c("cwres"),object,silent=TRUE))) {
use.cwres=FALSE
if(is.null(check.vars(c("wres"),object,silent=FALSE))) return()
}
}
object@Data$PRED.REF <- abs(object.ref@Data[,xvardef("pred", object.ref)])
object@Data$IPRED.REF <- abs(object.ref@Data[,xvardef("ipred", object.ref)])
#object@Data$WRES.REF <- abs(object.ref@Data[,xvardef("wres", object.ref)])
object@Data$IWRES.REF <- abs(object.ref@Data[,xvardef("iwres", object.ref)])
#object@Data$dWRES <- abs(object@Data[,xvardef("wres", object)] - object.ref@Data[,xvardef("wres", object.ref)])
object@Data$dIWRES <- abs(object@Data[,xvardef("iwres", object)] - object.ref@Data[,xvardef("iwres", object.ref)])
if(use.cwres){
object@Data$CWRES.REF <- abs(object.ref@Data[,xvardef("cwres", object.ref)])
object@Data$dCWRES <- abs(object@Data[,xvardef("cwres", object)] - object.ref@Data[,xvardef("cwres", object.ref)])
object@Data[,xvardef("cwres", object)] <- abs(object@Data[,xvardef("cwres", object)])
} else {
object@Data$WRES.REF <- abs(object.ref@Data[,xvardef("wres", object.ref)])
object@Data$dWRES <- abs(object@Data[,xvardef("wres", object)] - object.ref@Data[,xvardef("wres", object.ref)])
object@Data[,xvardef("wres", object)] <- abs(object@Data[,xvardef("wres", object)])
}
object@Data[,xvardef("pred", object)] <- abs(object@Data[,xvardef("pred", object)])
object@Data[,xvardef("ipred", object)] <- abs(object@Data[,xvardef("ipred", object)])
#object@Data[,xvardef("wres", object)] <- abs(object@Data[,xvardef("wres", object)])
object@Data[,xvardef("iwres", object)] <- abs(object@Data[,xvardef("iwres", object)])
## |PRED| vs |PRED|
if(!any(is.null(xvardef("pred", object))) &&
!any(is.null(xvardef("pred", object.ref)))) {
xlb <- paste("|",xlabel(xvardef("pred",object),object),
"| (Run ", object@Runno, ")",sep="")
ylb <- paste("|",xlabel(xvardef("pred",object.ref),object.ref),
"| (Run ", object.ref@Runno, ")",sep="")
# main <- paste(ylb, " vs ", xlb, sep="")
xplot1 <- xpose.plot.default(xvardef("pred", object),
"PRED.REF",
object,
xlb = xlb,
ylb = ylb,
main = NULL,
abline=c(0,1),
onlyfirst = onlyfirst,
inclZeroWRES = inclZeroWRES,
subset = subset,
pass.plot.list = TRUE,
...)
}
## |IPRED| vs |IPRED|
if(!any(is.null(xvardef("ipred", object))) && !any(is.null(xvardef("ipred", object.ref)))) {
xlb <- paste("|",xlabel(xvardef("ipred",object),object), "| (Run ", object@Runno, ")",sep="")
ylb <- paste("|",xlabel(xvardef("ipred",object.ref),object.ref), "| (Run ", object.ref@Runno, ")",sep="")
# main <- paste(ylb, " vs ", xlb, sep="")
xplot2 <- xpose.plot.default(xvardef("ipred", object),
"IPRED.REF",
object,
xlb = xlb,
ylb = ylb,
main = NULL,
abline=c(0,1),
onlyfirst = onlyfirst,
inclZeroWRES = inclZeroWRES,
subset = subset,
pass.plot.list = TRUE,
...)
}
if(use.cwres){
# |dCWRES| vs IDV
if(!any(is.null(xvardef("cwres", object))) && !any(is.null(xvardef("cwres", object.ref)))) {
xlb <- paste(xlabel(xvardef("idv",object),object),sep="")
ylb <- paste("|dCWRES| (Run ", object@Runno, " - Run ",object.ref@Runno,")",sep="")
# main <- paste(ylb, " vs ", xlb, sep="")
xplot3 <- xpose.plot.default(xvardef("idv", object),
"dCWRES",
object,
xlb = xlb,
ylb = ylb,
main = NULL,
onlyfirst = onlyfirst,
inclZeroWRES = inclZeroWRES,
subset = subset,
pass.plot.list = TRUE,
...)
}
} else {
# |dWRES| vs IDV
if(!any(is.null(xvardef("wres", object))) && !any(is.null(xvardef("wres", object.ref)))) {
xlb <- paste(xlabel(xvardef("idv",object),object),sep="")
ylb <- paste("|dWRES| (Run ", object@Runno, " - Run ",object.ref@Runno,")",sep="")
# main <- paste(ylb, " vs ", xlb, sep="")
xplot3 <- xpose.plot.default(xvardef("idv", object),
"dWRES",
object,
xlb = xlb,
ylb = ylb,
main = NULL,
onlyfirst = onlyfirst,
inclZeroWRES = inclZeroWRES,
subset = subset,
pass.plot.list = TRUE,
...)
}
}
# |dIWRES| vs IDV
if(!any(is.null(xvardef("iwres", object))) && !any(is.null(xvardef("iwres", object.ref)))) {
xlb <- paste(xlabel(xvardef("idv",object),object),sep="")
ylb <- paste("|diWRES| (Run ", object@Runno, " - Run ",object.ref@Runno,")",sep="")
# main <- paste(ylb, " vs ", xlb, sep="")
xplot4 <- xpose.plot.default(xvardef("idv", object),
"dIWRES",
object,
xlb = xlb,
ylb = ylb,
main = NULL,
onlyfirst = onlyfirst,
inclZeroWRES = inclZeroWRES,
subset = subset,
pass.plot.list = TRUE,
...)
}
## create enpty list for plots
num.of.plots <- 4
plotList <- vector("list",num.of.plots)
plotList[[1]] <- xplot1
plotList[[2]] <- xplot2
plotList[[3]] <- xplot3
plotList[[4]] <- xplot4
default.plot.title <- "Additional model comparison plots"
plotTitle <- xpose.multiple.plot.title(object=object,
plot.text = default.plot.title,
subset=subset,
main=main,
...)
obj <- xpose.multiple.plot(plotList,plotTitle,...)
return(obj)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.