options(mc.cores = 1)
options(loo.cores = NULL)
set.seed(123)

LLarr <- example_loglik_array()
LLmat <- example_loglik_matrix()
LLvec <- LLmat[, 1]
chain_id <- rep(1:2, each = dim(LLarr)[1])
r_eff_arr <- relative_eff(exp(LLarr))
r_eff_vec <- relative_eff(exp(LLvec), chain_id = chain_id)
psis1 <- psis(log_ratios = -LLarr, r_eff = r_eff_arr)
tis1 <- tis(log_ratios = -LLarr, r_eff = r_eff_arr)
is1 <- sis(log_ratios = -LLarr, r_eff = r_eff_arr)


test_that("tis and is runs", {
  LLvec[1] <- -10
  expect_silent(tis1 <- tis(log_ratios = -LLvec, r_eff = r_eff_vec))
  expect_silent(is1 <- sis(log_ratios = -LLvec, r_eff = r_eff_vec))
  expect_failure(expect_equal(tis1$log_weights, is1$log_weights))
  expect_failure(expect_equal(tis1$log_weights, psis1$log_weights))
})

test_that("tis() and sis() returns object with correct structure for tis/sis", {
  expect_false(is.psis(tis1))
  expect_false(is.psis(is1))
  expect_true(is.tis(tis1))
  expect_false(is.tis(is1))
  expect_false(is.sis(tis1))
  expect_true(is.sis(is1))

  expect_false(is.loo(tis1))
  expect_false(is.loo(is1))

  expect_false(is.psis_loo(tis1))
  expect_false(is.psis_loo(is1))

  expect_named(tis1, c("log_weights", "diagnostics"))
  expect_named(is1, c("log_weights", "diagnostics"))

  expect_named(tis1$diagnostics, c("pareto_k", "n_eff", "r_eff"))
  expect_named(is1$diagnostics, c("pareto_k", "n_eff", "r_eff"))

  expect_equal(dim(tis1), dim(LLmat))
  expect_equal(dim(is1), dim(LLmat))

  expect_length(tis1$diagnostics$pareto_k, dim(psis1)[2])
  expect_length(is1$diagnostics$pareto_k, dim(psis1)[2])

  expect_length(tis1$diagnostics$n_eff, dim(psis1)[2])
  expect_length(is1$diagnostics$n_eff, dim(psis1)[2])

  expect_equal(attr(psis1, "method")[1], "psis")
  expect_equal(attr(tis1, "method")[1], "tis")
  expect_equal(attr(is1, "method")[1], "sis")
})


test_that("psis methods give same results", {
  tis2 <- suppressWarnings(tis(-LLmat, r_eff = r_eff_arr))
  expect_identical(tis1, tis2)

  tisvec <- suppressWarnings(tis(-LLvec, r_eff = r_eff_vec))
  tismat <- suppressWarnings(tis(-LLmat[, 1], r_eff = r_eff_vec))
  expect_identical(tisvec, tismat)

  is2 <- suppressWarnings(sis(-LLmat, r_eff = r_eff_arr))
  expect_identical(is1, is2)

  isvec <- suppressWarnings(sis(-LLvec, r_eff = r_eff_vec))
  ismat <- suppressWarnings(sis(-LLmat[, 1], r_eff = r_eff_vec))
  expect_identical(isvec, ismat)
})


test_that("tis throws correct errors and warnings", {
  # r_eff default no warnings
  expect_silent(tis(-LLarr))
  expect_silent(tis(-LLmat))
  expect_silent(tis(-LLmat[, 1]))

  # r_eff=NULL no warnings
  expect_silent(tis(-LLarr, r_eff = NULL))
  expect_silent(tis(-LLmat, r_eff = NULL))
  expect_silent(tis(-LLmat[, 1], r_eff = NULL))

  # r_eff=NA no warnings
  expect_silent(tis(-LLarr, r_eff = NA))
  expect_silent(tis(-LLmat, r_eff = NA))
  expect_silent(tis(-LLmat[, 1], r_eff = NA))

  # r_eff default and r_eff=NA give same answer
  expect_equal(
    suppressWarnings(tis(-LLarr)),
    tis(-LLarr, r_eff = NA)
  )

  # r_eff=NULL and r_eff=NA give same answer
  expect_equal(
    suppressWarnings(tis(-LLarr, r_eff = NULL)),
    tis(-LLarr, r_eff = NA)
  )

  # r_eff scalar is fine
  expect_silent(tis(-LLarr, r_eff = r_eff_arr[1]))

  # r_eff wrong length is error
  expect_error(tis(-LLarr, r_eff = r_eff_arr[-1]), "one value per observation")

  # r_eff has some NA values which are replaced with 1
  r_eff_arr[2] <- NA
  expect_snapshot(psis(-LLarr, r_eff = r_eff_arr))

  # no NAs or non-finite values allowed
  LLmat[1, 1] <- NA
  expect_error(tis(-LLmat), "NAs not allowed in input")

  LLmat[1, 1] <- 1
  LLmat[10, 2] <- -Inf
  expect_error(tis(-LLmat), "All input values must be finite or -Inf")
  LLmat[10, 2] <- Inf
  expect_no_error(tis(-LLmat))

  # no lists allowed
  expect_error(expect_warning(
    tis(as.list(-LLvec)),
    "List not allowed as input"
  ))

  # if array, must be 3-D array
  dim(LLarr) <- c(2, 250, 2, 32)
  expect_error(
    tis(-LLarr),
    "length(dim(log_ratios)) == 3 is not TRUE",
    fixed = TRUE
  )
})


test_that("explict test of values for 'sis' and 'tis'", {
  lw <- 1:16
  expect_silent(tis_true <- tis(log_ratios = lw, r_eff = NA))
  expect_equal(
    as.vector(weights(tis_true, log = TRUE, normalize = FALSE)),
    c(
      -14.0723,
      -13.0723,
      -12.0723,
      -11.0723,
      -10.0723,
      -9.0723,
      -8.0723,
      -7.0723,
      -6.0723,
      -5.0723,
      -4.0723,
      -3.0723,
      -2.0723,
      -1.0723,
      -0.0723,
      0.
    ) +
      15.07238,
    tolerance = 0.001
  )
  expect_silent(is_true <- sis(log_ratios = lw, r_eff = NA))
  expect_equal(
    as.vector(weights(is_true, log = TRUE, normalize = FALSE)),
    lw,
    tolerance = 0.00001
  )

  lw <- c(
    0.7609420,
    1.3894140,
    0.4158346,
    2.5307927,
    4.3379119,
    2.4159240,
    2.2462172,
    0.8057697,
    0.9333107,
    1.5599302
  )

  expect_silent(tis_true <- tis(log_ratios = lw, r_eff = NA))
  expect_equal(
    as.vector(weights(tis_true, log = TRUE, normalize = FALSE)),
    c(
      -2.931,
      -2.303,
      -3.276,
      -1.161,
      0,
      -1.276,
      -1.446,
      -2.886,
      -2.759,
      -2.132
    ) +
      3.692668,
    tolerance = 0.001
  )
  expect_silent(is_true <- sis(log_ratios = lw, r_eff = NA))
  expect_equal(
    as.vector(weights(is_true, log = TRUE, normalize = FALSE)),
    lw,
    tolerance = 0.00001
  )
})


test_that("tis_loo and sis_loo are returned", {
  LLmat <- example_loglik_matrix()
  loo_psis <- suppressWarnings(loo(LLmat, r_eff = NA, is_method = "psis"))
  loo_tis <- suppressWarnings(loo(LLmat, r_eff = NA, is_method = "tis"))
  loo_sis <- suppressWarnings(loo(LLmat, r_eff = NA, is_method = "sis"))

  expect_s3_class(loo_tis, "tis_loo")
  expect_s3_class(loo_sis, "sis_loo")
  expect_s3_class(loo_tis, "importance_sampling_loo")
  expect_s3_class(loo_sis, "importance_sampling_loo")

  expect_snapshot(print(loo_tis))
  expect_snapshot(print(loo_sis))
})
