test-gkhamis.R
In pricelevels: Spatial Price Level Comparisons

# START


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


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

expect_equal(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product)],
  c("1"=1)
)

expect_equal(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, settings=list(solve="matrix"))],
  c("1"=1)
)

expect_equal(
  dt[, ikle(p=price, q=quantity, r=region, n=product)],
  c("1"=1)
)

expect_equal(
  dt[, ikle(p=price, r=region, n=product)],
  c("1"=1)
)


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


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

expect_no_error(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product)]
)

expect_no_error(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, settings=list(solve="matrix"))]
)

expect_equal(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product)],
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, settings=list(solve="matrix"))]
)

expect_no_error(
  dt[, rao(p=price, q=quantity, r=region, n=product)]
)


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


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

# gkhamis():
gk.est <- dt[, gkhamis(p=price, q=quantity, r=region, n=product, base=NULL)]
gk.est1 <- dt[, gkhamis(p=price, q=quantity, r=region, n=product, base="1")]
gk.est2 <- dt[, gkhamis(p=price, q=quantity, r=region, n=product, base="2")]
gk.est3 <- dt[, gkhamis(p=price, q=quantity, r=region, n=product, simplify=FALSE)]
gk.est4 <- dt[, gkhamis(p=price, q=quantity, r=region, n=product, simplify=FALSE, settings=list(solve="matrix"))]

expect_equal(is.vector(gk.est1), TRUE)
expect_equal(is.vector(gk.est2), TRUE)
expect_equal(is.list(gk.est3), TRUE)
expect_equal(is.list(gk.est4), TRUE)
expect_equal(names(gk.est3), c("par","niter","tol"))
expect_equal(names(gk.est4), c("par"))
expect_equal(gk.est3$par, gk.est4$par)
expect_equal(gk.est1[1], c("1"=1))
expect_equal(gk.est2[2], c("2"=1))
expect_equal(mean(gk.est), 1)
expect_equal(gk.est1, gk.est/gk.est[1])
expect_equal(gk.est1, gk.est2/gk.est2[1])

# ikle():
ikd.est <- dt[, ikle(p=price, q=quantity, r=region, n=product, base=NULL)]
ikd.est1 <- dt[, ikle(p=price, q=quantity, r=region, n=product, base="1")]
ikd.est2 <- dt[, ikle(p=price, q=quantity, r=region, n=product, base="2")]
ikd.est3 <- dt[, ikle(p=price, q=quantity, r=region, n=product, simplify=FALSE)]

expect_equal(is.vector(ikd.est1), TRUE)
expect_equal(is.vector(ikd.est2), TRUE)
expect_equal(is.list(ikd.est3), TRUE)
expect_equal(names(ikd.est3), c("par","niter","tol"))
expect_equal(ikd.est1[1], c("1"=1))
expect_equal(ikd.est2[2], c("2"=1))
expect_equal(mean(ikd.est), 1)
expect_equal(ikd.est1, ikd.est/ikd.est[1])
expect_equal(ikd.est1, ikd.est2/ikd.est2[1])

# rao():
rao.est <- dt[, rao(p=price, q=quantity, r=region, n=product, base=NULL)]
rao.est1 <- dt[, rao(p=price, q=quantity, r=region, n=product, base="1")]
rao.est2 <- dt[, rao(p=price, q=quantity, r=region, n=product, base="2")]
rao.est3 <- dt[, rao(p=price, q=quantity, r=region, n=product, simplify=FALSE)]

expect_equal(is.vector(rao.est1), TRUE)
expect_equal(is.vector(rao.est2), TRUE)
expect_equal(is.list(rao.est3), TRUE)
expect_equal(names(rao.est3), c("par","niter","tol"))
expect_equal(rao.est1[1], c("1"=1))
expect_equal(rao.est2[2], c("2"=1))
expect_equal(exp(mean(log(rao.est))), 1) # different to others!
expect_equal(rao.est1, rao.est/rao.est[1])
expect_equal(rao.est1, rao.est2/rao.est2[1])

# rhajargasht():
rh.est <- dt[, rhajargasht(p=price, r=region, n=product, base=NULL)]
rh.est1 <- dt[, rhajargasht(p=price, r=region, n=product, base="1")]
rh.est2 <- dt[, rhajargasht(p=price, r=region, n=product, base="2")]
rh.est3 <- dt[, rhajargasht(p=price, r=region, n=product, simplify=FALSE)]

expect_equal(is.vector(rh.est1), TRUE)
expect_equal(is.vector(rh.est2), TRUE)
expect_equal(is.list(rh.est3), TRUE)
expect_equal(names(rh.est3), c("par","niter","tol"))
expect_equal(rh.est1[1], c("1"=1))
expect_equal(rh.est2[2], c("2"=1))
expect_equal(mean(rh.est), 1)
expect_equal(rh.est1, rh.est/rh.est[1])
expect_equal(rh.est1, rh.est2/rh.est2[1])

# test quantities versus shares as weights:
dt[, "share" := (price*quantity)/sum(price*quantity), by="region"]

expect_equal(
  dt[, rao(p=price, q=quantity, r=region, n=product, base=NULL)],
  dt[, rao(p=price, w=share, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, ikle(p=price, q=quantity, r=region, n=product, base=NULL)],
  dt[, ikle(p=price, w=share, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, rhajargasht(p=price, q=quantity, r=region, n=product, base=NULL)],
  dt[, rhajargasht(p=price, w=share, r=region, n=product, base=NULL)]
)


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


# missing quantities:
expect_no_error(
  dt[, gkhamis(p=price, r=region, n=product)]
)

# missing quantities and weights:
expect_no_error(
  dt[, rao(p=price, r=region, n=product)]
)

# wrong setting:
expect_error(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, settings=list(solve="abc"))]
)

# negative tolerance not allowed:
expect_error(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, settings=list(tol=-2))]
)

# negative maximum number of iterations not allowed:
expect_error(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, settings=list(max.iter=-2))]
)

# solve-method not allowed:
expect_error(
  dt[, ikle(p=price, q=quantity, r=region, n=product, settings=list(solve="matrix"))]
)


# 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(
  dt[, gkhamis(p=price, r=region, n=product, q=quantity, base="1",
           settings=list(chatty=FALSE, connect=TRUE))][1],
  c("1"=1)
)

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

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

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

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

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

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

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


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


# test if ikle(), gkhamis(), and gerardi() identical if no gaps
# and quantities are the same across regions:
set.seed(123)
dt <- rdata(R=5, B=1, N=9, gaps=0)
dt[, "quantity" := 1000*rleidv(product)]

expect_equal(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, base=NULL)],
  dt[, ikle(p=price, q=quantity, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, gkhamis(p=price, q=quantity, r=region, n=product, base=NULL)],
  dt[, gerardi(p=price, q=quantity, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, gerardi(p=price, q=quantity, r=region, n=product, base=NULL)],
  dt[, ikle(p=price, q=quantity, r=region, n=product, base=NULL)]
)

# test if unweighted are identical to weighted ones using weights of 1
# if there are no gaps (with gaps, renormalization of weights causes
# differences):
expect_equal(
  dt[, rao(p=price, w=rep(1,.N), r=region, n=product, base=NULL)],
  dt[, rao(p=price, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, rhajargasht(p=price, w=rep(1,.N), r=region, n=product, base=NULL)],
  dt[, rhajargasht(p=price, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, ikle(p=price, w=rep(1,.N), r=region, n=product, base=NULL)],
  dt[, ikle(p=price, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, gkhamis(p=price, q=rep(1,.N), r=region, n=product, base=NULL)],
  dt[, gkhamis(p=price, r=region, n=product, base=NULL)]
)

# test if rao() is identical to cpd() even if there are gaps:
# see http://www.roiw.org/2005/2005-24.pdf
set.seed(123)
dt <- rdata(R=5, B=1, N=9, gaps=0.3)
dt[, "share":=price*quantity/sum(price*quantity), by="region"]

expect_equal(
  dt[, rao(p=price, r=region, n=product, base="1")],
  dt[, cpd(p=price, r=region, n=product, base="1")]
)

expect_equal(
  dt[, rao(p=price, q=quantity, r=region, n=product, base="1")],
  dt[, cpd(p=price, q=quantity, r=region, n=product, base="1")]
)

expect_equal(
  dt[, rao(p=price, q=quantity, r=region, n=product, base=NULL)],
  dt[, cpd(p=price, q=quantity, r=region, n=product, base=NULL)]
)

expect_equal(
  dt[, rao(p=price, w=share, r=region, n=product, base="1")],
  dt[, cpd(p=price, w=share, r=region, n=product, base="1")]
)

expect_equal(
  dt[, rao(p=price, w=share, r=region, n=product, base=NULL)],
  dt[, cpd(p=price, w=share, r=region, n=product, base=NULL)]
)

# END