在 R 中使用 mutate 中的 lapply 进行不同长度的计算

Question

我有一个执行 PCA 和 FA 的 df。现在我想使用我的 FA 模型来计算我的新因子值。所以我有一个带有测量值的 df 来计算，还有一个单独的 df 带有变量的名称、计算中使用的负载大小以及它所属的因子的数量。这里有一些虚拟数据：

set.seed(4711)
df <- data.frame(matrix(sample(0:6, 120, replace = TRUE), ncol = 15, nrow = 8))
var <- colnames(df)
load_val <- rnorm(length(var), mean = .5, sd = .2)
fac_nr <- c(2,2,1,3,5,4,1,1,3,2,4,2,5,2,2)
fa_dat <- data.frame(var, load_val, fac_nr)
fa_dat[fac_nr == 1, "var"]`

所以现在我必须计算 5 个新变量，从 F1 到 F5。在硬编码中，它会是这样的：

#Creating and calculating F1 (on 3 variables)
f1_var <- as.character(fa_dat[fac_nr == 1, "var"]) #The variables to use
f1_load <- fa_dat[fac_nr == 1, "load_val"] #The loadings to use
df$F1 <- df[f1_var[1]] * f1_load[1] + df[f1_var[2]] * f1_load[2] + 
  df[f1_var[3]] * f1_load[3] 

#Creating and calculating F2 (on 6 variables)
f2_var <- as.character(fa_dat[fac_nr == 2, "var"])
f2_load <- fa_dat[fac_nr == 2, "load_val"]
df$F2 <- df[f2_var[1]] * f2_load[1] + df[f2_var[2]] * f2_load[2] + 
  df[f2_var[3]] * f2_load[3] + df[f2_var[4]] * f2_load[4] + 
  df[f2_var[5]] * f2_load[5] + df[f2_var[6]] * f2_load[6]

#Creating and calculating F3 (on 2 variables)
f3_var <- as.character(fa_dat[fac_nr == 3, "var"])
f3_load <- fa_dat[fac_nr == 3, "load_val"]
df$F3 <- df[f3_var[1]] * f3_load[1] + df[f3_var[2]] * f3_load[2]

#Creating and calculating F4 (on 2 variables)
f4_var <- as.character(fa_dat[fac_nr == 4, "var"])
f4_load <- fa_dat[fac_nr == 4, "load_val"]
df$F4 <- df[f4_var[1]] * f4_load[1] + df[f4_var[2]] * f4_load[2]

#Creating and calculating F5 (on 2 variables)
f5_var <- as.character(fa_dat[fac_nr == 5, "var"])
f5_load <- fa_dat[fac_nr == 5, "load_val"]
df$F5 <- df[f5_var[1]] * f5_load[1] + df[f5_var[2]] * f5_load[2]`

所以这是想要的结果（不要介意列名）：

我知道如何在循环中创建新变量，但我不知道——而且真的找不到——如何计算这个新变量中的值，计算的长度在哪里变化以及我在哪里获得变量- 来自另一个对象的名称并根据 F 数选择它们。我认为解决方案可能是将mutate 函数与lapply 结合使用。我试过了，但绝望地失败了。

我希望有人可以帮助我一点？提前谢谢你:-)

Answer 1

看看以下是否适合你？

第一步：重命名fa_dat中fac_nr中的值；我们以后可以直接使用它来创建变量。

library(dplyr)
library(tidyr)

fa_dat <- fa_dat %>%
  mutate(fac_nr = paste0("F", fac_nr))

> fa_dat
   var  load_val fac_nr
1   X1 0.6017347     F2
2   X2 0.6585308     F2
3   X3 0.5286310     F1
4   X4 0.4954384     F3
5   X5 0.4900243     F5
6   X6 0.3144942     F4
7   X7 0.3793662     F1
8   X8 0.3453306     F1
9   X9 0.6922815     F3
10 X10 0.4996667     F2
11 X11 0.4545040     F4
12 X12 0.5386711     F2
13 X13 0.6527543     F5
14 X14 0.5332412     F2
15 X15 0.5164538     F2

第 2 步：计算每个 F# 的结果

df2 <- df %>%
  # add a row number so we can sort it back to the original order later
  mutate(row.id = seq(1, n())) %>%

  # gather all the variables (except row id) & join each to all
  # the corresponding combinations of F# & load_val
  gather(var, value, -row.id) %>%
  left_join(fa_dat, by = "var") %>%

  # calculate the result for each row & each F#
  group_by(row.id, fac_nr) %>%
  summarise(result = sum(value * load_val)) %>%
  ungroup() %>%

  # get the results back into original wide format, making
  # sure the rows are sorted in the correct order
  spread(fac_nr, result) %>%
  arrange(row.id) %>%
  select(-row.id)

> df2
# A tibble: 8 x 5
     F1    F2    F3    F4    F5
  <dbl> <dbl> <dbl> <dbl> <dbl>
1  1.93 10.1   5.64 1.57   4.24
2  6.27  8.13  5.74 1.36   2.29
3  5.36  6.30  2.67 2.31   1.96
4  7.14  7.30  4.15 3.22   1.31
5  1.91 12.7   2.67 2.48   2.29
6  6.76 10.3   3.07 3.67   4.73
7  3.21 11.2   3.66 0.629  5.06
8  6.61  6.94  0    4.16   5.88

第 3 步：将结果添加回 df

df <- cbind(df, df2)

> df
  X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15       F1        F2       F3        F4       F5
1  6  1  3  3  2  5  0  1  6   2   0   5   5   2   2 1.931224 10.061018 5.640005 1.5724709 4.243820
2  3  0  5  6  2  0  5  5  4   3   3   4   2   5   0 6.266639  8.125094 5.741757 1.3635119 2.285557
3  6  0  4  4  4  3  4  5  1   0   3   5   0   0   0 5.358642  6.303763 2.674035 2.3069944 1.960097
4  1  4  6  0  0  3  5  6  6   5   5   0   2   1   2 7.140600  7.300340 4.153689 3.2160023 1.305509
5  6  5  1  4  2  5  0  4  1   0   2   4   2   2   5 1.909953 12.706498 2.674035 2.4814788 2.285557
6  4  1  6  2  3  3  4  6  3   5   6   1   5   2   6 6.761234 10.267679 3.067722 3.6705063 4.733844
7  2  1  0  6  5  2  3  6  1   6   0   6   4   1   5 3.210082 11.207537 3.664912 0.6289884 5.061138
8  1  0  5  0  4  6  5  6  0   2   5   4   6   5   1 6.611969  6.938412 0.000000 4.1594849 5.876623

Answer 2

这是使用dplyr 包的解决方案：

library(dplyr)

add_column <- function(i){
  cols <- fa_dat %>% filter(fac_nr==i) %>% select(var)
  cols <- cols$var
  cols_idx <- which(colnames(df) %in% cols)

  df_filtered <- df %>% select(cols_idx)

  coef <- fa_dat %>% filter(fac_nr==i) %>% select(load_val)
  coef <- coef$load_val

  return(as.matrix(df_filtered) %*% coef) 
}

for(i in unique(fa_dat$fac_nr)){
  df[paste0("F",i)] <- add_column(i)
}