test-summary.R
In predint: Prediction Intervals

test_that("test summary() for normalPI", {


        # fit the model
        fit <- lme4::lmer(y_ijk~(1|a)+(1|b)+(1|a:b), c2_dat1)


        #-----------------------------------------------------------------------
        # Calculate the PI using c2_dat2 as newdat
        pred_int_npi <- lmer_pi_futmat(model=fit,
                                   newdat=c2_dat2,
                                   alternative="both",
                                   nboot=100,
                                   traceplot=FALSE)
        # Save the summary
        sum_futmat <- summary(pred_int_npi)

        # data.frame
        expect_true(is.data.frame(sum_futmat))

        # ncol ok?
        expect_equal(ncol(sum_futmat), 9)

        # nrow ok?
        expect_equal(nrow(sum_futmat), 21)

        # variable names ok?
        expect_equal(names(sum_futmat),
                     c("y_ijk",
                       "a",
                       "b",
                       "lower",
                       "upper",
                       "y_star_hat",
                       "q",
                       "pred_se",
                       "cover" ))

        # change row names
        sum_futmat_npi_1 <- summary(pred_int_npi,
                                row.names=21:1)

        expect_true(all(rownames(sum_futmat_npi_1) == 21:1))

        # Check if the print works fine
        expect_output(summary(pred_int_npi),
                      "Simultanious 95 % prediction interval for 21 future observations")

        expect_output(summary(pred_int_npi),
                      "All future observations are covered")

        expect_output(summary(pred_int_npi),
                      "Bootstrap calibration was done following Menssen and Schaarschmidt 2022")

        #-----------------------------------------------------------------------
        # Lower bounds with newdat
        pred_int_nl <- lmer_pi_futmat(model=fit,
                                      newdat=c2_dat2,
                                      alternative="lower",
                                      nboot=100,
                                      traceplot=FALSE)

        # Sumary
        sum_int_nl <- summary(pred_int_nl)

        # data.frame
        expect_true(is.data.frame(sum_int_nl))

        # ncol ok?
        expect_equal(ncol(sum_int_nl), 8)

        # nrow ok?
        expect_equal(nrow(sum_int_nl), 21)

        # variable names ok?
        expect_equal(names(sum_int_nl),
                     c("y_ijk",
                       "a",
                       "b",
                       "lower",
                       # "upper",
                       "y_star_hat",
                       "q",
                       "pred_se",
                       "cover" ))

        # Check if the print works fine
        expect_output(summary(pred_int_nl),
                      "One-sided simultanious 95 % lower prediction limit for 21 future observations")

        expect_output(summary(pred_int_nl),
                      "All future observations are covered")

        expect_output(summary(pred_int_nl),
                      "Bootstrap calibration was done following Menssen and Schaarschmidt 2022")

        #-----------------------------------------------------------------------
        # Lower bounds with newdat
        pred_int_ul <- lmer_pi_futmat(model=fit,
                                      newdat=c2_dat2,
                                      alternative="upper",
                                      nboot=100,
                                      traceplot=FALSE)

        # Sumary
        sum_int_ul <- summary(pred_int_ul)

        # data.frame
        expect_true(is.data.frame(sum_int_ul))

        # ncol ok?
        expect_equal(ncol(sum_int_ul), 8)

        # nrow ok?
        expect_equal(nrow(sum_int_ul), 21)

        # variable names ok?
        expect_equal(names(sum_int_ul),
                     c("y_ijk",
                       "a",
                       "b",
                       # "lower",
                       "upper",
                       "y_star_hat",
                       "q",
                       "pred_se",
                       "cover" ))

        # Check if the print works fine
        expect_output(summary(pred_int_ul),
                      "One-sided simultanious 95 % upper prediction limit for 21 future observations")

        expect_output(summary(pred_int_ul),
                      "All future observations are covered")

        expect_output(summary(pred_int_ul),
                      "Bootstrap calibration was done following Menssen and Schaarschmidt 2022")


        #-----------------------------------------------------------------------
        # PI for m=1

        pred_int_pi1 <- lmer_pi_futmat(model=fit,
                                       newdat=1,
                                       alternative="both",
                                       nboot=100,
                                       traceplot=FALSE)

        # Save the summary
        sum_futmat_pi1 <- summary(pred_int_pi1)

        # data.frame
        expect_true(is.data.frame(sum_futmat_pi1))

        # ncol ok?
        expect_equal(ncol(sum_futmat_pi1), 5)

        # nrow ok?
        expect_equal(nrow(sum_futmat_pi1), 1)

        # variable names ok?
        expect_equal(names(sum_futmat_pi1),
                     c("lower",
                       "upper",
                       "y_star_hat",
                       "q",
                       "pred_se"))

        # Check if the print works fine
        expect_output(summary(pred_int_pi1),
                      "Pointwise 95 % prediction interval for one future observation")

        expect_output(summary(pred_int_pi1),
                      "Bootstrap calibration was done following Menssen and Schaarschmidt 2022")

        #-----------------------------------------------------------------------
        # lower bound for m=1

        pred_int_l1 <- lmer_pi_futmat(model=fit,
                                      newdat=1,
                                      alternative="lower",
                                      nboot=100,
                                      traceplot=FALSE)

        # Save the summary
        sum_futmat_pi1 <- summary(pred_int_l1)

        # data.frame
        expect_true(is.data.frame(sum_futmat_pi1))

        # ncol ok?
        expect_equal(ncol(sum_futmat_pi1), 4)

        # nrow ok?
        expect_equal(nrow(sum_futmat_pi1), 1)

        # variable names ok?
        expect_equal(names(sum_futmat_pi1),
                     c("lower",
                       "y_star_hat",
                       "q",
                       "pred_se"))

        # Check if the print works fine
        expect_output(summary(pred_int_l1),
                      "One-sided pointwise 95 % lower prediction limit for one future observation")

        expect_output(summary(pred_int_l1),
                      "Bootstrap calibration was done following Menssen and Schaarschmidt 2022")

        #-----------------------------------------------------------------------
        # upper bound for m=1

        pred_int_u1 <- lmer_pi_futmat(model=fit,
                                      newdat=1,
                                      alternative="upper",
                                      nboot=100,
                                      traceplot=FALSE)

        # Save the summary
        sum_futmat_pi1 <- summary(pred_int_u1)

        # data.frame
        expect_true(is.data.frame(sum_futmat_pi1))

        # ncol ok?
        expect_equal(ncol(sum_futmat_pi1), 4)

        # nrow ok?
        expect_equal(nrow(sum_futmat_pi1), 1)

        # variable names ok?
        expect_equal(names(sum_futmat_pi1),
                     c("upper",
                       "y_star_hat",
                       "q",
                       "pred_se"))

        # Check if the print works fine
        expect_output(summary(pred_int_u1),
                      "One-sided pointwise 95 % upper prediction limit for one future observation")

        expect_output(summary(pred_int_u1),
                      "Bootstrap calibration was done following Menssen and Schaarschmidt 2022")

        #-----------------------------------------------------------------------

        fml <- vector(length=4, "list")

        names(fml) <- c("a:b", "b", "a", "Residual")

        fml[["a:b"]] <- matrix(nrow=6, ncol=2, data=c(1,1,0,0,0,0, 0,0,1,1,1,1))

        fml[["b"]] <- matrix(nrow=6, ncol=1, data=c(1,1,1,1,1,1))

        fml[["a"]] <- matrix(nrow=6, ncol=2, data=c(1,1,0,0,0,0, 0,0,1,1,1,1))

        fml[["Residual"]] <- diag(6)

        fml

        pred_int_fml_pi <- lmer_pi_futmat(model=fit,
                                          futmat_list=fml,
                                          alternative="both",
                                          nboot=100,
                                          traceplot = FALSE)

        sum_futmat_fml_pi <- summary(pred_int_fml_pi)

        # data.frame
        expect_true(is.data.frame(sum_futmat_fml_pi))

        # ncol ok?
        expect_equal(ncol(sum_futmat_fml_pi), 5)

        # nrow ok?
        expect_equal(nrow(sum_futmat_fml_pi), 6)

        # variable names ok?
        expect_equal(names(sum_futmat_fml_pi),
                     c("lower",
                       "upper",
                       "y_star_hat",
                       "q",
                       "pred_se" ))


        # Check if the print works fine
        expect_output(summary(pred_int_fml_pi),
                      "Simultanious 95 % prediction interval for 6 future observations")

        expect_output(summary(pred_int_fml_pi),
                      "Bootstrap calibration was done following Menssen and Schaarschmidt 2022")
})


test_that("test summary() for binomial PI)", {

        # Calculate the PI using c2_dat2 as newdat
        pred_int_bb_pi <- beta_bin_pi(histdat=bb_dat1,
                                      newdat=bb_dat2,
                                      nboot=1000,
                                      traceplot = FALSE)

        # Save the summary
        sum_futmat_bb_pi <- summary(pred_int_bb_pi)

        # data.frame
        expect_true(is.data.frame(sum_futmat_bb_pi))

        # ncol ok?
        expect_equal(ncol(sum_futmat_bb_pi), 10)

        # nrow ok?
        expect_equal(nrow(sum_futmat_bb_pi), 3)

        # variable names ok?
        expect_equal(names(sum_futmat_bb_pi),
                     c("succ",
                       "fail",
                       "newsize",
                       "lower",
                       "upper",
                       "y_star_hat",
                       "ql",
                       "qu",
                       "pred_se",
                       "cover"))

        # Check if the print works fine
        expect_output(summary(pred_int_bb_pi),
                      "Simultanious 95 % prediction intervals for 3 future observations")

        expect_output(summary(pred_int_bb_pi),
                      "All future observations are covered")

        expect_output(summary(pred_int_bb_pi),
                      "modiefied version of Menssen and Schaarschmidt 2022")

        #-----------------------------------------------------------------------

        # Calculate the PI using c2_dat2 as newdat
        pred_int_bb_pi_30 <- beta_bin_pi(histdat=bb_dat1,
                                         newsize=30,
                                         nboot=1000,
                                         traceplot = FALSE)

        # Save the summary
        sum_futmat_bb_pi_30 <- summary(pred_int_bb_pi_30)

        # data.frame
        expect_true(is.data.frame(sum_futmat_bb_pi_30))

        # ncol ok?
        expect_equal(ncol(sum_futmat_bb_pi_30), 7)

        # nrow ok?
        expect_equal(nrow(sum_futmat_bb_pi_30), 1)

        # variable names ok?
        expect_equal(names(sum_futmat_bb_pi_30),
                     c("lower",
                       "upper",
                       "newsize",
                       "y_star_hat",
                       "ql",
                       "qu",
                       "pred_se"))

        # Check if the print works fine
        expect_output(summary(pred_int_bb_pi_30),
                      "Pointwise 95 % prediction interval for one future observation")

        expect_output(summary(pred_int_bb_pi_30),
                      "modiefied version of Menssen and Schaarschmidt 2022")

})


test_that("test summary() for Poisson PI)", {

        # Calculate the PI using c2_dat2 as newdat
        pred_int_qp_pi <- quasi_pois_pi(histdat=qp_dat1,
                                        newdat=qp_dat2,
                                        nboot=1000,
                                        traceplot = FALSE)

        # Save the summary
        sum_futmat_qp_pi <- summary(pred_int_qp_pi)

        # data.frame
        expect_true(is.data.frame(sum_futmat_qp_pi))

        # ncol ok?
        expect_equal(ncol(sum_futmat_qp_pi), 9)

        # nrow ok?
        expect_equal(nrow(sum_futmat_qp_pi), 3)

        # variable names ok?
        expect_equal(names(sum_futmat_qp_pi),
                     c("y",
                       "offset",
                       "lower",
                       "upper",
                       "y_star_hat",
                       "ql",
                       "qu",
                       "pred_se",
                       "cover"))

        # Check if the print works fine
        expect_output(summary(pred_int_qp_pi),
                      "Simultanious 95 % prediction intervals for 3 future observations")

        expect_output(summary(pred_int_qp_pi),
                      "All future observations are covered")

        expect_output(summary(pred_int_qp_pi),
                      "modiefied version of Menssen and Schaarschmidt 2022")

        #-----------------------------------------------------------------------

        # Calculate the PI using c2_dat2 as newdat
        pred_int_qp_pi_3 <- quasi_pois_pi(histdat=qp_dat1,
                                           newoffset=3,
                                           nboot=1000,
                                           traceplot = FALSE)

        # Save the summary
        sum_futmat_qp_pi_3 <- summary(pred_int_qp_pi_3)

        # data.frame
        expect_true(is.data.frame(sum_futmat_qp_pi_3))

        # ncol ok?
        expect_equal(ncol(sum_futmat_qp_pi_3), 7)

        # nrow ok?
        expect_equal(nrow(sum_futmat_qp_pi_3), 1)

        # variable names ok?
        expect_equal(names(sum_futmat_qp_pi_3),
                     c("lower",
                       "upper",
                       "newoffset",
                       "y_star_hat",
                       "ql",
                       "qu",
                       "pred_se"))

        # Check if the print works fine
        expect_output(summary(pred_int_qp_pi_3),
                      "Pointwise 95 % prediction interval for one future observation")

        expect_output(summary(pred_int_qp_pi_3),
                      "modiefied version of Menssen and Schaarschmidt 2022")

})