No more partial matching of index dimensions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: piar
 Title: Price Index Aggregation
-Version: 0.7.0.9017
+Version: 0.7.0.9018
 Authors@R: c(
     person("Steve", "Martin", role = c("aut", "cre", "cph"),
            email = "[email protected]",

R/chain.R

@@ -120,7 +120,7 @@ unchain.chainable_piar_index <- function(x, ...) {
 #' @export
 unchain.direct_piar_index <- function(x, base = rep(1, nlevels(x)), ...) {
   if (length(base) == 1L && is.character(base)) {
-    base <- x$index[[match(match.arg(base, x$time), x$time)]] / x$index[[1L]]
+    base <- x$index[[match_time(base, x$time)]] / x$index[[1L]]
   } else {
     base <- as.numeric(base)
     if (length(base) != length(x$levels)) {
@@ -155,7 +155,7 @@ rebase.chainable_piar_index <- function(x, ...) {
 #' @export
 rebase.direct_piar_index <- function(x, base = rep(1, nlevels(x)), ...) {
   if (length(base) == 1L && is.character(base)) {
-    base <- x$index[[match(match.arg(base, x$time), x$time)]]
+    base <- x$index[[match_time(base, x$time)]]
   } else {
     base <- as.numeric(base)
     if (length(base) != length(x$levels)) {

R/contrib.R

@@ -59,19 +59,19 @@ contrib <- function(x, ...) {
 #' @export
 contrib.piar_index <- function(x, level = levels(x)[1L], period = time(x), ...,
                                pad = 0) {
-  level <- match.arg(as.character(level), x$levels)
-  period <- match.arg(as.character(period), x$time, several.ok = TRUE)
+  level <- match_levels(as.character(level), x$levels)
+  period <- match_time(as.character(period), x$time, several = TRUE)
   pad <- as.numeric(pad)
   if (length(pad) != 1L) {
     stop("'pad' must be a length 1 numeric value")
   }
-  con <- lapply(x$contrib[match(period, x$time)], `[[`, match(level, x$levels))
+  con <- lapply(x$contrib[period], `[[`, level)
 
   con_names <- lapply(con, names)
   products <- sort.int(unique(unlist(con_names, use.names = FALSE)))
 
   out <- vector("list", length(con))
-  names(out) <- period
+  names(out) <- x$time[period]
 
   # Initialize 0 contributions for all products in all time periods, then
   # replace with the actual values so products that didn't sell have 0 and

R/extract.piar_index.R

@@ -4,9 +4,9 @@ dim_indices <- function(x, i) {
     return(seq_along(x))
   }
   if (is.character(i)) {
-    res <- match(i, x, incomparables = NA)
+    res <- match(i, x)
   } else {
-    res <- match(x[i], x, incomparables = NA)
+    res <- match(x[i], x)
   }
   if (length(res) == 0L) {
     stop("attempted to select less than one element")

R/index-class.R

@@ -210,3 +210,28 @@ Ops.piar_index <- function(e1, e2) {
 Summary.piar_index <- function(..., na.rm) {
   stop(gettextf("'%s' not meaningful for index objects", .Generic))
 }
+
+match_levels <- function(x, levels) {
+  if (length(x) != 1L) {
+    stop("must supply exactly one index level")
+  }
+  i <- match(x, levels)
+  if (anyNA(i)) {
+    stop(gettextf("'%s' is not an index level", x))
+  }
+  i
+}
+
+match_time <- function(x, time, several = FALSE) {
+  if (!several && length(x) != 1L) {
+    stop("must supply exactly one time period")
+  } else if (several && length(x) == 0L) {
+    stop("must supply at least one time period")
+  }
+  i <- match(x, time)
+  no_match <- is.na(i)
+  if (any(no_match)) {
+    stop(gettextf("'%s' is not a time period", x[no_match][1L]))
+  }
+  i
+}

R/update.aggregation_structure.R

@@ -54,12 +54,12 @@ update.piar_aggregation_structure <- function(object, index,
                                               r = 1) {
   price_update <- gpindex::factor_weights(r)
   index <- as_index(index)
-  period <- match.arg(as.character(period), index$time)
+  period <- match_time(as.character(period), index$time)
   eas <- match(object$levels[[length(object$levels)]], index$levels)
   if (anyNA(eas)) {
     warning("not all weights in 'object' have a corresponding index value")
   }
-  epr <- chain(index)$index[[match(period, index$time)]]
+  epr <- chain(index)$index[[period]]
   weights(object) <- price_update(epr[eas], object$weights)
   object
 }

R/window.piar_index.R

@@ -1,14 +1,10 @@
 #' Get the indexes for a window of time periods
 #' @noRd
 index_window <- function(x, start, end) {
-  start <- match(
-    if (is.null(start)) start(x) else match.arg(start, x$time),
-    x$time
-  )
-  end <- match(
-    if (is.null(end)) end(x) else match.arg(end, x$time),
-    x$time
-  )
+  if (is.null(start)) start <- start(x)
+  if (is.null(end)) end <- end(x)
+  start <- match_time(as.character(start), x$time)
+  end <- match_time(as.character(end), x$time)
 
   if (start > end) {
     stop("'start' must refer to a time period before 'end'")