Nothing
context("bilateral indices")
load(system.file("testdata","testData_bilateral.RData", package = "IndexNumR"))
indexMethods <- c("laspeyres", "paasche", "fisher", "tornqvist", "satovartia",
"dutot", "carli", "jevons", "harmonic", "cswd", "walsh", "ces",
"geomLaspeyres", "geomPaasche", "tpd", "gk", "palgrave", "drobish",
"stuvel", "marshalledgeworth", "lowe", "young")
outputTypes <- c("pop", "chained", "fixedbase")
indexEqual <- function(pOrq, indexMethod, outputType, result){
switch(pOrq,
price = expect_equal(priceIndex(CES_sigma_2,
pvar = "prices",
qvar = "quantities",
pervar = "time",
prodID = "prodID",
indexMethod = !!indexMethod,
sample = "matched",
output = !!outputType,
sigma = 2,
weights = "shares"),
!!result),
quantity = eval(bquote(expect_equal(quantityIndex(CES_sigma_2,
pvar = "prices",
qvar = "quantities",
pervar = "time",
prodID = "prodID",
indexMethod = .(indexMethod),
sample = "matched",
output = .(outputType),
sigma = 2,
weights = "shares"),
.(result)))))
}
test_that("bilateral price index functions return the correct values",{
for(i in seq_along(indexMethods)){
for(j in seq_along(outputTypes)){
indexEqual("price",
indexMethods[i],
outputTypes[j],
as.matrix(testData[[paste0(indexMethods[i],"_",outputTypes[j])]]))
}
}
})
test_that("error is thrown when wrong column names are given",{
expect_error(priceIndex(CES_sigma_2,pvar = "price",qvar = "quantities",
pervar = "time",prodID = "prodID",indexMethod = "laspeyres",
sample="matched", output = "chained"),
"are not column names of the input data frame")
})
test_that("error is thrown when wrong column names are given",{
expect_error(priceIndex(CES_sigma_2, pvar = "prices", qvar = "quantitie",
pervar = "time", prodID = "prodID", indexMethod = "laspeyres",
sample = "matched", output = "chained"),
"are not column names of the input data frame")
})
test_that("error is thrown when wrong index method is specified",{
expect_error(priceIndex(CES_sigma_2,pvar = "prices",qvar = "quantities",
pervar = "time",prodID = "prodID",indexMethod = "wrong_method",
sample="matched", output = "chained"),
"Not a valid index number method.")
})
test_that("error is thrown when output method is specified",{
expect_error(priceIndex(CES_sigma_2,pvar = "prices",qvar = "quantities",
pervar = "time",prodID = "prodID",indexMethod = "laspeyres",
sample="matched", output = "wrong_output"),
"Not a valid output type. Please choose from chained, fixedbase or pop.")
})
test_that("Error is thrown when wrong chain method given", {
expect_error(priceIndex(CES_sigma_2,pvar = "prices",qvar = "quantities",
pervar = "time",prodID = "prodID",indexMethod = "laspeyres",
sample="matched", output = "chained", chainMethod = "wrong_method"),
"Not a valid chainMethod. Please choose frompop, plspread, asymplinear, logquadratic, mixscale, predictedshare")
})
test_that("Error is thrown for an invalid tpd weight type", {
expect_error(priceIndex(CES_sigma_2,pvar = "prices",qvar = "quantities",
pervar = "time",prodID = "prodID",indexMethod = "laspeyres",
sample="matched", output = "chained", weights = "wrong_weights"),
"Not a valid weight type. Please choose from unweighted, shares or average.")
})
test_that("Error is thrown when time/product combinations are not unique", {
duped <- CES_sigma_2
# set the time for the second observation on product 1 to period 1
# which creates a duplicate time/product combination
duped$time[2] <- 1
expect_error(priceIndex(duped, pvar="prices", qvar="quantities", pervar="time", prodID = "prodID"))
})
rm(testData)
#load CES_sigma_2 and make period 3 missing
dat <- CES_sigma_2
dat$time[dat$time==3] <- 2
test_that("error is thrown when a time period is missing",{
expect_error(priceIndex(dat, pvar="prices",qvar="quantities", pervar = "time",
prodID = "prodID", indexMethod = "laspeyres",
output = "chained"),
"The time period variable is not continuous. Missing periods: 3")
})
rm(dat)
load(system.file("testdata","testData_bilateral_quantity.RData",package = "IndexNumR"))
test_that("bilateral quantity index functions return the correct values",{
for(i in seq_along(indexMethods)){
for(j in seq_along(outputTypes)){
indexEqual("quantity",
indexMethods[i],
outputTypes[j],
as.matrix(testData[[paste0(indexMethods[i],"_",outputTypes[j])]]))
}
}
})
rm(testData)
# setup a random ordering of the 4 products for 4 periods
v1 <- 1:4
v2 <- rev(v1)
v3 <- c(4,2,1,3)
v4 <- rev(v3)
CESUnordered <- as.data.frame(matrix(NA, nrow = 16, ncol = 4))
# bind the 4 periods of data in the order defined by v1-v4
CESUnordered[1:4,] <- CES_sigma_2[CES_sigma_2$time == 1,][v1,]
CESUnordered[5:8,] <- CES_sigma_2[CES_sigma_2$time == 2,][v2,]
CESUnordered[9:12,] <- CES_sigma_2[CES_sigma_2$time == 3,][v3,]
CESUnordered[13:16,] <- CES_sigma_2[CES_sigma_2$time == 4,][v4,]
colnames(CESUnordered) <- colnames(CES_sigma_2)
CESOrdered <- CES_sigma_2[CES_sigma_2$time %in% 1:4,]
test_that("Indices return the same answer regardless of product ordering",{
doIndex <- function(dataset, method){
priceIndex(dataset, pvar = "prices", qvar = "quantities", prodID = "prodID",
pervar = "time", indexMethod = method)
}
indexEqual <- function(dataset1, method, dataset2){
expect_equal(doIndex(dataset1, method), doIndex(dataset2, method))
}
for(i in seq_along(indexMethods)){
indexEqual(CESOrdered, indexMethods[i], CESUnordered)
}
})
test_that("bilateral tpd with average weights gives a tornqvist index", {
tpd <- priceIndex(CES_sigma_2, pvar = "prices", qvar = "quantities", pervar = "time",
prodID = "prodID", indexMethod = "tpd", biasAdjust = FALSE,
weights = "average")
torn <- priceIndex(CES_sigma_2, pvar = "prices", qvar = "quantities", pervar = "time",
prodID = "prodID", indexMethod = "tornqvist")
expect_equal(tpd, torn)
})
test_that("bilateral unweighted tpd gives a jevons index", {
tpd <- priceIndex(CES_sigma_2, pvar = "prices", qvar = "quantities", pervar = "time",
prodID = "prodID", indexMethod = "tpd", biasAdjust = FALSE,
weights = "unweighted")
jev <- priceIndex(CES_sigma_2, pvar = "prices", qvar = "quantities", pervar = "time",
prodID = "prodID", indexMethod = "jevons")
expect_equal(tpd, jev)
})
test_that("bilateral unweighted tpd gives a matched-model jevons index with missing products", {
tpd <- priceIndex(CES_sigma_2[-15,], pvar = "prices", qvar = "quantities", pervar = "time",
prodID = "prodID", indexMethod = "tpd", biasAdjust = FALSE,
weights = "unweighted", sample = "")
jev <- priceIndex(CES_sigma_2[-15,], pvar = "prices", qvar = "quantities", pervar = "time",
prodID = "prodID", indexMethod = "jevons", sample = "matched")
expect_equal(tpd, jev)
})
test_that("The right result is given when prices are imputed", {
df <- CES_sigma_2[-c(2:3),]
result <- priceIndex(df, pvar = "prices", qvar = "quantities", pervar = "time",
prodID = "prodID", indexMethod = "fisher", output = "chained", imputePrices = "carry")
expect_equal(result, as.matrix(c(1, 0.881280297388098, 1.10748511558337, 1.13268619923687,
0.932248672354066, 1.18881766113942, 1.13162788219576, 0.937414782841657,
1.10719909454772, 0.955793570240181, 1.13893096121809, 1.14473220737899
)))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.