Merge pull request #16 from certara/drwn_265_update_npde

DRWN-265 fix npde calc

R/npde.R

@@ -130,8 +130,8 @@ npde.tidyvpcobj <- function(o, id, data=o$data, smooth=FALSE, ...) {
 
   obssim <- data.table(
     y    = c(o$obs$y, o$sim$y),
-    id   = rep(id, len=(niter + 1)*nrow(obs)),
-    iter = rep(0:niter, each=nrow(obs)))
+    id   = rep(id, length.out=(niter + 1)*nrow(o$obs)),
+    iter = rep(0:niter, each=nrow(o$obs)))
 
   obssim <- obssim[, rn := (1:.N)][, cbind(rn, calc.npde(y, iter, smooth=smooth)), by=id][order(rn)][, rn := NULL]
 

R/vpcstats.R

@@ -2097,6 +2097,6 @@ binlessfit <- function(o, conf.level = .95, llam.quant = NULL, span = NULL, ...)
 
 .onAttach <- function(libname, pkgname) {
   packageStartupMessage(paste0("tidyvpc is part of Certara.R!\n",
-                               "Follow the link below to learn more about R package development at Cerara.\n",
+                               "Follow the link below to learn more about PMx R package development at Certara.\n",
                                "https://certara.github.io/R-Certara/"))
 }

tests/testthat/test-binless.R

@@ -1,20 +1,21 @@
-test_that("cont vpc binless vpcstats are correct", {
-  skip_on_cran()
-  get_os <- function(){
-    sysinf <- Sys.info()
-    if (!is.null(sysinf)){
-      os <- sysinf['sysname']
-      if (os == 'Darwin')
-        os <- "osx"
-    } else { ## mystery machine
-      os <- .Platform$OS.type
-      if (grepl("^darwin", R.version$os))
-        os <- "osx"
-      if (grepl("linux-gnu", R.version$os))
-        os <- "linux"
-    }
-    tolower(os)
+get_os <- function(){
+  sysinf <- Sys.info()
+  if (!is.null(sysinf)){
+    os <- sysinf['sysname']
+    if (os == 'Darwin')
+      os <- "osx"
+  } else { ## mystery machine
+    os <- .Platform$OS.type
+    if (grepl("^darwin", R.version$os))
+      os <- "osx"
+    if (grepl("linux-gnu", R.version$os))
+      os <- "linux"
   }
+  tolower(os)
+}
+
+test_that("cont vpc binless vpcstats are correct", {
+  #skip_on_cran()
 
   obs_data <- tidyvpc::obs_data
   sim_data <- tidyvpc::sim_data
@@ -46,22 +47,7 @@ test_that("cont vpc binless vpcstats are correct", {
 
 
 test_that("cont vpc binless stratification vpcstats are correct", {
-  skip_on_cran()
-  get_os <- function(){
-    sysinf <- Sys.info()
-    if (!is.null(sysinf)){
-      os <- sysinf['sysname']
-      if (os == 'Darwin')
-        os <- "osx"
-    } else { ## mystery machine
-      os <- .Platform$OS.type
-      if (grepl("^darwin", R.version$os))
-        os <- "osx"
-      if (grepl("linux-gnu", R.version$os))
-        os <- "linux"
-    }
-    tolower(os)
-  }
+  #skip_on_cran()
 
   obs_data <- tidyvpc::obs_data
   sim_data <- tidyvpc::sim_data
@@ -92,7 +78,7 @@ test_that("cont vpc binless stratification vpcstats are correct", {
 })
 
 test_that("cat vpc binless vpcstats are correct", {
-  skip_on_cran()
+ # skip_on_cran()
   obs_cat_data <- tidyvpc::obs_cat_data
   sim_cat_data <- tidyvpc::sim_cat_data
 
@@ -115,7 +101,7 @@ test_that("cat vpc binless vpcstats are correct", {
 
 
 test_that("cat vpc binless stratification vpcstats are correct", {
-  skip_on_cran()
+  #skip_on_cran()
   obs_cat_data <- tidyvpc::obs_cat_data
   sim_cat_data <- tidyvpc::sim_cat_data
 

tests/testthat/test-binning.R

@@ -70,3 +70,36 @@ test_that("cat obs strat vpcstats is correct", {
   testthat::expect_identical(all.equal(vpc$stats, stats), TRUE)
 
 })
+
+test_that("binning methods are valid", {
+
+  ## Subest MDV = 0
+  obs <- obs_data[MDV == 0]
+  sim <- sim_data[MDV == 0]
+
+  vpc <- observed(obs, x = TIME, y = DV )
+  vpc <- simulated(vpc, sim, y = DV)
+
+  centers <- c(0,1,5,8,12)
+  vpc <- binning(vpc, bin = "centers", centers = centers)
+  expect_equal(vpc$xbin$bin, as.factor(centers))
+
+  vpc <- binning(vpc, bin = "breaks", breaks = c(1,3,6,9,11))
+  expect_true(length(levels(vpc$xbin$bin)) == 11)
+
+  vpc <- binning(vpc, bin = "breaks", breaks = c(1,3,6,9,11))
+  expect_true(length(levels(vpc$xbin$bin)) == 11)
+
+  vpc <- binning(vpc, bin = "pam", nbins = 6)
+  expect_true(max(vpc$xbin$xbin) < 12)
+
+  vpc <- binning(vpc, bin = "ntile", nbins = 6)
+  expect_true(nrow(vpc$xbin) == 6)
+
+  vpc <- binning(vpc, bin = "eqcut", nbins = 12)
+  expect_true(nrow(vpc$xbin) == 12)
+
+  vpc <- binning(vpc, bin = "sd", nbins = 4)
+  expect_true(nrow(vpc$xbin) == 6)
+
+})

tests/testthat/test_npde.R

@@ -0,0 +1,47 @@
+test_that("npde colnames are correct", {
+  obs <- obs_data[MDV==0]
+  sim <- sim_data[MDV==0]
+
+  npde <- observed(obs, x=NULL, y=DV) %>%
+    simulated(sim, y=DV) %>%
+    npde(id=ID)
+
+  testthat::expect_true(
+    all(colnames(npde$npdeobs) == c("id", "iter","epred", "eres",  "ewres", "npd", "npde"))
+  )
+
+  testthat::expect_true(
+    all(colnames(npde$npdesim) == c("id", "iter","epred", "eres",  "ewres", "npd", "npde"))
+  )
+
+})
+
+
+test_that("npde results are correct", {
+  #skip_on_cran()
+
+  obs <- obs_data[MDV==0]
+  sim <- sim_data[MDV==0]
+
+  npde <- observed(obs, x=NULL, y=DV)
+  npde <- simulated(npde, sim, y=DV)
+  npde <- npde(npde, id=ID)
+
+  location=system.file("extdata/NPDE","npdeobs.csv", package="tidyvpc")
+
+  stats <- fread(location)
+
+  testthat::expect_equal(npde$npdeobs, stats)
+
+  vpc <- observed(npde$npdeobs, x=epred, y=npde) 
+  vpc <- simulated(vpc, npde$npdesim, y=npde)
+  vpc <- binning(vpc, "eqcut", nbins=10)
+  vpc <- vpcstats(vpc)
+
+  testthat::expect_true(class(vpc)[1]=="tidyvpcobj")
+
+  vpc_plot <- tidyvpc:::plot.tidyvpcobj(vpc, point.alpha = 0.25)
+
+  testthat::expect_true(class(vpc_plot)[1]=="gg")
+
+})