dplyr：使用矩阵中的值子集创建带有 case_when 的新列

Question

I am trying to use create a new column in a data frame using mutate and case_when but I get unexpected results.

Here is a dput of a subset of my data: Pastebin .

The aim is to calculate own and cross price elasticities for products in multiple completely separate markets. My idea was to use case_when to use different expressions for own and cross elasticities and use a unique product identifier ( IDprod_un_j and IDprod_un_l ) to subset some values from another matrix. This is the code I am using:

elast_small %<>% 
  mutate(
    eta_jlm_rc = case_when(
      IDprod_j == IDprod_l ~ (-price_j/share_j) * rowMeans(-alpha_i_rc * share_i_small[IDprod_un_j,] * (1-share_i_small[IDprod_un_j,])),
      IDprod_j != IDprod_l ~ (-price_l/share_j) * rowMeans(alpha_i_rc * share_i_small[IDprod_un_j,] * share_i_small[IDprod_un_l,])
    )
  )

This runs without errors, but when I try to verify the results, I get different values:

> -elast_small$price_j[1] / elast_small$share_j[1] * mean(-alpha_i_rc * share_i_small[1,] * (1-share_i_small[1,]))
[1] -10.02669
> elast_small$eta_jlm_rc[1]
[1] -14.83231

What am I missing here?

Answer 1

What I was missing here is that case_when does not apply the RHS row by row, but in one go for each case so that share_i_small[IDprod_un_j,] returns a matrix with more than one row. Multiplying a vector and a matrix is done columnwise in R, so the multiplication is not correct.

This solves the issue:

elast %<>%
  mutate(
    eta_jlm_rc = case_when(
      IDprod_j == IDprod_l ~ (-price_j/share_j) * rowMeans(t(t(share_i[IDprod_ud_j,] * (1-share_i[IDprod_ud_j,])) * -alpha_i_rc)),
      IDprod_j != IDprod_l ~ (-price_l/share_j) * rowMeans(t(t(share_i[IDprod_ud_j,] * share_i[IDprod_ud_l,]) * alpha_i_rc))
    )
  )

Answer 2

It looks like it might work if you group by product type j and l and then make the variables by which you're multiplying (-price/share) before hand in the mutate() statement:

tmp <- elast_small %>% 
  group_by(IDprod_un_j,IDprod_un_l) %>% 
  mutate(
    newvar1 = mean(-alpha_i_rc * share_i_small[IDprod_un_j, ] * (1-share_i_small[IDprod_un_j, ])), 
    newvar2 = mean(alpha_i_rc * share_i_small[IDprod_un_j, ] * share_i_small[IDprod_un_l, ]), 
    eta_jlm_rc = case_when(
      IDprod_j == IDprod_l ~ (-price_j/share_j) * newvar1,
      IDprod_j != IDprod_l ~ (-price_l/share_j) * newvar2
    )
  )

tmp %>% 
  select(IDprod_un_j, IDprod_un_l, eta_jlm_rc2) %>% 
  as.data.frame %>% 
  head
# IDprod_un_j IDprod_un_l   eta_jlm_rc2
# 1           1           1 -10.026692702
# 2           1           2   0.001446025
# 3           1           3   0.005316131
# 4           1           4   0.133027210
# 5           1           5   0.017306581
# 6           1           6   0.063833755