Skip to content

Commit

Permalink
Fix/test for vpcPlot
Browse files Browse the repository at this point in the history
  • Loading branch information
mattfidler committed Jan 30, 2023
1 parent c375df8 commit a69ca8d
Show file tree
Hide file tree
Showing 3 changed files with 37 additions and 4 deletions.
1 change: 1 addition & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -12,3 +12,4 @@


^cran-comments\.md$
^CRAN-SUBMISSION$
13 changes: 9 additions & 4 deletions R/vpcPlot.R
Original file line number Diff line number Diff line change
Expand Up @@ -72,7 +72,7 @@ vpcPlot <- function(fit, data = NULL, n = 300, bins = "jenks",
fit <- .fit
}
.ui <- rxode2::rxUiDecompress(fit$ui)
.obsLst <- .vpcUiSetupObservationData(fit, data=data, idv=idv)
.obsLst <- .vpcUiSetupObservationData(fit, data=data, idv=idv, cens=cens)
.obs <- .obsLst$obs
.no <- .obsLst$namesObs
.nol <- .obsLst$namesObsLower
Expand Down Expand Up @@ -210,7 +210,7 @@ vpcCens <- function(..., cens=TRUE, idv="time") {
#' @return List with `namesObs`, `namesObsLower`, `obs` and `obsCols`
#' @author Matthew L. Fidler
#' @noRd
.vpcUiSetupObservationData <- function(fit, data=NULL, idv="time") {
.vpcUiSetupObservationData <- function(fit, data=NULL, idv="time", cens=FALSE) {
if (!is.null(data)) {
.obs <- data
} else {
Expand Down Expand Up @@ -252,8 +252,13 @@ vpcCens <- function(..., cens=TRUE, idv="time") {
}
.obsCols <- c(.obsCols,
list(idv=.no[.wo]))
if (!cens) {
.no <- .no[which(tolower(.no) != "cens")]
.nol <- .no[which(tolower(.no) != "cens")]
.obs <- .obs[which(tolower(names(.obs)) != "cens")]
}
list(namesObs=.no,
namesObsLower=.nol,
obs=.obs,
obsCols=.obsCols)
obs=.obs,
obsCols=.obsCols)
}
27 changes: 27 additions & 0 deletions tests/testthat/test-plots-cens.R
Original file line number Diff line number Diff line change
Expand Up @@ -84,4 +84,31 @@ test_that("plot censoring", {
#for (i in seq_along(gof)) {
# vdiffr::expect_doppelganger(sprintf("gof %03d", i), gof[[i]])
#}

theo_cens <- theo_sd
theo_cens$cens <- 0
theo_cens$cens[theo_cens$DV <= 1] <- 1
theo_cens$DV[theo_cens$DV <= 1 & theo_cens$AMT == 0] <- 1

m1 <- function() {
ini({
tka <- 0.5
tcl <- -3.2
tv <- -1
eta.ka ~ 1
eta.cl ~ 2
eta.v ~ 1
add.err <- 0.1
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
linCmt() ~ add(add.err)
})
}
fit1 <- nlmixr(m1, theo_cens,
est = "focei", control=foceiControl(print=0),
table = tableControl(npde = TRUE, censMethod = "cdf"))
expect_error(vpcPlot(fit = fit1), NA)
})

0 comments on commit a69ca8d

Please sign in to comment.