R按组逐列将回归系数存储在数据帧中

时间:2019-05-10 17:39:23

标签: r dplyr regression

我有一个带有调查结果的数据框。结果以垂直格式存储。数据框看起来像这样-

set.seed(1000)

df = data.frame(RESP_ID=c(rep(1,6),rep(2,8),rep(3,9),rep(4,5),rep(5,4),rep(6,10),rep(7,4),rep(8,8),rep(9,8),rep(10,10)),
                CLIENT=c(rep("A",6),rep("A",8),rep("A",9),rep("A",5),rep("A",4),rep("B",10),rep("B",4),rep("B",8),rep("B",8),rep("B",10)),
                QST=c(paste0("Q",c(1:6)),paste0("Q",c(1:8)),paste0("Q",c(1:9)),paste0("Q",c(1:5)),paste0("Q",c(1:4)),paste0("Q",c(1:10)),paste0("Q",c(1:4)),paste0("Q",c(1:8)),paste0("Q",c(1:8)),paste0("Q",c(1:10))),
                VALUE=round(runif(72,1,4),0))

数据框说明

RESP_ID =受访者ID。每个ID通讯员都对应一个响应者。在此示例数据框架中,我们有10位受访者。

客户(CLIENT)=受访者姓名(被调查者)。在此示例数据框中,我们有两个客户端(A和B)。

QST =与调查中的问题编号相对应。

VALUE =对应于问题的答案选项。所有问题都有4个答案选项(1至4)。

客观

对于每个客户和问题的组合,我想创建一个单独的列,用于存储该问题在QST列中回归到Q2的回归系数。

因此,在回归模型中,Q2是因变量,所有其他问题都是自变量。

我的尝试

我的尝试没有给我想要的结果。

slopesdf = df %>%
  spread(QST, VALUE, fill = 0) %>%
  group_by(CLIENT) %>%
  mutate(COEFFICIENT=lm(Q2 ~ .))

我试图首先按CLIENTQST分组,然后为每个问题的斜率找到与Q2回归的斜率。我相信有更好的方法可以做到这一点。

当前,我的尝试给我以下错误消息-

  

mutate_impl(.data,点)中的错误:评估错误:“。”丹斯拉   公式和参数“数据”

所需的输出

我希望最终数据帧包含三列:一列用于CLIENT,一列用于QST,第三列称为COEFFICIENT,其CLIENT和QST每种组合的系数将Q2作为响应变量回归。

对此将提供任何帮助。

3 个答案:

答案 0 :(得分:1)

我不确定100%的输出是否是您所追求的,但这是否在正确的轨道上?

df2 <- df %>%
  spread(QST, VALUE, fill = 0) %>%
  split(.$CLIENT) %>%
  lapply(., function(x) { lm(Q2 ~ ., x[, -c(1,2)])$coefficients }) %>%
  do.call(rbind, .) %>%
  data.frame(.) %>%
  mutate(CLIENT = rownames(.)) %>%
  gather(QST, COEFFICIENT, -CLIENT) %>%
  arrange(CLIENT)


> df2
   CLIENT          QST   COEFFICIENT
1       A X.Intercept. -1.200000e+01
2       A           Q1  1.000000e+00
3       A          Q10            NA
4       A           Q3  2.000000e+00
5       A           Q4  3.000000e+00
6       A           Q5  5.000000e-01
7       A           Q6            NA
8       A           Q7            NA
9       A           Q8            NA
10      A           Q9            NA
11      B X.Intercept.  5.000000e+00
12      B           Q1 -1.326970e-16
13      B          Q10  1.666667e+00
14      B           Q3  3.726559e-15
15      B           Q4 -2.000000e+00
16      B           Q5            NA
17      B           Q6            NA
18      B           Q7            NA
19      B           Q8            NA
20      B           Q9            NA

编辑:

运行拆分组件只会为每个客户端生成一个宽格式数据帧列表:

df %>%
  spread(QST, VALUE, fill = 0) %>%
  split(.$CLIENT) 

$A
  RESP_ID CLIENT Q1 Q10 Q2 Q3 Q4 Q5 Q6 Q7 Q8 Q9
1       1      A  4   0  1  4  3  3  2  0  0  0
2       2      A  2   0  2  2  3  2  4  4  3  0
3       3      A  2   0  2  3  3  1  2  4  2  3
4       4      A  3   0  3  4  2  1  0  0  0  0
5       5      A  3   0  4  4  3  0  0  0  0  0

$B
   RESP_ID CLIENT Q1 Q10 Q2 Q3 Q4 Q5 Q6 Q7 Q8 Q9
6        6      B  3   2  3  2  3  2  2  1  3  3
7        7      B  2   0  3  2  2  0  0  0  0  0
8        8      B  3   0  2  4  1  3  3  2  3  0
9        9      B  2   0  1  4  2  1  3  1  2  0
10      10      B  3   2  3  3  3  3  4  2  3  3

请注意,对于原始数据没有值的问题,如果没有回答,则所有零填充。参见Ben Bolker对此的回答。

如果您现在包括在每个代码上运行lm的代码,则可以直接获取系数值,其中包括上面显示的NA值:

> df %>%
+   spread(QST, VALUE, fill = 0) %>%
+   split(.$CLIENT) %>%
+   lapply(., function(x) { lm(Q2 ~ ., x[, -c(1,2)])$coefficients })
$A
(Intercept)          Q1         Q10          Q3          Q4          Q5          Q6          Q7          Q8          Q9 
  6.6666667   2.0000000          NA  -1.6666667  -0.6666667  -1.6666667          NA          NA          NA          NA 

$B
(Intercept)          Q1         Q10          Q3          Q4          Q5          Q6          Q7          Q8          Q9 
       13.0        -3.0        -0.5        -2.0          NA         2.0          NA          NA          NA          NA 

编辑2:

如果使用以下df,只需探索更完整的数据集即可:

set.seed(42)
df <-
  expand.grid(RESP_ID = 1:10,
              CLIENT = c("A", "B"),
              QST = paste("Q", 1:10, sep = "")) %>%
  mutate(VALUE = round(runif(200, 1, 4), 0))

并运行相同的代码,我们得到不带NA值的系数:

> df %>%
+   spread(QST, VALUE, fill = 0) %>%
+   split(.$CLIENT) %>%
+   lapply(., function(x) { lm(Q2 ~ ., x[, -c(1,2)])$coefficients }) %>%
+   do.call(rbind, .) %>%
+   data.frame(.) %>%
+   mutate(CLIENT = rownames(.)) %>%
+   gather(QST, COEFFICIENT, -CLIENT) %>%
+   arrange(CLIENT)
   CLIENT          QST COEFFICIENT
1       A X.Intercept.  6.50000000
2       A           Q1 -4.14285714
3       A           Q3  2.50000000
4       A           Q4  0.85714286
5       A           Q5  1.00000000
6       A           Q6 -0.64285714
7       A           Q7 -1.21428571
8       A           Q8 -1.85714286
9       A           Q9  2.50000000
10      A          Q10 -0.07142857
11      B X.Intercept. -4.69924812
12      B           Q1 -0.86466165
13      B           Q3  1.56390977
14      B           Q4  1.10150376
15      B           Q5 -0.86842105
16      B           Q6  0.87593985
17      B           Q7  0.57142857
18      B           Q8  0.25187970
19      B           Q9  0.79699248
20      B          Q10 -0.12781955

答案 1 :(得分:1)

一种遵循我大脑逻辑的解决方案(我们需要将Q2作为一个单独的变量使用……一旦以这种方式重新排列数据,我们就可以运行。(NA值肯定是由于这个微小数据集中的缺陷-预测变量没有变化,因此无法估计响应的情况...)

(df
    %>% group_by(RESP_ID,CLIENT)
    ## add a new variable for Q2
    %>% mutate(Q2=VALUE[QST=="Q2"])
    ## drop the old one
    %>% filter(QST!="Q2")
    %>% group_by(CLIENT,QST)
    ## run the regression by group; return a data frame
    %>% do(as.data.frame(rbind(coef(lm(Q2~VALUE,data=.)))))
    ## convert wide coefficients to long
    %>% tidyr::gather(coef,value,-c(CLIENT,QST))
    %>% arrange(CLIENT)
)

答案 2 :(得分:1)

对于这样的任务,我喜欢R for Data Science中的“许多模型”方法。它符合tidyverse样式,使用嵌套数据框和purrr::map创建模型的列表列。然后broom::tidy提供实用程序,用于提取您需要的有关模型的信息。

我放下ID列只是为了在数据散布后摆脱它,然后按CLIENT进行分组和嵌套:

library(tidyverse)

df %>%
  spread(key = QST, value = VALUE, fill = 0) %>%
  select(-RESP_ID) %>%
  group_by(CLIENT) %>%
  nest()
#> # A tibble: 2 x 2
#>   CLIENT data             
#>   <fct>  <list>           
#> 1 A      <tibble [5 × 10]>
#> 2 B      <tibble [5 × 10]>

然后,创建一列线性模型。将quick = T传递到broom::tidy会返回模型诊断表的简化版本;如果不进行设置,则还会为模型中的每个变量获取标准误差,测试统计信息和p值。

df %>%
  spread(key = QST, value = VALUE, fill = 0) %>%
  select(-RESP_ID) %>%
  group_by(CLIENT) %>%
  nest() %>%
  mutate(lm_mod = map(data, function(d) lm(Q2 ~ ., data = d))) %>%
  mutate(mod_tidy = map(lm_mod, broom::tidy, quick = T)) %>%
  unnest(mod_tidy) %>%
  head()
#> # A tibble: 6 x 3
#>   CLIENT term        estimate
#>   <fct>  <chr>          <dbl>
#> 1 A      (Intercept)    2.67 
#> 2 A      Q1             0.333
#> 3 A      Q10           NA    
#> 4 A      Q3            -0.333
#> 5 A      Q4            -1.   
#> 6 A      Q5             1.