R Захват наклонов регрессии по группам в кадре данных - PullRequest
0 голосов
/ 21 января 2019

Мой фрейм данных состоит из оценок по различным вопросам, заданным в опросе, за 3 финансовых года (2013 ФГ, 14 ФГ и 15 ФГ). Результаты представлены Region.

Вот как выглядит образец фактического фрейма данных, где у нас есть два вопроса на регион, задаваемых в разные годы.

testdf=data.frame(FY=c("FY13","FY14","FY15","FY14","FY15","FY13","FY14","FY15","FY13","FY15","FY13","FY14","FY15","FY13","FY14","FY15"),
              Region=c(rep("AFRICA",5),rep("ASIA",5),rep("AMERICA",6)),
              QST=c(rep("Q2",3),rep("Q5",2),rep("Q2",3),rep("Q5",2),rep("Q2",3),rep("Q5",3)),
              Very.Satisfied=runif(16,min = 0, max=1),
              Total.Very.Satisfied=floor(runif(16,min=10,max=120)))

Моя цель

Для каждого региона моя цель - определить, какой вопрос пережил наиболее значительную восходящую эволюцию за эти 3 года. Чтобы измерить значительные восходящие движения, я решил использовать наклон регрессии в качестве параметра.

Вопрос с самой значительной восходящей эволюцией в пределах региона за 3-х летний период будет с самым крутым положительным наклоном .

Используя эту логику, я решил сделать следующее -

1) Для каждой комбинации Region и QST я запускаю функцию lm.

2) Я извлекаю наклон для каждой комбинации и сохраняю его как отдельную переменную. Затем для каждого региона я отфильтрую вопрос с максимальным значением наклона.

Моя попытка

Вот моя попытка решить эту проблему.

test_final=testdf %>%   
group_by(Region,QST) %>% 
map(~lm(FY ~ Very.Satisfied, data = .)) %>%
map_df(tidy) %>%
filter(term == 'circumference') %>%
select(estimate) %>% 
summarise(Value = max(estimate))

Однако, когда я запускаю это, я получаю сообщение об ошибке, говорящее, что объект FY не был найден.

Дополнительное требование

Кроме того, я бы хотел, чтобы это работало только для вопросов, которые имеют по крайней мере 2 года подряд данных для сравнения. Но я не могу понять, как включить это условие в мой код.

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

Ответы [ 2 ]

0 голосов
/ 21 января 2019

Вот аналогичная версия с фильтрацией по размеру / смежности группы (она была написана к тому времени, когда вы разместили сообщение, что я с таким же успехом могу пойти дальше).

library(tidyverse)
set.seed(42)
testdf=data.frame(FY=c("FY13","FY14","FY15","FY14","FY15","FY13","FY14","FY15","FY13","FY15","FY13","FY14","FY15","FY13","FY14","FY15"),
                  Region=c(rep("AFRICA",5),rep("ASIA",5),rep("AMERICA",6)),
                  QST=c(rep("Q2",3),rep("Q5",2),rep("Q2",3),rep("Q5",2),rep("Q2",3),rep("Q5",3)),
                  Very.Satisfied=runif(16,min = 0, max=1),
                  Total.Very.Satisfied=floor(runif(16,min=10,max=120)))

test_final <- testdf %>%   
  group_by(Region,QST) %>% # group by region
  mutate(numdate = as.numeric(str_remove(FY, "FY"))) %>% 
  filter(n() >= 2 & max(diff(numdate)) < 2) %>% # filter out singleton groups
  mutate(slopes = coef(lm(Very.Satisfied~numdate))[2])
test_final %>% select(Region, QST, slopes)
#> # A tibble: 14 x 3
#> # Groups:   Region, QST [5]
#>    Region  QST   slopes
#>    <fct>   <fct>  <dbl>
#>  1 AFRICA  Q2    -0.314
#>  2 AFRICA  Q2    -0.314
#>  3 AFRICA  Q2    -0.314
#>  4 AFRICA  Q5    -0.189
#>  5 AFRICA  Q5    -0.189
#>  6 ASIA    Q2    -0.192
#>  7 ASIA    Q2    -0.192
#>  8 ASIA    Q2    -0.192
#>  9 AMERICA Q2     0.238
#> 10 AMERICA Q2     0.238
#> 11 AMERICA Q2     0.238
#> 12 AMERICA Q5     0.342
#> 13 AMERICA Q5     0.342
#> 14 AMERICA Q5     0.342

test_final %>% group_by(Region) %>% 
  summarise(Value = max(slopes),
            Top_Question = QST[which.max(slopes)])
#> # A tibble: 3 x 3
#>   Region   Value Top_Question
#>   <fct>    <dbl> <fct>       
#> 1 AFRICA  -0.189 Q5          
#> 2 AMERICA  0.342 Q5          
#> 3 ASIA    -0.192 Q2

Создано в 2019-01-21 с помощью пакета представ. (v0.2.1)

0 голосов
/ 21 января 2019

Это не относится к части «по крайней мере, два года подряд», но относится к части «получить вопрос с наибольшим уклоном»:

library(dplyr)
test_final = testdf %>%
  mutate(FY.num = as.numeric(gsub("FY", "", FY))) %>%
  group_by(Region, QST) %>%
  mutate(lm_slope = lm(Very.Satisfied ~ FY.num)$coefficients[["FY.num"]]) %>%
  ungroup() %>%
  group_by(Region) %>%
  filter(lm_slope == max(lm_slope))
...