Question

我在df上执行PCA和FA。现在，我想使用我的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

看看以下内容对您有用吗？

步骤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)
}

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

2 个答案: