R Сохранение коэффициентов регрессии в столбце данных по группам - PullRequest
Новая
       11

R Сохранение коэффициентов регрессии в столбце данных по группам

0 голосов
/ 10 мая 2019

У меня есть фрейм данных с результатами опроса.Результаты хранятся в вертикальном формате.Фрейм данных выглядит следующим образом - 

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 респондента.Каждое удостоверение личности соответствует одному респонденту.В этом примере данных у нас есть 10 респондентов.

CLIENT = Соответствует имени клиента, респонденты которого были опрошены.В этом образце данных у нас есть два клиента (A & B).

QST = Соответствует номеру вопроса в опросе.

VALUE = Соответствует варианту ответа на вопрос.На все вопросы есть 4 варианта ответа (от 1 до 4).

Цель

Для каждой комбинации клиента и вопроса я хотел бы создать отдельный столбец, в котором будут хранитьсякоэффициент регрессии для этого вопроса регрессировал до Q2 в столбце QST.

Таким образом, в регрессионной модели Q2 является зависимой переменной, а все остальные вопросы являются независимыми переменными.

Моя попытка

Моя попытка не дает желаемого результата. 

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

Я пытаюсь сгруппировать CLIENT& QST и затем найдите наклоны для каждого вопроса, регрессированного с помощью Q2.Я уверен, что есть лучший способ сделать это.

В настоящее время моя попытка выдает мне следующее сообщение об ошибке -

Ошибка в mutate_impl (.data, dots): Ошибка оценки: '.'dans la formule и pas d'argument 'data'

Желаемый вывод

Я хотел бы, чтобы окончательный кадр данных содержал три столбца: один для CLIENT, один для QST и третий для COEFFICIENT с коэффициентами для каждой комбинации CLIENT и QST, регрессированными с Q2 в качестве переменной отклика.

Любая помощь по этому вопросу будет принята с благодарностью.

Ответы [ 3 ]

1 голос
/ 10 мая 2019

Решение, которое следует логике в моем мозгу (нам нужно, чтобы 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)
)
1 голос
/ 11 мая 2019

Для подобных задач мне нравится подход "многих моделей" из R для Data Science .Он вписывается в стиль Tidyverse, используя вложенные фреймы данных и purrr::map для создания списка-столбца моделей.Затем broom::tidy предоставляет утилиты для извлечения необходимой информации о моделях.

Я удалил столбец идентификаторов, чтобы убрать его с дороги после распространения данных, сгруппировал и вложил по 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.
1 голос
/ 10 мая 2019

Я не уверен на 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

Обратите внимание, что все нули заполняются для вопросов, где ваши исходные данные не имели значений - если вопрос былне ответил.См. Ответ Бена Болкера по этому вопросу.

Если вы сейчас включите код для запуска 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
...