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 ))) })