tests/testthat/test-cTMed-boot-med-std.R

In cTMed: Continuous-Time Mediation

## ---- test-cTMed-boot-med-std
lapply(
  X = 1,
  FUN = function(i,
                 text,
                 tol) {
    message(text)
    testthat::test_that(
      paste(text, "BootMedStd"),
      {
        testthat::skip_on_cran()
        total <- 0.0854
        direct <- -0.3429
        indirect <- 0.4283
        answer <- c(
          total,
          direct,
          indirect
        )
        phi <- matrix(
          data = c(
            -0.357, 0.771, -0.450,
            0.0, -0.511, 0.729,
            0, 0, -0.693
          ),
          nrow = 3
        )
        colnames(phi) <- rownames(phi) <- c("x", "m", "y")
        sigma <- matrix(
          data = c(
            0.24455556, 0.02201587, -0.05004762,
            0.02201587, 0.07067800, 0.01539456,
            -0.05004762, 0.01539456, 0.07553061
          ),
          nrow = 3
        )
        vcov_theta <- matrix(
          data = c(
            0.00843, 0.00040, -0.00151, -0.00600, -0.00033,
            0.00110, 0.00324, 0.00020, -0.00061, -0.00115,
            0.00011, 0.00015, 0.00001, -0.00002, -0.00001,
            0.00040, 0.00374, 0.00016, -0.00022, -0.00273,
            -0.00016, 0.00009, 0.00150, 0.00012, -0.00010,
            -0.00026, 0.00002, 0.00012, 0.00004, -0.00001,
            -0.00151, 0.00016, 0.00389, 0.00103, -0.00007,
            -0.00283, -0.00050, 0.00000, 0.00156, 0.00021,
            -0.00005, -0.00031, 0.00001, 0.00007, 0.00006,
            -0.00600, -0.00022, 0.00103, 0.00644, 0.00031,
            -0.00119, -0.00374, -0.00021, 0.00070, 0.00064,
            -0.00015, -0.00005, 0.00000, 0.00003, -0.00001,
            -0.00033, -0.00273, -0.00007, 0.00031, 0.00287,
            0.00013, -0.00014, -0.00170, -0.00012, 0.00006,
            0.00014, -0.00001, -0.00015, 0.00000, 0.00001,
            0.00110, -0.00016, -0.00283, -0.00119, 0.00013,
            0.00297, 0.00063, -0.00004, -0.00177, -0.00013,
            0.00005, 0.00017, -0.00002, -0.00008, 0.00001,
            0.00324, 0.00009, -0.00050, -0.00374, -0.00014,
            0.00063, 0.00495, 0.00024, -0.00093, -0.00020,
            0.00006, -0.00010, 0.00000, -0.00001, 0.00004,
            0.00020, 0.00150, 0.00000, -0.00021, -0.00170,
            -0.00004, 0.00024, 0.00214, 0.00012, -0.00002,
            -0.00004, 0.00000, 0.00006, -0.00005, -0.00001,
            -0.00061, 0.00012, 0.00156, 0.00070, -0.00012,
            -0.00177, -0.00093, 0.00012, 0.00223, 0.00004,
            -0.00002, -0.00003, 0.00001, 0.00003, -0.00013,
            -0.00115, -0.00010, 0.00021, 0.00064, 0.00006,
            -0.00013, -0.00020, -0.00002, 0.00004, 0.00057,
            0.00001, -0.00009, 0.00000, 0.00000, 0.00001,
            0.00011, -0.00026, -0.00005, -0.00015, 0.00014,
            0.00005, 0.00006, -0.00004, -0.00002, 0.00001,
            0.00012, 0.00001, 0.00000, -0.00002, 0.00000,
            0.00015, 0.00002, -0.00031, -0.00005, -0.00001,
            0.00017, -0.00010, 0.00000, -0.00003, -0.00009,
            0.00001, 0.00014, 0.00000, 0.00000, -0.00005,
            0.00001, 0.00012, 0.00001, 0.00000, -0.00015,
            -0.00002, 0.00000, 0.00006, 0.00001, 0.00000,
            0.00000, 0.00000, 0.00010, 0.00001, 0.00000,
            -0.00002, 0.00004, 0.00007, 0.00003, 0.00000,
            -0.00008, -0.00001, -0.00005, 0.00003, 0.00000,
            -0.00002, 0.00000, 0.00001, 0.00005, 0.00001,
            -0.00001, -0.00001, 0.00006, -0.00001, 0.00001,
            0.00001, 0.00004, -0.00001, -0.00013, 0.00001,
            0.00000, -0.00005, 0.00000, 0.00001, 0.00012
          ),
          nrow = 15
        )
        delta_t <- 2
        R <- 1000
        mc <- MCPhiSigma(
          phi = phi,
          sigma = sigma,
          vcov_theta = vcov_theta,
          R = R,
          seed = 42
        )$output
        mc_phi <- lapply(
          X = mc,
          FUN = function(i) {
            i[[1]]
          }
        )
        mc_sigma <- lapply(
          X = mc,
          FUN = function(i) {
            i[[2]]
          }
        )
        boot <- BootMedStd(
          phi = mc_phi,
          sigma = mc_sigma,
          phi_hat = phi,
          sigma_hat = sigma,
          delta_t = delta_t,
          from = "x",
          to = "y",
          med = "m"
        )
        testthat::expect_true(
          all(
            (
              answer - summary(boot)$est
            ) <= tol
          )
        )
      }
    )
    testthat::test_that(
      paste(text, "plot error"),
      {
        testthat::skip_on_cran()
        total <- 0.0854
        direct <- -0.3429
        indirect <- 0.4283
        answer <- c(
          total,
          direct,
          indirect
        )
        phi <- matrix(
          data = c(
            -0.357, 0.771, -0.450,
            0.0, -0.511, 0.729,
            0, 0, -0.693
          ),
          nrow = 3
        )
        colnames(phi) <- rownames(phi) <- c("x", "m", "y")
        sigma <- matrix(
          data = c(
            0.24455556, 0.02201587, -0.05004762,
            0.02201587, 0.07067800, 0.01539456,
            -0.05004762, 0.01539456, 0.07553061
          ),
          nrow = 3
        )
        vcov_theta <- matrix(
          data = c(
            0.00843, 0.00040, -0.00151, -0.00600, -0.00033,
            0.00110, 0.00324, 0.00020, -0.00061, -0.00115,
            0.00011, 0.00015, 0.00001, -0.00002, -0.00001,
            0.00040, 0.00374, 0.00016, -0.00022, -0.00273,
            -0.00016, 0.00009, 0.00150, 0.00012, -0.00010,
            -0.00026, 0.00002, 0.00012, 0.00004, -0.00001,
            -0.00151, 0.00016, 0.00389, 0.00103, -0.00007,
            -0.00283, -0.00050, 0.00000, 0.00156, 0.00021,
            -0.00005, -0.00031, 0.00001, 0.00007, 0.00006,
            -0.00600, -0.00022, 0.00103, 0.00644, 0.00031,
            -0.00119, -0.00374, -0.00021, 0.00070, 0.00064,
            -0.00015, -0.00005, 0.00000, 0.00003, -0.00001,
            -0.00033, -0.00273, -0.00007, 0.00031, 0.00287,
            0.00013, -0.00014, -0.00170, -0.00012, 0.00006,
            0.00014, -0.00001, -0.00015, 0.00000, 0.00001,
            0.00110, -0.00016, -0.00283, -0.00119, 0.00013,
            0.00297, 0.00063, -0.00004, -0.00177, -0.00013,
            0.00005, 0.00017, -0.00002, -0.00008, 0.00001,
            0.00324, 0.00009, -0.00050, -0.00374, -0.00014,
            0.00063, 0.00495, 0.00024, -0.00093, -0.00020,
            0.00006, -0.00010, 0.00000, -0.00001, 0.00004,
            0.00020, 0.00150, 0.00000, -0.00021, -0.00170,
            -0.00004, 0.00024, 0.00214, 0.00012, -0.00002,
            -0.00004, 0.00000, 0.00006, -0.00005, -0.00001,
            -0.00061, 0.00012, 0.00156, 0.00070, -0.00012,
            -0.00177, -0.00093, 0.00012, 0.00223, 0.00004,
            -0.00002, -0.00003, 0.00001, 0.00003, -0.00013,
            -0.00115, -0.00010, 0.00021, 0.00064, 0.00006,
            -0.00013, -0.00020, -0.00002, 0.00004, 0.00057,
            0.00001, -0.00009, 0.00000, 0.00000, 0.00001,
            0.00011, -0.00026, -0.00005, -0.00015, 0.00014,
            0.00005, 0.00006, -0.00004, -0.00002, 0.00001,
            0.00012, 0.00001, 0.00000, -0.00002, 0.00000,
            0.00015, 0.00002, -0.00031, -0.00005, -0.00001,
            0.00017, -0.00010, 0.00000, -0.00003, -0.00009,
            0.00001, 0.00014, 0.00000, 0.00000, -0.00005,
            0.00001, 0.00012, 0.00001, 0.00000, -0.00015,
            -0.00002, 0.00000, 0.00006, 0.00001, 0.00000,
            0.00000, 0.00000, 0.00010, 0.00001, 0.00000,
            -0.00002, 0.00004, 0.00007, 0.00003, 0.00000,
            -0.00008, -0.00001, -0.00005, 0.00003, 0.00000,
            -0.00002, 0.00000, 0.00001, 0.00005, 0.00001,
            -0.00001, -0.00001, 0.00006, -0.00001, 0.00001,
            0.00001, 0.00004, -0.00001, -0.00013, 0.00001,
            0.00000, -0.00005, 0.00000, 0.00001, 0.00012
          ),
          nrow = 15
        )
        delta_t <- 2
        R <- 1000
        mc <- MCPhiSigma(
          phi = phi,
          sigma = sigma,
          vcov_theta = vcov_theta,
          R = R,
          seed = 42
        )$output
        mc_phi <- lapply(
          X = mc,
          FUN = function(i) {
            i[[1]]
          }
        )
        mc_sigma <- lapply(
          X = mc,
          FUN = function(i) {
            i[[2]]
          }
        )
        boot <- BootMedStd(
          phi = mc_phi,
          sigma = mc_sigma,
          phi_hat = phi,
          sigma_hat = sigma,
          delta_t = 1:5,
          from = "x",
          to = "y",
          med = "m"
        )
        print(boot)
        summary(boot)
        confint(boot)
        plot(boot)
        print(boot, type = "bc")
        summary(boot, type = "bc")
        confint(boot, type = "bc")
        plot(boot, type = "bc")
        boot <- BootMedStd(
          phi = mc_phi,
          sigma = mc_sigma,
          phi_hat = phi,
          sigma_hat = sigma,
          delta_t = 1,
          from = "x",
          to = "y",
          med = "m"
        )
        print(boot)
        summary(boot)
        confint(boot, level = 0.95)
        print(boot, type = "bc")
        summary(boot, type = "bc")
        confint(boot, type = "bc", level = 0.95)
        testthat::expect_error(
          plot(boot)
        )
      }
    )
  },
  text = "test-cTMed-boot-med-std",
  tol = 0.01
)