Fix posterior_predict.stanemaxbin

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: rstanemax
-Version: 0.1.6
+Version: 0.1.6.1
 Title: Emax Model Analysis with 'Stan'
 Description: Perform sigmoidal Emax model fit using 'Stan' in a formula notation, without writing 'Stan' model code.
 Authors@R: c(

NEWS.md

@@ -1,4 +1,11 @@
 
+# rstanemax 0.1.6.1
+
+## Patch release
+
+* Fix match.arg(newDataType) for posterior_predict.stanemaxbin 
+* Correctly return prediction for posterior_predict.stanemaxbin
+
 # rstanemax 0.1.6
 
 ## Major changes

R/posterior_predict.R

@@ -33,13 +33,16 @@ rstantools::posterior_predict
 #'
 #' For continuous endpoint model ([stan_emax()]),
 #'
-#' - `respHat`: prediction without considering residual variability and is intended to provide credible interval of "mean" response.
-#' - `response`: include residual variability in its calculation, therefore the range represents prediction interval of observed response.
+#' - `.linpred` & `.epred`: prediction without considering residual variability and is intended to provide credible interval of "mean" response.
+#' - `.prediction`: include residual variability in its calculation, therefore the range represents prediction interval of observed response.
+#' - (deprecated) `respHat`: replaced by `.linpred` & `.epred`
+#' - (deprecated) `response`: replaced by `.prediction`
 #'
 #' For binary endpoint model ([stan_emax_binary()]),
 #'
 #' - `.linpred`: predicted probability on logit scale
 #' - `.epred`: predicted probability on probability scale
+#' - `.prediction`: predicted event (1) or non-event (0)
 #'
 #' The return object also contains exposure and parameter values used for calculation.
 NULL
@@ -126,6 +129,7 @@ posterior_predict.stanemaxbin <- function(
     newDataType = c("raw", "modelframe"),
     ...) {
   returnType <- match.arg(returnType)
+  newDataType <- match.arg(newDataType)
 
   if (is.null(newdata)) {
     df.model <- object$prminput$df.model
@@ -158,7 +162,7 @@ posterior_predict.stanemaxbin <- function(
     )
 
   if (returnType == "matrix") {
-    return(matrix(pred.response$.epred, ncol = nrow(df.model), byrow = TRUE))
+    return(matrix(pred.response$.prediction, ncol = nrow(df.model), byrow = TRUE))
   } else if (returnType == "dataframe") {
     return(as.data.frame(pred.response))
   } else if (returnType == "tibble") {
@@ -191,13 +195,19 @@ pp_calc <- function(stanfit, df.model,
         respHat = e0 + emax * exposure^gamma / (ec50^gamma + exposure^gamma),
         response = stats::rnorm(respHat, respHat, sigma)
       ) %>%
+      dplyr::mutate(
+        .linpred = respHat,
+        .epred = respHat,
+        .prediction = response
+      ) %>%
       dplyr::select(mcmcid, exposure, dplyr::everything())
   } else if (mod_type == "stanemaxbin") {
     out <-
       df %>%
       dplyr::mutate(
         .linpred = e0 + emax * exposure^gamma / (ec50^gamma + exposure^gamma),
-        .epred = 1 / (1 + exp(-.linpred))
+        .epred = 1 / (1 + exp(-.linpred)),
+        .prediction = stats::rbinom(.epred, 1, .epred)
       ) %>%
       dplyr::select(mcmcid, exposure, dplyr::everything())
   }

tests/testthat/test-posterior_predict.R

@@ -76,7 +76,7 @@ test_that("posterior prediction with new data with covariates", {
 
   # Make sure posterior_predict works with covariates
   test.pp.tibble <- posterior_predict.stanemax(test.fit.2cov, newdata = test.data.short, returnType = "tibble")
-  expect_equal(dim(test.pp.tibble), c(30000, 13))
+  expect_equal(dim(test.pp.tibble), c(30000, 16))
 
   # Make sure data is not re-sorted
   expect_equal(

tests/testthat/test-stan_emax_binary.R

@@ -31,6 +31,7 @@ test_that("emax model run", {
 
 
 test_that("posterior prediction with original data", {
+  set.seed(1234)
   test.pp.matrix <- posterior_predict(test.fit2)
   test.pp.df <- posterior_predict(test.fit2, returnType = "dataframe")