test-rhat.R
In mcmcr: Manipulate MCMC Samples

test_that("rhat.matrix", {
  matrix <- matrix(1, nrow = 2, ncol = 100)
  expect_identical(.rhat(matrix, na_rm = FALSE), 1)
  matrix[1, 1] <- NA
  expect_true(is.na(.rhat(matrix, na_rm = FALSE)))
  expect_identical(.rhat(matrix, na_rm = TRUE), 1)
  matrix[1, ] <- 2
  expect_true(is.infinite(.rhat(matrix, na_rm = FALSE)))

  matrix <- matrix(rep(1, 50), rep(2, 50), nrow = 1, ncol = 100)
  expect_true(is.na(.rhat(matrix, na_rm = FALSE)))
  matrix[1, 1] <- 1.1
  matrix[1, 100] <- 2.1
  expect_true(is.na(.rhat(matrix, na_rm = FALSE)))

  matrix <- matrix(NA_real_, nrow = 2, ncol = 100)
  expect_true(is.na(.rhat(matrix, na_rm = FALSE)))
  expect_true(is.na(.rhat(matrix, na_rm = TRUE)))
})

test_that("rhat.mcarry", {
  expect_identical(rhat(as.mcarray(mcmcr_example$beta)), 1.147)
})

test_that("rhat.mcmc", {
  expect_identical(rhat(coda::as.mcmc(collapse_chains(mcmcr_example$beta))), 1)
})

test_that("rhat.mcmc.list", {
  expect_identical(rhat(coda::as.mcmc.list(mcmcr_example)), 2.002)
})

test_that("rhat.mcmcmarray", {
  expect_identical(rhat(mcmcr_example[[1]], by = "term"), c(2.002, 2.002))

  expect_identical(
    rhat(mcmcr_example[[1]], as_df = TRUE, by = "all"),
    structure(
      list(parameter = "parameter", rhat = 2.002),
      class = c("tbl_df", "tbl", "data.frame"),
      row.names = c(NA, -1L)
    )
  )

  expect_equal(
    rhat(mcmcr_example[[2]], by = "term"),
    matrix(c(1.147, 1.147, 1.147, 1.147), nrow = 2, ncol = 2)
  )

  expect_identical(rhat(mcmcr_example[[2]]), 1.147)
  expect_equal(
    rhat(mcmcr_example[[2]], by = "term", as_df = TRUE)$term,
    as_term(c(
      "parameter[1,1]",
      "parameter[2,1]",
      "parameter[1,2]",
      "parameter[2,2]"
    ))
  )
  expect_equal(
    rhat(mcmcr_example[[2]], by = "term", as_df = TRUE)$rhat,
    c(1.147, 1.147, 1.147, 1.147)
  )

  expect_identical(
    rhat(
      subset(mcmcr_example[[2]], iters = 1L),
      by = "term",
      as_df = TRUE
    )$rhat,
    rep(NA_real_, 4)
  )
  expect_identical(
    rhat(mcmcr_example[[1]], "parameter"),
    rhat(mcmcr_example[[1]], "all")
  )
})

test_that("rhat.mcmcr", {
  expect_identical(rhat(mcmcr_example2), 2.002)
  expect_identical(
    rhat(mcmcr_example, as_df = TRUE),
    structure(
      list(all = "all", rhat = 2.002),
      class = c("tbl_df", "tbl", "data.frame"),
      row.names = c(NA, -1L)
    )
  )

  expect_identical(rhat(mcmcr_example), 2.002)
  expect_identical(
    rhat(mcmcr_example, by = "parameter"),
    list(alpha = 2.002, beta = 1.147, sigma = 1)
  )
  expect_equal(
    rhat(mcmcr_example, by = "parameter", as_df = TRUE),
    tibble(parameter = c("alpha", "beta", "sigma"), rhat = c(2.002, 1.147, 1)),
    ignore_attr = FALSE
  )
  expect_equal(
    rhat(mcmcr_example, by = "term"),
    list(
      alpha = c(2.002, 2.002),
      beta = matrix(c(1.147, 1.147, 1.147, 1.147), nrow = 2.002, ncol = 2),
      sigma = 1
    )
  )
  expect_equal(
    rhat(mcmcr_example, by = "term", as_df = TRUE),
    tibble(
      term = as_term(c(
        "alpha[1]",
        "alpha[2]",
        "beta[1,1]",
        "beta[2,1]",
        "beta[1,2]",
        "beta[2,2]",
        "sigma"
      )),
      rhat = c(2.002, 2.002, 1.147, 1.147, 1.147, 1.147, 1)
    )
  )
})

test_that("rhat.mcmcr NA", {
  x <- mcmcr:::mcmcr_example2
  x$alpha[1, 1, 1, 1, 1] <- NA_real_
  expect_identical(rhat(x), NA_real_)
  expect_identical(rhat(x, na_rm = TRUE), 2.085)
  expect_identical(
    rhat(x, by = "parameter"),
    list(alpha = NA_real_, beta = 1.147, sigma = 1)
  )
  expect_identical(
    rhat(x, by = "parameter", na_rm = TRUE),
    list(alpha = 2.085, beta = 1.147, sigma = 1)
  )
})

test_that("rhat.mcmcrs", {
  expect_identical(
    rhat(
      mcmcrs(mcmcr_example, mcmcr_example)
    ),
    list(mcmcr1 = 2.002, mcmcr2 = 2.002)
  )

  lifecycle::expect_deprecated(
    expect_identical(
      rhat(mcmcrs(mcmcr_example, mcmcr_example), bound = TRUE),
      list(mcmcr1 = 2.002, mcmcr2 = 2.002, bound = 1.891)
    ),
    regexp = "`rhat.mcmcrs\\(x, bound = TRUE\\)` returns scalar was deprecated in mcmcr 0.6.1.9001."
  )

  expect_identical(
    rhat(mcmcrs(mcmcr_example, mcmcr_example), by = "parameter"),
    list(
      mcmcr1 = list(alpha = 2.002, beta = 1.147, sigma = 1),
      mcmcr2 = list(alpha = 2.002, beta = 1.147, sigma = 1)
    )
  )

  lifecycle::expect_deprecated(
    expect_identical(
      rhat(
        mcmcrs(mcmcr_example, mcmcr_example),
        bound = TRUE,
        by = "parameter"
      ),
      list(
        mcmcr1 = list(alpha = 2.002, beta = 1.147, sigma = 1),
        mcmcr2 = list(alpha = 2.002, beta = 1.147, sigma = 1),
        bound = list(alpha = 1.891, beta = 1.127, sigma = 1)
      )
    ),
    regexp = "`rhat.mcmcrs\\(x, bound = TRUE\\)` returns scalar was deprecated in mcmcr 0.6.1.9001."
  )

  lifecycle::expect_deprecated(
    expect_identical(
      rhat(mcmcrs(mcmcr_example, mcmcr_example), bound = TRUE, as_df = TRUE),
      structure(
        list(all = "all", mcmcr1 = 2.002, mcmcr2 = 2.002, bound = 1.891),
        class = "data.frame",
        row.names = c(NA, -1L)
      )
    ),
    regexp = "`rhat.mcmcrs\\(x, bound = TRUE\\)` returns scalar was deprecated in mcmcr 0.6.1.9001."
  )

  lifecycle::expect_deprecated(
    expect_identical(
      rhat(
        mcmcrs(mcmcr_example, mcmcr_example),
        by = "parameter",
        bound = TRUE,
        as_df = TRUE
      ),
      structure(
        list(
          parameter = c("alpha", "beta", "sigma"),
          mcmcr1 = c(2.002, 1.147, 1),
          mcmcr2 = c(2.002, 1.147, 1),
          bound = c(1.891, 1.127, 1)
        ),
        class = "data.frame",
        row.names = c(NA, -3L)
      )
    ),
    regexp = "`rhat.mcmcrs\\(x, bound = TRUE\\)` returns scalar was deprecated in mcmcr 0.6.1.9001."
  )

  lifecycle::expect_deprecated(
    expect_identical(
      rhat(
        mcmcrs(mcmcr_example, mcmcr_example),
        by = "term",
        bound = TRUE,
        as_df = TRUE
      ),
      structure(
        list(
          term = structure(
            c(
              "alpha[1]",
              "alpha[2]",
              "beta[1,1]",
              "beta[2,1]",
              "beta[1,2]",
              "beta[2,2]",
              "sigma"
            ),
            class = c("term", "vctrs_vctr")
          ),
          mcmcr1 = c(2.002, 2.002, 1.147, 1.147, 1.147, 1.147, 1),
          mcmcr2 = c(2.002, 2.002, 1.147, 1.147, 1.147, 1.147, 1),
          bound = c(1.891, 1.891, 1.127, 1.127, 1.127, 1.127, 1)
        ),
        class = "data.frame",
        row.names = c(NA, -7L)
      )
    ),
    regexp = "`rhat.mcmcrs\\(x, bound = TRUE\\)` returns scalar was deprecated in mcmcr 0.6.1.9001."
  )
})