# START


options(pricelevels.chatty=FALSE)


# Data with one region only -----------------------------------------------


# example data:
set.seed(123)
dt <- rdata(R=1, B=1, N=4)

expect_equal(
  dt[, index.pairs(p=price, r=region, n=product, settings=list(type="jevons"))],
  data.table("base"=as.factor(1), "region"=as.factor(1), "jevons"=1, key=c("base","region"))
)

expect_equal(
  dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=TRUE))],
  data.table("base"=as.factor(1), "region"=as.factor(1), "jevons"=1, "fisher"=1, key=c("base","region"))
)

expect_equal(
  dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=FALSE))],
  data.table("base"=factor(x=character(), level="1"), "region"=factor(x=character(), level="1"), "jevons"=numeric(), "fisher"=numeric(), key=c("base","region"))
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, settings=list(type="jevons"))],
  c("1"=1)
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=TRUE))],
  matrix(data=1, nrow=2, dimnames=list(c("geks-jevons","geks-fisher"), "1"))
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=FALSE))],
  matrix(data=1, nrow=2, dimnames=list(c("geks-jevons","geks-fisher"), "1"))
)


# Data with one product only ----------------------------------------------


# example data:
set.seed(123)
dt <- rdata(R=4, B=1, N=1)

expect_no_error(
  dt[, index.pairs(p=price, r=region, n=product, settings=list(type="jevons"))]
)

expect_no_error(
  dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=TRUE))]
)

expect_no_error(
  dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=FALSE))]
)

expect_no_error(
  dt[, geks(p=price, r=region, n=product, settings=list(type="jevons"))]
)

expect_no_error(
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=TRUE))]
)

expect_no_error(
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type=c("jevons","fisher"), all.pairs=FALSE))]
)


# Data with gaps ----------------------------------------------------------


# example data:
set.seed(123)
dt <- rdata(R=3, B=1, N=4, gaps=0.2)
dt[, "share" := price*quantity/sum(price*quantity), by="region"]
dt[, "weight" := rweights(r=region, b=product, type=~b)]

# index.pairs():
res.expec <- rbind(
  dt[, jevons(p=price, r=region, n=product, base="1")],
  dt[, jevons(p=price, r=region, n=product, base="2")],
  dt[, jevons(p=price, r=region, n=product, base="3")]
)
rownames(res.expec) <- c("1","2","3")

expect_equal(
  as.matrix(dcast(data=dt[, index.pairs(p=price, r=region, n=product, settings=list(type="jevons", all.pairs=TRUE))], formula=base~region, value.var="jevons", droP=FALSE), rownames="base"),
  res.expec
)

res.expec[lower.tri(res.expec)] <- NA
diag(res.expec) <- NA

expect_equal(
  as.matrix(dcast(data=dt[, index.pairs(p=price, r=region, n=product, settings=list(type="jevons", all.pairs=FALSE))], formula=base~region, value.var="jevons", drop=FALSE), rownames="base"),
  res.expec
)

expect_equal(
  nrow(dt[, index.pairs(p=price, r=region, n=product, settings=list(type="jevons", all.pairs=TRUE))]),
  3^2
)

expect_equal(
  nrow(dt[, index.pairs(p=price, r=region, n=product, settings=list(type="jevons", all.pairs=FALSE))]),
  3*(3-1)/2
)

# geks():
geks.est <- dt[, geks(p=price, r=region, n=product, w=weight, base=NULL, settings=list(type="toernqvist"))]
geks.est1 <- dt[, geks(p=price, r=region, n=product, w=weight, base="1", settings=list(type="toernqvist"))]
geks.est2 <- dt[, geks(p=price, r=region, n=product, w=weight, base="2", settings=list(type="toernqvist", all.pairs=TRUE))]
geks.est3 <- dt[, geks(p=price, r=region, n=product, w=weight, base="2", settings=list(type="toernqvist", all.pairs=FALSE))]

expect_equal(prod(geks.est), 1)
expect_equal(geks.est1[1], c("1"=1))
expect_equal(geks.est2[2], c("2"=1))
expect_equal(geks.est3[2], c("2"=1))
expect_equal(geks.est2, geks.est3)
expect_equal(geks.est1, geks.est2/geks.est2[1])
expect_equal(geks.est1, geks.est/geks.est[1])

# expenditure share weights versus quantities identical:
expect_equal(
  dt[, geks(p=price, r=region, n=product, w=share, base="1", settings=list(type="toernqvist", all.pairs=TRUE))],
  dt[, geks(p=price, r=region, n=product, q=quantity, base="1", settings=list(type="toernqvist", all.pairs=TRUE))]
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, w=share, base="1", settings=list(type="toernqvist", all.pairs=FALSE))],
  dt[, geks(p=price, r=region, n=product, q=quantity, base="1", settings=list(type="toernqvist", all.pairs=FALSE))]
)

# wmethod='shares' still transitive:
geks.est4 <- dt[, geks(p=price, r=region, n=product, q=quantity, base="1", settings=list(type="toernqvist", wmethod="shares", all.pairs=TRUE))]
geks.est5 <- dt[, geks(p=price, r=region, n=product, q=quantity, base=NULL, settings=list(type="toernqvist", wmethod="shares", all.pairs=TRUE))]
expect_equal(geks.est4, geks.est5/geks.est5[1])

geks.est6 <- dt[, geks(p=price, r=region, n=product, q=quantity, base="1", settings=list(type="toernqvist", wmethod="shares", all.pairs=FALSE))]
geks.est7 <- dt[, geks(p=price, r=region, n=product, q=quantity, base=NULL, settings=list(type="toernqvist", wmethod="shares", all.pairs=FALSE))]
expect_equal(geks.est6, geks.est7/geks.est7[1])

# multiple index formulas at once:
geks.est8 <- dt[, geks(p=price, r=region, n=product, q=quantity, base="1", settings=list(type=c("toernqvist","jevons")))]
expect_equal(is.matrix(geks.est8), TRUE)
expect_equal(dim(geks.est8), c(2,3))
expect_true(all(grepl("geks-", rownames(geks.est8))))


# Settings ----------------------------------------------------------------


expect_error(
  dt[, index.pairs(p=price, r=region, n=product, q=quantity,
                   settings=list(type="toernqvist", all.pairs="bla"))]
)

expect_error(
  dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type="bla"))]
)

expect_error(
  dt[, index.pairs(p=price, r=region, n=product, settings=list(type="laspeyres"))]
)

expect_gte(
  length(capture_warnings(dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type="young", qbase="bla", chatty=TRUE))])),
  1L
)

expect_error(
  dt[, geks(p=price, r=region, n=product, q=quantity, base="1",
            settings=list(type="toernqvist", wmethod="bla"))]
)

expect_gte(
  length(capture_warnings(dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type="young", qbase="bla", chatty=TRUE))])),
  1L
)


# Non-connected data ------------------------------------------------------


# example data:
set.seed(123)
dt1 <- pricelevels::rdata(R=3, B=1, N=5)
dt2 <- pricelevels::rdata(R=4, B=1, N=4)
dt2[, "region":=factor(region, labels=4:7)]
dt2[, "product":=factor(product, labels=6:9)]
dt <- rbind(dt1, dt2)

expect_equal(
  dim(as.matrix(dcast(data=dt[, index.pairs(p=price, r=region, n=product, q=quantity)], formula=base~region, value.var="jevons"), rownames="base")),
  c(7,7)
)

expect_equal(
  nrow(dt[, index.pairs(p=price, r=region, n=product, q=quantity)]),
  3*3+4*4
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, base="1",
             settings=list(connect=TRUE))][1],
  c("1"=1)
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, base="1",
             settings=list(connect=TRUE))][4:7],
  setNames(rep(NA_real_, 4), 4:7)
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, base="4",
             settings=list(connect=TRUE))][1:3],
  setNames(rep(NA_real_, 3), 1:3)
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, base="4",
             settings=list(connect=TRUE))][4],
  c("4"=1)
)


# Misc --------------------------------------------------------------------


# example data without gaps:
set.seed(123)
dt <- rdata(R=3, B=1, N=4)

geks.est <- dt[, geks(p=price, r=region, n=product, base=NULL)]
geks.est1 <- dt[, geks(p=price, r=region, n=product, base="1")]
geks.est2 <- dt[, geks(p=price, r=region, n=product, base="2")]
jev.est1 <- dt[, jevons(p=price, r=region, n=product, base="1")]

expect_equal(geks.est1[1], c("1"=1))
expect_equal(geks.est2[2], c("2"=1))
expect_equal(prod(geks.est), 1)
expect_equal(geks.est1, geks.est2/geks.est2[1])
expect_equal(geks.est1, jev.est1)

# example data with weights=1:
dt <- rdata(R=5, B=1, N=10)
dt[, "weights" := 1]

expect_equal(
  dt[, index.pairs(p=price, r=region, n=product, settings=list(type="jevons"))]$jevons,
  dt[, index.pairs(price, region, product, w=weights, settings=list(type="toernqvist"))]$toernqvist
)

expect_equal(
  dt[, index.pairs(price, region, product, settings=list(type = "carli"))]$carli,
  dt[, index.pairs(price, region, product, w=weights, settings=list(type = "laspeyres"))]$laspeyres
)

expect_equal(
  dt[, index.pairs(price, region, product, settings=list(type = "harmonic"))]$harmonic,
  dt[, index.pairs(price, region, product, w=weights, settings=list(type = "paasche"))]$paasche
)


# example data with weights=~b:
set.seed(123)
dt <- rdata(R=3, B=1, N=4)
dt[, "weight" := rweights(r=region, b=product, type=~b)]

geks.est1 <- dt[, geks(p=price, r=region, n=product, w=weight, base="1", settings=list(type="toernqvist"))]
geks.est2 <- dt[, geks(p=price, r=region, n=product, w=weight, base=NULL, settings=list(type="toernqvist"))]
toernq.est1 <- dt[, toernqvist(p=price, r=region, n=product, w=weight, base="1")]

expect_equal(geks.est1[1], c("1"=1))
expect_equal(prod(geks.est2), 1)
expect_equal(geks.est1, geks.est2/geks.est2[1])
expect_equal(geks.est1, toernq.est1)

# example data with gaps:
set.seed(123)
dt <- rdata(R=5, B=1, N=9)

# reciprocal of paasche identical to laspeyres:
expect_equal(
  t(1/as.matrix(dcast(data=dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type="paasche"))], formula=base~region, value.var="paasche"), rownames="base")),
  as.matrix(dcast(data=dt[, index.pairs(p=price, r=region, n=product, q=quantity, settings=list(type="laspeyres"))], formula=base~region, value.var="laspeyres"), rownames="base")
)

# hence, geks-fisher, geks-laspeyres, and geks-paasche identical:
expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type="fisher"))],
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type="laspeyres"))]
)

expect_equal(
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type="fisher"))],
  dt[, geks(p=price, r=region, n=product, q=quantity, settings=list(type="paasche"))]
)

# END