Changed so it will predict with se.fit when needed

CollinErickson · Oct 30, 2017 · e599b7e · e599b7e
1 parent 0e43f90
commit e599b7e
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 1 deletion.
diff --git a/R/mbc.R b/R/mbc.R
@@ -306,8 +306,10 @@ mbc <- function(..., times=5, input, inputi, evaluator, post, target, targetin,
           } else {
             targetinj <- targetin
           }
-          po <- predict(po, targetinj)
+          po <- predict(po, targetinj, se.fit=any(c("t","mis90","sr27") %in% metric))
           # }
+        } else {
+          targetinj <- NULL
         }
         # Run
         if (!missing(target)) {
@@ -324,6 +326,7 @@ mbc <- function(..., times=5, input, inputi, evaluator, post, target, targetin,
           if ("t" %in% metric) {
               targetj <- if (is.function(target)) {target(j)}
               else if (is.list(target)) {target[[j]]}
+              else if (is.character(target) && !is.character(po) && (target%in%names(targetinj))) {targetinj[[target]]}
               else if (is.character(target) && !is.character(po)) {input[[target]]}
               else {target}
               po.mean <- if ("fit" %in% names(po)) po$fit else if ("mean" %in% names(po)) po$mean else {stop("Can't get fit/mean from post/out")}
@@ -336,6 +339,7 @@ mbc <- function(..., times=5, input, inputi, evaluator, post, target, targetin,
           if ("mis90" %in% metric) {
             targetj <- if (is.function(target)) {target(j)}
             else if (is.list(target)) {target[[j]]}
+            else if (is.character(target) && !is.character(po) && (target%in%names(targetinj))) {targetinj[[target]]}
             else if (is.character(target) && !is.character(po)) {input[[target]]}
             else {target}
             po.mean <- if ("fit" %in% names(po)) po$fit else if ("mean" %in% names(po)) po$mean else {stop("Can't get fit/mean from post/out")}
@@ -349,6 +353,7 @@ mbc <- function(..., times=5, input, inputi, evaluator, post, target, targetin,
           if ("sr27" %in% metric) {
             targetj <- if (is.function(target)) {target(j)}
             else if (is.list(target)) {target[[j]]}
+            else if (is.character(target) && !is.character(po) && (target%in%names(targetinj))) {targetinj[[target]]}
             else if (is.character(target) && !is.character(po)) {input[[target]]}
             else {target}
             po.mean <- if ("fit" %in% names(po)) po$fit else if ("mean" %in% names(po)) po$mean else {stop("Can't get fit/mean from post/out")}

diff --git a/tests/testthat/test_mbc.R b/tests/testthat/test_mbc.R
@@ -100,6 +100,7 @@ test_that("test mbc metrics", {
   expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=function(i) {ydf}, metric="mis90", post=function(mod){predict(mod, xdf,se=T)}), NA)
   expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=lapply(1:5, function(i)ydf), metric="mis90", post=function(mod){predict(mod, xdf,se=T)}), NA)
   expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target="ydf", metric="mis90", input=list(ydf=ydf, x1=xdf$x1, x2=xdf$x2, y1=y1),post=function(mod){predict(mod, xdf,se=T)}), NA)
+  expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), targetin=data.frame(ydf=ydf, x1=xdf$x1, x2=xdf$x2, y1=y1), target="ydf", metric="mis90", input=list(ydf=ydf, x1=xdf$x1, x2=xdf$x2, y1=y1)), NA)
 
   # t and mis90
   m1 <- mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=ydf, metric=c("t","mis90"), post=function(mod){predict(mod, xdf,se=T)})