R: data.table compute weighted means of multiple variables with multiple weight variables each, by group

Question

I am still new to data.table. My question is similar to this one and this one. The difference is that I want to compute weighted means for multiple variables, by groups, but using more than one weight for each mean.

Consider the following data.table (the actual is much larger):

library(data.table)

set.seed(123456)

mydata <- data.table(CLID = rep("CNK", 10),
                     ITNUM = rep(c("First", "Second", "First", "First", "Second"), 2),
                     SATS = rep(c("Always", "Amost always", "Sometimes", "Never", "Always"), 2),
                     ASSETS = rep(c("0-10", "11-25", "26-100", "101-200", "MORE THAN 200"), 2),
                     AVGVALUE1 = rnorm(10, 10, 2),
                     AVGVALUE2 = rnorm(10, 10, 2),
                     WGT1 = rnorm(10, 3, 1),
                     WGT2 = rnorm(10, 3, 1),
                     WGT3 = rnorm(10, 3, 1))

#I set the key of the table to the variables I want to group by,
#so the output is sorted
setkeyv(mydata, c("CLID", "ITNUM", "SATS", "ASSETS"))

What I want to achieve is to compute the weighted means for AVGVALUE1 and AVGVALUE2 (and possibly more variables) by groups defined by ITNUM, SATS, ASSETS using each one of the weight variables WGT1, WGT2, WGT3 (and possibly more of them). So for each of the variables I want to compute the weighted means I will have three weighted means by groups (or whatever the number of weights is).

I can do it for each variable separately, e.g.:

all.weights <- c("WGT1", "WGT2", "WGT3")
avg.var <- "AVGVALUE1"
split.vars <- c("ITNUM", "SATS", "ASSETS")

mydata[ , Map(f = weighted.mean, x = .(get(avg.var)), w = mget(all.weights),
na.rm = TRUE), by = c(key(mydata)[1], split.vars)]

I add the first key variable in by, although it is a constant, because I would like to have it as a column in the output. And I get:

   CLID  ITNUM         SATS        ASSETS       V1       V2       V3
1:  CNK  First       Always          0-10 11.66824 11.66819 11.66829
2:  CNK  First        Never       101-200 11.37378 12.21008 11.60182
3:  CNK  First    Sometimes        26-100 12.43004 13.13450 12.01330
4:  CNK Second       Always MORE THAN 200 12.32265 11.81613 12.56786
5:  CNK Second Amost always         11-25 10.76556 11.34669 10.52458

However, with the actual data.table, where I have much more columns to compute the weighted means for (as well as much more weights to use), it would be rather cumberosme to do it one by one. What I imagine is a function where the mean for each of the variables (AVGVALUE1, AVGVALUE2 and so on) is computed with each of the weight variables (WGT1, WGT2, WGT3 and so on) and the output for each variable for which the weighted mean is computed is added to a list. I guess the list would be the best option because if all estimates are in the same output, the number of columns might be endless. So something like this:

[[1]]
   CLID  ITNUM         SATS        ASSETS       V1       V2       V3
1:  CNK  First       Always          0-10 11.66824 11.66819 11.66829
2:  CNK  First        Never       101-200 11.37378 12.21008 11.60182
3:  CNK  First    Sometimes        26-100 12.43004 13.13450 12.01330
4:  CNK Second       Always MORE THAN 200 12.32265 11.81613 12.56786
5:  CNK Second Amost always         11-25 10.76556 11.34669 10.52458

[[2]]
   CLID  ITNUM         SATS        ASSETS        V1        V2        V3
1:  CNK  First       Always          0-10  9.132899  9.060045  9.197005
2:  CNK  First        Never       101-200 12.896584 13.278680 13.000772
3:  CNK  First    Sometimes        26-100 10.972260 11.215390 10.828431
4:  CNK Second       Always MORE THAN 200 11.704404 11.611072 11.749586
5:  CNK Second Amost always         11-25  8.086409  8.225030  8.028928

What I tried so far:

Using lapply

all.weights <- c("WGT1", "WGT2", "WGT3")
avg.vars <- c("AVGVALUE1", "AVGVALUE2")
split.vars <- c("ITNUM", "SATS", "ASSETS")

lapply(mydata, function(i) {
mydata[ , Map(f = weighted.mean, x = mget(avg.vars)[i], w = mget(all.weights),
na.rm = TRUE), by = c(key(mydata)[1], split.vars)]
})

Error in weighted.mean.default(x = dots[[1L]][[1L]], w = dots[[2L]][[1L]],  : 
 'x' and 'w' must have the same length

Using mapply

myfun <- function(data, spl.v, avg.v, wgts) {
  data[ , Map(f = weighted.mean, x = mget(avg.v), w = mget(all.weights),
  na.rm = TRUE), by = c(key(data)[1], spl.v)]
}

mapply(FUN = myfun, data = mydata, spl.v = split.vars, avg.v = avg.vars,
wgts = all.weights)

Error: value for ‘AVGVALUE2’ not found

I tried to wrap the mget(avg.v) as a list - .(mget(avg.v)), but then get another error:

 Error in mapply(FUN = f, ..., SIMPLIFY = FALSE) : 
  could not find function "."

Can someone help?

dww · Answer 1 · 2016-11-02T18:45:43.733

We can use outer (which performs a function on all combinations of the values in two input vectors) operating on a vectorized weighted means function. By defining the function used by outer within the scope of the data table, we can have get evaluate to the data.table columns:

wmeans = mydata[, {
  f  = function(X,Y) weighted.mean(get(X), get(Y));
  vf = Vectorize(f);
  outer(avg.var, all.weights, vf)},
  by = split.vars]

This puts all the means into a single column (i.e. 'long' format). We can also add a couple more columns to specify which value/weight combination each refers to:

wmeans[, mean.v := expand.grid(avg.var, all.weights)[,1]]       
wmeans[, mean.w := expand.grid(avg.var, all.weights)[,2]]
head(wmeans)
#    ITNUM   SATS ASSETS        V1    mean.v mean.w
# 1: First Always   0-10 11.668243 AVGVALUE1   WGT1
# 2: First Always   0-10  9.132899 AVGVALUE2   WGT1
# 3: First Always   0-10 11.668192 AVGVALUE1   WGT2
# 4: First Always   0-10  9.060045 AVGVALUE2   WGT2
# 5: First Always   0-10 11.668287 AVGVALUE1   WGT3
# 6: First Always   0-10  9.197005 AVGVALUE2   WGT3

We can use dcast to reshape this into a data.table that is long in avg.var, but wide in all.weights:

wide.wmeans = dcast(wmeans, mean.v+ITNUM+SATS+ASSETS ~ mean.w, value.var = "V1")  
#       mean.v  ITNUM         SATS        ASSETS      WGT1      WGT2      WGT3
# 1: AVGVALUE1  First       Always          0-10 11.668243 11.668192 11.668287
# 2: AVGVALUE1  First        Never       101-200 11.373780 12.210083 11.601819
# 3: AVGVALUE1  First    Sometimes        26-100 12.430039 13.134499 12.013299
# 4: AVGVALUE1 Second       Always MORE THAN 200 12.322651 11.816135 12.567860
# 5: AVGVALUE1 Second Amost always         11-25 10.765557 11.346688 10.524583
# 6: AVGVALUE2  First       Always          0-10  9.132899  9.060045  9.197005
# 7: AVGVALUE2  First        Never       101-200 12.896584 13.278680 13.000772
# 8: AVGVALUE2  First    Sometimes        26-100 10.972260 11.215390 10.828431
# 9: AVGVALUE2 Second       Always MORE THAN 200 11.704404 11.611072 11.749586
#10: AVGVALUE2 Second Amost always         11-25  8.086409  8.225030  8.028928

If you need this as a list rather than a data.table, you can split it up using

lapply(avg.var, function(x) wide.wmeans[mean.v == x])
# [[1]]
#       mean.v  ITNUM         SATS        ASSETS     WGT1     WGT2     WGT3
# 1: AVGVALUE1  First       Always          0-10 11.66824 11.66819 11.66829
# 2: AVGVALUE1  First        Never       101-200 11.37378 12.21008 11.60182
# 3: AVGVALUE1  First    Sometimes        26-100 12.43004 13.13450 12.01330
# 4: AVGVALUE1 Second       Always MORE THAN 200 12.32265 11.81613 12.56786
# 5: AVGVALUE1 Second Amost always         11-25 10.76556 11.34669 10.52458
# 
# [[2]]
#       mean.v  ITNUM         SATS        ASSETS      WGT1      WGT2      WGT3
# 1: AVGVALUE2  First       Always          0-10  9.132899  9.060045  9.197005
# 2: AVGVALUE2  First        Never       101-200 12.896584 13.278680 13.000772
# 3: AVGVALUE2  First    Sometimes        26-100 10.972260 11.215390 10.828431
# 4: AVGVALUE2 Second       Always MORE THAN 200 11.704404 11.611072 11.749586
# 5: AVGVALUE2 Second Amost always         11-25  8.086409  8.225030  8.028928

Hack-R · Accepted Answer · 2016-10-29T17:00:34.447

I. lapply solution

all.weights <- c("WGT1", "WGT2", "WGT3")
avg.vars    <- c("AVGVALUE1", "AVGVALUE2")
split.vars  <- c("ITNUM", "SATS", "ASSETS")

myfun <- function(avg.vars){
  tmp <-
    mydata[ , Map(f = weighted.mean, 
                x = .(get(avg.vars)), 
                w = mget(all.weights),
                na.rm = TRUE), 
          by = c(key(mydata)[1], split.vars)]  

  return(tmp) # totally optional, a habit from using C and Java
}

lapply(avg.vars, myfun)

Up-sides:

Makes use of an *apply
Avoids loop
Way faster than doing it one by one

Down-sides:

Returns a list

[[1]]
   CLID  ITNUM         SATS        ASSETS       V1       V2       V3
1:  CNK  First       Always          0-10 11.66824 11.66819 11.66829
2:  CNK  First        Never       101-200 11.37378 12.21008 11.60182
3:  CNK  First    Sometimes        26-100 12.43004 13.13450 12.01330
4:  CNK Second       Always MORE THAN 200 12.32265 11.81613 12.56786
5:  CNK Second Amost always         11-25 10.76556 11.34669 10.52458

[[2]]
   CLID  ITNUM         SATS        ASSETS        V1        V2        V3
1:  CNK  First       Always          0-10  9.132899  9.060045  9.197005
2:  CNK  First        Never       101-200 12.896584 13.278680 13.000772
3:  CNK  First    Sometimes        26-100 10.972260 11.215390 10.828431
4:  CNK Second       Always MORE THAN 200 11.704404 11.611072 11.749586
5:  CNK Second Amost always         11-25  8.086409  8.225030  8.028928

II. for loop solution

Using a simple for loop with the example where avg.vars has 2 values:

all.weights <- c("WGT1", "WGT2", "WGT3")
avg.vars    <- c("AVGVALUE1", "AVGVALUE2")
split.vars  <- c("ITNUM", "SATS", "ASSETS")

result <- data.frame(matrix(nrow=0,ncol=7))
for(i in avg.vars){
  tmp <- 
    mydata[ , Map(f = weighted.mean, 
                x = .(get(i)), 
                w = mget(all.weights),
                na.rm = TRUE), 
          by = c(key(mydata)[1], split.vars)]  

  result <- rbind(result,tmp,use.names=F)
}
colnames(result) <- c("CLID", "ITNUM", "SATS", "ASSETS", "V1", "V2", "V3")
result

    CLID  ITNUM         SATS        ASSETS        V1        V2        V3
 1:  CNK  First       Always          0-10 11.668243 11.668192 11.668287
 2:  CNK  First        Never       101-200 11.373780 12.210083 11.601819
 3:  CNK  First    Sometimes        26-100 12.430039 13.134499 12.013299
 4:  CNK Second       Always MORE THAN 200 12.322651 11.816135 12.567860
 5:  CNK Second Amost always         11-25 10.765557 11.346688 10.524583
 6:  CNK  First       Always          0-10  9.132899  9.060045  9.197005
 7:  CNK  First        Never       101-200 12.896584 13.278680 13.000772
 8:  CNK  First    Sometimes        26-100 10.972260 11.215390 10.828431
 9:  CNK Second       Always MORE THAN 200 11.704404 11.611072 11.749586
10:  CNK Second Amost always         11-25  8.086409  8.225030  8.028928

Up-sides:

Completes instantly in the example
Scales to any number of columns with no additional data manipulation/coding
Will save a huge amount of time over going one by one
Returns a nice data.table
if you actually want a list you can get that by initializing return as a list (return <- list()), creating a counter variable (n <- 1) then replacing the rbind statement with return[n] <- tmp and incrementing the counter (n <- n + 1) within the loop

Down-sides:

If your data is very large (e.g. > 100,000 rows and dozens or more values of avg.var) then performance of any loop or function written with loops will be poor

Thank you, but I found an issue in both the `lapply` (which I would prefer) and the `for`loop` solution. If you add one more column to compute the mean on (say `CRMVAR = rnorm(10, 10, 2)`) to `mydata`, and then add it to `avg.vars` (`avg.vars <- c("AVGVALUE1", "AVGVALUE2", "CRMVAR")`), the function will return a list of 3 components, as needed. But the values for the first 2 components will differ from the output above. So the output would depend on the number of columns you try to compute the means for. It seems to me that in this case `lapply` messes up something internally. How to fix this? — panman, Oct 31 '16 at 15:54
@panman That's weird. Could you please update the question with the new example and expected output so that I can reproduce and fix the problem? — Hack-R, Oct 31 '16 at 16:02
Oh, sorry, it was entirely my mistake. I added the new variable (`CRMVAR`) to `mydt` using the original syntax at the beginning of my post and although I used the same seed, the values of the rest of the variables changed (I use R 3.3.1 in Linux), but I was comparing the values with the ones in the example output I had already posted. Everything is OK, sorry for the confusion. — panman, Oct 31 '16 at 16:43

R: data.table compute weighted means of multiple variables with multiple weight variables each, by group

What I tried so far:

2 Answers2