Match vector values with elements in list in R - r

Question

I am trying to match a vector of months to the appropriate quarter in R. Unfortunately, the code I inherited contains the quarters in a list with the appropriate months as a vector of each list element (this least is supposed to be adaptable such that you could do quarters, trimesters, or semesters if desired). Currently, I am using sapply to loop through the vector and match the appropriate quarter to each month as follows:
month.vec <- sample(1:12, 100, replace=T)
quarters.list <- list(`1` = 1:3, `2` = 4:6, `3` = 7:9, `4` = 10:12)
month.to.quarter <- function(months, quarters) {
sapply(months, FUN=function(x) {
as.numeric(substr(names(which(x == unlist(quarters))),0,1))
})
}
month.to.quarter(month.vec, quarters.list)
This works great for vectors of about length(month.vec) < 1e5 or so, but is a bit time consuming after that (see code below). Does anyone have an elegant solution for this sort of matching at vectors longer than this?
Script to show how processing time increases with vector length. NOTE: this takes a few seconds (<10)
times <- NULL
for (i in c(10 %o% 10^(2:5))) {
month.vec <- sample(1:12, i, replace=T)
quarters.list <- list(`1` = 1:3, `2` = 4:6, `3` = 7:9, `4` = 10:12)
t <- system.time(a <- month.to.quarter(month.vec, quarters.list))[3]
time <- data.frame(n = i, time = t)
times <- rbind(times, time)
}
plot(time ~ n, times)

Answer 1

I wonder whether it would be faster to invert the quarters list, so that the quarter can just be looked up using month as the index. Something like the following...
quarters <- as.numeric(substr(names(sort(unlist(quarters.list))),1,1))
This only needs to be done once, and then you can just do
quarters.vec <- quarters[month.vec]
It is about 2000 times faster...
microbenchmark::microbenchmark(quarters[month.vec],month.to.quarter(month.vec, quarters.list))
Unit: microseconds
expr min lq mean median uq max neval
quarters[month.vec] 199.836 202.629 235.3968 227.763 233.9695 554.823 100
month.to.quarter(month.vec, quarters.list) 439466.006 456649.059 495957.5722 469543.098 499346.5020 935046.664 100

Answer 2

Try this:
(month.vec - 1) %/% 3 + 1

Answer 3

This is the first method I came up with. I think I saw it in Hudley's book. It uses names for the element of a vector.
month.vec <- sample(1:12, 10000, replace=T)
quarters.list <- list(`1` = 1:3, `2` = 4:6, `3` = 7:9, `4` = 10:12)
# your method
month.to.quarter <- function(months, quarters) {
sapply(months, FUN=function(x) {
as.numeric(substr(names(which(x == unlist(quarters))),0,1))
})
}
out1 <-month.to.quarter(month.vec, quarters.list)
# my method
vec <- rep(1:4, each = 3)
names(vec) <- 1:12
out2 <- vec[month.vec]
names(out2) <- NULL
all.equal(out1, out2) # this will return TRUE
Benchmark is really different.
month.vec <- sample(1:12, 10000, replace=T)
microbenchmark::microbenchmark(vec[month.vec],
month.to.quarter(month.vec, quarters.list))
## Unit: microseconds
## expr min lq mean median uq max neval
## vec[month.vec] 108.503 112.433 119.3982 116.916 119.983 183.467 100
## month.to.quarter(month.vec, quarters.list) 78859.160 84036.995 87956.6532 86960.269 89975.668 140797.487 100
The new method is about 800 times faster.
If you want to make it a function it's like this and still quite fast
month.to.quarter2 <- function(months) {
vec <- rep(1:4, each = 3)
names(vec) <- 1:12
out <- vec[months]
names(out) <- NULL
return(out)
}
microbenchmark::microbenchmark(vec[month.vec],
month.to.quarter(month.vec, quarters.list),
month.to.quarter2(month.vec))
## Unit: microseconds
## expr min lq mean median uq max neval
## vec[month.vec] 109.222 111.6345 121.3035 115.604 117.916 706.034 100
## month.to.quarter(month.vec, quarters.list) 77292.742 83032.7425 85770.6963 84690.500 87243.327 138531.309 100
## month.to.quarter2(month.vec) 117.264 120.3555 127.6535 127.021 133.474 153.556 100