Создать новый фрейм данных, используя перехваты множественной линейной регрессии в R - PullRequest
Новая
       24

Создать новый фрейм данных, используя перехваты множественной линейной регрессии в R

0 голосов
/ 15 марта 2019

У меня есть фрейм данных с примерно 200 столбцами, и он выглядит так: 

d1 <- structure(list(Date=c(2012, 2012, 2013, 2013, 2014, 2014),
                x1=c(NA, NA, 17L, 29L, 27L, 10L), x2=c(30L, 19L, 22L, 20L, 11L,
                24L), x3=c(NA, 23L, 22L, 27L, 21L, 26L), x4=c(30L, 28L, 23L,
                24L, 10L, 17L), x5=c(12L, 18L, 17L, 16L, 30L, 26L)),
                 row.names=c(NA, 6L), class="data.frame")

Вывод: 

 Date x1 x2 x3 x4 x5
1 2012 NA 30 NA 30 12
2 2012 NA 19 23 28 18
3 2013 17 22 22 23 17
4 2013 29 20 27 24 16
5 2014 27 11 21 10 30
6 2014 10 24 26 17 26

Теперь я хочу запустить линейные регрессии для каждого года отдельно иa создать новый фрейм данных только с перехватами для каждой переменной от x1 до x4 для каждого года.Моя независимая переменная x5.

примерно так: 

 Time x1 x2 x3 x4 
1 2012 Interceptx1 Interceptx2  Interceptx3 Interceptx4 
2 2013 Interceptx1 Interceptx2  Interceptx3 Interceptx4 
3 2014 Interceptx1 Interceptx2  Interceptx3 Interceptx4

Я пробовал lms <- lapply(2:5, function(x) lm(d1[,x] ~ d1$x5)) и df <- data.frame(sapply(lms, coef)), но это приводит к регрессии в течение всего периода времени.Мой фрейм данных содержит 200 столбцов, и поэтому я ищу эффективный способ создания этого нового фрейма данных.

Большое спасибо!

1 Ответ

0 голосов
/ 18 марта 2019

Вот решение, основанное на какой-то другой работе, которую я сделал. Я уверен, что это можно превратить в чисто мурлыканье и буду рад любым предложениям в этом направлении.

Мне пришлось внести некоторые изменения в ваши данные, так как значения NA приводили к их поломке. 

library(purrr)
library(dplyr)
library(tidyr)
library(broom)

d1 <- structure(list(cyear=c(2012, 2012, 2013, 2013, 2014, 2014),
                     x1=c(5L, 5L, 17L, 29L, 27L, 10L), 
                     x2=c(30L, 19L, 22L, 20L, 11L,24L), 
                     x3=c(5L, 23L, 22L, 27L, 21L, 26L), 
                     x4=c(30L, 28L, 23L,24L, 10L, 17L), 
                     x5=c(12L, 18L, 17L, 16L, 30L, 26L)),
                row.names=c(NA, 6L), class="data.frame")

models <- nest(d1, -cyear)
str(models)

reg_vars <- c("x1", "x2", "x3", "x4")

# The following loops through each of the independent
for(i in 1:length(reg_vars)){
  var_mdl <- rlang::sym(paste0(reg_vars[i], "_mdl")) # create the name of a model
  var_res <- rlang::sym(paste0(reg_vars[i], "_res")) # create the name of the results
  formula = as.formula(paste0(reg_vars[i], " ~ x5")) # create the regression formula
  print(formula)

  models <- models %>%
    mutate(
# create the model as an element in the nested data
      !!var_mdl := map(data, ~ lm(formula, data = ., na.action = "na.omit")), 
# tidy the model results into an element
      !!var_res := map(!!var_mdl, tidy)
    )
}
models

reg_vars2 <- paste0(reg_vars, "_res")
reg_vars2

# clean up ####
# this will extract the regression results into a new data frame
for(i in 1:length(reg_vars2)){
  if(i == 1){
    results <- rlang::sym(reg_vars2[i])
    out_df <- models %>% 
      select(cyear, !!results) %>% 
      unnest(!!results)  
  }
  results <- rlang::sym(reg_vars2[i])
  temp_df <- models %>% 
    select(cyear, !!results) %>% 
    unnest(!!results)
  out_df <- bind_rows(out_df, temp_df)
}

head(out_df)
...