diff --git a/DESCRIPTION b/DESCRIPTION index 7b261f6..7305599 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: piar Title: Price Index Aggregation -Version: 0.4.0.9016 +Version: 0.5.0 Authors@R: c( person("Steve", "Martin", role = c("aut", "cre", "cph"), email = "stevemartin041@gmail.com", comment = c(ORCID = "0000-0003-2544-9480")) ) diff --git a/R/aggregation_structure.R b/R/aggregation_structure.R index 7c5072c..a6ae24c 100644 --- a/R/aggregation_structure.R +++ b/R/aggregation_structure.R @@ -50,7 +50,7 @@ validate_pias <- function(x) { } aggregation_structure <- function(x, w = NULL) { - x <- lapply(x, factor) + x <- lapply(x, as.character) len <- length(x) ea <- as.character(unlist(x[len], use.names = FALSE)) if (length(ea) == 0L) { @@ -82,12 +82,8 @@ aggregation_structure <- function(x, w = NULL) { child <- parent <- vector("list", len)[-1L] # produce a list for each level with all the parent and child nodes for (i in seq_along(upper)) { - child[[i]] <- lapply( - split(as.character(lower[[len - i]]), upper[[len - i]]), unique - ) - parent[[i]] <- lapply( - split(as.character(upper[[len - i]]), lower[[len - i]]), unique - ) + child[[i]] <- lapply(split(lower[[len - i]], upper[[len - i]]), unique) + parent[[i]] <- lapply(split(upper[[len - i]], lower[[len - i]]), unique) } if (any(lengths(unlist(parent, recursive = FALSE)) > 1L)) { stop("some nodes in the price index aggregation structure have ", diff --git a/cran-comments.md b/cran-comments.md index b657db8..5098c28 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,7 +1,8 @@ ## Test environments -- local Ubuntu 20.04 installation, R 4.2.0, 3.5.0 +- local Ubuntu 20.04 installation, R 4.3.1 - win-builder (devel, release, oldrelease) +- mac-builder (release) - R-hub (fedora-clang devel) ## R CMD check results diff --git a/man/aggregation_structure.Rd b/man/aggregation_structure.Rd index 575dc52..14279d8 100644 --- a/man/aggregation_structure.Rd +++ b/man/aggregation_structure.Rd @@ -14,7 +14,7 @@ aggregation_structure(x, w = NULL) } \arguments{ -\item{x}{A list of factors (or vectors to be coerced to factors) that give the codes/labels for each level of the classification, ordered so that moving down the list goes down the hierarchy. The last vector gives the elemental aggregates, which should have no duplicates. All vectors should be the same length, without \code{NA}s, and there should be no duplicates across different levels of \code{x}.} +\item{x}{A list of character vectors that give the codes/labels for each level of the classification, ordered so that moving down the list goes down the hierarchy. The last vector gives the elemental aggregates, which should have no duplicates. All vectors should be the same length, without \code{NA}s, and there should be no duplicates across different levels of \code{x}.} \item{w}{A numeric vector of aggregation weights for the elemental aggregates (i.e., the last vector in \code{x}). The default is to give each elemental aggregate the same weight.} } diff --git a/man/expand_classification.Rd b/man/expand_classification.Rd index bb67f28..8a4bba8 100644 --- a/man/expand_classification.Rd +++ b/man/expand_classification.Rd @@ -16,7 +16,7 @@ expand_classification(x, width = 1) \arguments{ \item{x}{A character vector, or something that can be coerced into one, of codes/labels for a specific level in a classification (e.g., 5-digit COICOP, 5-digit NAICS, 4-digit SIC).} -\item{width}{An integer vector that gives the width of each digit in \code{x}. A single value is recycled to span the longest element in \code{class}. This cannot contain NAs. The default assumes each digit has a width of 1, as in the NAICS, NAPCS, and SIC classifications.} +\item{width}{An integer vector that gives the width of each digit in \code{x}. A single value is recycled to span the longest element in \code{x}. This cannot contain NAs. The default assumes each digit has a width of 1, as in the NAICS, NAPCS, and SIC classifications.} } \value{ diff --git a/tests/Examples/piar-Ex.Rout.save b/tests/Examples/piar-Ex.Rout.save index 412634b..7bebd5a 100644 --- a/tests/Examples/piar-Ex.Rout.save +++ b/tests/Examples/piar-Ex.Rout.save @@ -80,7 +80,7 @@ top 2.462968 16.4796 > > ### Name: aggregation-structure-attributes > ### Title: Methods to get the weights and levels for a price index -> ### aggregation structure. +> ### aggregation structure > ### Aliases: weights.aggregation_structure weights<- > ### weights<-.aggregation_structure levels.aggregation_structure > diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 09bd364..9ced0a2 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -90,6 +90,10 @@ test_that("a matched-sample index aggregates correctly", { as.matrix(aggregate(ms_epr, ms_pias, na.rm = TRUE)[levels(ms_index), ]), as.matrix(ms_index) ) + expect_equal( + as.matrix(aggregate(ms_epr, ms_pias, na.rm = TRUE)[1:3, ]), + as.matrix(ms_index)[1:3, ] + ) # Aggregated contributions should add up expect_equal(as.matrix(ms_index)[1, ], diff --git a/tests/testthat/test-aggregation_structure.R b/tests/testthat/test-aggregation_structure.R index 8b4cae0..c8fb9e6 100644 --- a/tests/testthat/test-aggregation_structure.R +++ b/tests/testthat/test-aggregation_structure.R @@ -2,7 +2,7 @@ x1 <- c("1", "2", "1", "1") x2 <- c("11", "21", "12", "11") x3 <- c("111", "211", "121", "112") -test_that("reordering works", { +test_that("reordering does nothing", { epr <- as_index(matrix(1:12, 4, 3, dimnames = list(c("111", "112", "121", "211"), 1:3))) agg1 <- aggregation_structure(list(x1, x2, x3), 1:4) @@ -10,7 +10,7 @@ test_that("reordering works", { agg2 <- aggregation_structure(list(x1, f, x3), 1:4) index1 <- aggregate(epr, agg1) index2 <- aggregate(epr, agg2) - expect_equal(as.matrix(index1[levels(index2)]), as.matrix(index2)) + expect_equal(index1, index2) f <- factor(x2, levels = c("11", "21", "12", "99")) expect_equal(agg2, aggregation_structure(list(x1, f, x3), 1:4)) @@ -27,4 +27,5 @@ test_that("errors work", { expect_error(aggregation_structure(list(1:2, c(11, NA)))) expect_error(aggregation_structure(list(1:2, c(11, 11, 12)))) expect_error(aggregation_structure(list(1:2, c(3, 3), c(4, 5)))) + expect_error(aggregation_structure(list(1:2, c(3, 3), c(4, "")))) }) diff --git a/tests/testthat/test-vcov.R b/tests/testthat/test-vcov.R index ba45b5a..29895cf 100644 --- a/tests/testthat/test-vcov.R +++ b/tests/testthat/test-vcov.R @@ -128,3 +128,13 @@ test_that("vcov works for chained index", { covar[1, 2] # 0.004125957 according to svymean ) }) + +test_that("vcov doesn't depend on order", { + covar <- vcov(index, rw * weights$ew, mse = FALSE) + ord <- c(1, 3:4, 8, 2, 5:7) + weights <- weights[ord, ] + pias <- with(weights, aggregation_structure(as.list(weights[1:4]), ew * dw)) + index <- aggregate(epr, pias) + rw <- rw[ord, ] + expect_equal(vcov(index, rw * weights$ew, mse = FALSE), covar) +})