dat <- data.frame(
  rel = c(1:6, NA, 7, 8),
  period = c(1, 1, 1, 1, 1, 2, 2, 2, 2),
  ea = c("11", "11", "12", "12", "13", "11", "12", "11", "14")
)

pias <- as_aggregation_structure(
  data.frame(level1 = 1, level2 = c(11, 12, 13, 14), weight = 1)
)

epr <- elementary_index(
  dat,
  setNames(rel, c(1:5, 1, 3, 2, 6)) ~ period + ea,
  contrib = TRUE
)
index <- aggregate(epr, pias, na.rm = TRUE)
epr2 <- elementary_index(dat, rel ~ period + ea)

test_that("contrib works", {
  expect_equal(
    contrib(epr),
    matrix(
      c(0, 0.414213562373095, 2.5962965079607, 2.88444419044716),
      2,
      2,
      dimnames = list(product = c("1", "2"), time = 1:2)
    )
  )
  expect_equal(
    contrib(epr, "14"),
    matrix(c(0, 7), 1, 2, dimnames = list(product = "6", time = 1:2))
  )
  expect_equal(
    contrib(epr2),
    matrix(numeric(0), 0, 2, dimnames = list(product = NULL, time = 1:2))
  )
  expect_equal(
    contrib(epr, 12, 2),
    matrix(NA_real_, 1, 1, dimnames = list(product = 3, time = 2))
  )
})

test_that("contrib2DF works", {
  expect_equal(
    contrib2DF(epr),
    data.frame(
      period = c("1", "1", "2", "2"),
      level = c("11", "11", "11", "11"),
      product = c("1", "2", "1", "2"),
      value = as.numeric(contrib(epr))
    )
  )

  expect_equal(
    contrib2DF(epr, levels(epr), 2),
    data.frame(
      period = c("2", "2", "2", "2"),
      level = c("11", "11", "12", "14"),
      product = c("1", "2", "3", "6"),
      value = c(
        contrib(epr, "11", 2),
        contrib(epr, "12", 2),
        contrib(epr, "14", 2)
      )
    )
  )

  expect_equal(
    contrib2DF(epr2),
    data.frame(
      period = character(0),
      level = character(0),
      product = character(0),
      value = numeric(0)
    )
  )
})

test_that("padding work", {
  expect_equal(
    contrib(epr, 12, pad = -99),
    matrix(
      c(1.07179676972449, 1.39230484541326, NA, -99),
      2,
      2,
      dimnames = list(product = 3:4, time = 1:2)
    )
  )
  expect_error(contrib(epr, 12, pad = 1:2))
})

test_that("aggregate contributions have the right form", {
  contributions <- contrib(index)
  expect_equal(
    rownames(contributions),
    c("1", "2", "3", "4", "5", "6")
  )
  expect_equal(colnames(contributions), c("1", "2"))
})

test_that("product names are correct", {
  expect_equal(
    suppressWarnings(
      contrib(elementary_index(
        c(a = 1, b = 2, c = 3, a = 4, a = 5),
        period = c(1, 1, 1, 2, 2),
        ea = gl(1, 5),
        contrib = TRUE,
        r = 1
      ))
    ),
    matrix(
      c(0, 0, 1 / 3, 2 / 3, 1.5, 2, 0, 0),
      4,
      2,
      dimnames = list(product = c("a", "a.1", "b", "c"), time = 1:2)
    )
  )

  w <- setNames(rep(1, 9), letters[1:9])
  expect_equal(
    contrib(epr),
    contrib(
      elementary_index(
        dat,
        rel ~ period + ea,
        weights = w,
        contrib = TRUE,
        product = c(1:5, 1, 3, 2, 6)
      )
    )
  )
})

test_that("replacement works", {
  # No op.
  epr2 <- epr
  contrib(epr) <- contrib(epr)
  expect_identical(epr, epr2)

  # Replacing with change in index.
  contrib(epr) <- matrix(as.numeric(epr[1]) - 1, 1)
  expect_equal(
    contrib(epr),
    matrix(as.numeric(epr[1]) - 1, 1, dimnames = list(product = 1, time = 1:2))
  )

  # Deleting contributions, used to be give an error.
  contrib(epr, 12) <- numeric(0)
  expect_equal(
    contrib2DF(epr, 12),
    data.frame(
      period = character(0),
      level = character(0),
      product = character(0),
      value = numeric(0)
    )
  )

  # Adding contributions.
  contrib(epr, 14) <- matrix(
    c(NA, 2:3, 6, 1, NA),
    3,
    dimnames = list(product = letters[1:3], time = NULL)
  )
  expect_equal(
    contrib(epr, 14),
    matrix(
      c(NA, 2:3, 6, 1, NA),
      3,
      dimnames = list(product = letters[1:3], time = 1:2)
    )
  )

  # Errors work.
  expect_error(contrib(epr) <- matrix(0, 0, 0))
  expect_warning(contrib(epr) <- matrix(c(as.numeric(epr[1]), 3) - 1, 1, 3))
  expect_warning(contrib(epr, 14, 1) <- c(a = 1, a = NA))
})

test_that("setting as index works", {
  reset_contrib <- function(index) {
    contrib_matrix <- as.matrix(index) - 1
    for (l in levels(index)) {
      contrib(index, l) <- contrib_matrix[l, , drop = FALSE]
    }
    index
  }
  expect_equal(reset_contrib(epr), set_contrib_from_index(epr2))
})
