tests/testthat/test-zzz-coverage.R

## ---- test-zzz-coverage
lapply(
  X = 1,
  FUN = function(i,
                 text) {
    message(text)
    set.seed(42)
    df <- nas1982
    object <- lm(QUALITY ~ NARTIC + PCTGRT + PCTSUPP, data = df)
    lm_process <- betaMC:::.ProcessLM(object)
    print(
      betaMC:::.JacobianVechSigmaWRTTheta(
        beta = lm_process$beta,
        sigmacapx = lm_process$sigmacapx,
        q = lm_process$q,
        p = lm_process$p,
        rsq = NULL,
        fixed_x = FALSE
      )
    )
    print(
      betaMC:::.JacobianVechSigmaWRTTheta(
        beta = lm_process$beta,
        sigmacapx = lm_process$sigmacapx,
        q = lm_process$q,
        p = lm_process$p,
        rsq = NULL,
        fixed_x = TRUE
      )
    )
    print(
      betaMC:::.JacobianVechSigmaWRTTheta(
        beta = lm_process$beta,
        sigmacapx = lm_process$sigmacapx,
        q = lm_process$q,
        p = lm_process$p,
        rsq = lm_process$rsq[1],
        fixed_x = FALSE
      )
    )
    print(
      betaMC:::.JacobianVechSigmaWRTTheta(
        beta = lm_process$beta,
        sigmacapx = lm_process$sigmacapx,
        q = lm_process$q,
        p = lm_process$p,
        rsq = lm_process$rsq[1],
        fixed_x = TRUE
      )
    )
    betaMC:::.ThetaHatStar(
      scale = diag(2),
      location = c(0, 0),
      pd = FALSE
    )
    betaMC:::.ThetaHatStar(
      scale = matrix(
        data = c(1, -1, 1, 1),
        nrow = 2
      ),
      location = c(0, 0),
      pd = FALSE
    )
    betaMC:::.TestPositiveDefinite2(
      x = matrix(
        data = c(1, -1, 1, 1),
        nrow = 2
      )
    )
  },
  text = "test-zzz-coverage"
)

Try the betaMC package in your browser

Any scripts or data that you put into this service are public.

betaMC documentation built on June 24, 2024, 9:08 a.m.