Exécution simultanée de nombreuses régressions multiples avec différentes formules à la fois en utilisant dplyr

Question

Je essaie de faire fonctionner plusieurs régressions multiples en même temps avec des formules légèrement différentes. J'ai trouvé un bon exemple ici : https://rpubs.com/Marcelobn/many_regressions

Cependant, je n'arrive pas tout à fait à faire fonctionner des formules différentes pour chaque régression... Je cherche de l'aide pour corriger mon code mis à jour ou fournir une méthode alternative. Merci d'avance !

J'utilise R Studio, et j'ai mis en évidence ce que j'ai déjà essayé ci-dessous (exemple2).

library(pwt)
library(dplyr)
library(tidyr)
library(purrr)
library(broom)
library(pander)

exemple <- pwt7.1

# Cela fonctionne très bien, et je veux toujours un résultat comme celui-ci :
croissance_multiple <- exemple %>% select(country, openc, cg, cgdp) %>% 
  na.omit() %>%
  nest(-country) %>%
  mutate(model = map(data, ~lm(cgdp ~ openc + cg, data = .)),
         tidied = map(model, tidy)) %>%
  unnest(tidied) 

# MAIS : cela suppose que chacun des modèles pour chaque pays est le même
# Je veux spécifier des formules différentes pour chacun
exemple2 <- exemple

# Je les ai assignées de manière aléatoire à des fins d'exemple
# En réalité, j'y arrive de manière plus méthodique !
formule1 <- paste("cgdp", "~", "openc", "+", "cg", sep = " ")
formule2 <- paste("cgdp", "~", "openc", "+", "cg", "+", "currency", "+", "ppp", sep = " ")
formule3 <- paste("cgdp", "~", "pg", "+", "kg", "+", "openc", sep = " ")

randvar = sample(c(formule1,formule2,formule3), size = nrow(exemple2), replace = TRUE)
exemple2$regress = randvar

# Exécuter à nouveau le modèle avec une légère modification de lm, et cela fonctionne un peu
croissance_multiple_2 <- exemple2 %>% select(country, openc, cg, cgdp, currency, ppp, pg, kg, regress) %>% 
  na.omit() %>%
  nest(-country, -regress) %>%
  mutate(model = map(data, ~lm(as.formula(regress), data = .)), # c'est là que j'ai essayé de le changer
         tidied = map(model, tidy)) %>%
  unnest(tidied) 

# Cela fonctionne un peu mais cela utilise la première formule pour TOUS les autres pays... Une idée pour corriger / une méthode alternative ?

Un résultat similaire est ce que je souhaiterais, mais avec les régressions utilisant la bonne formule pour chacune et pas seulement la première de la liste pour toutes...

Answer 1

Utilisez map2 pour itérer sur la formule et le dataframe :

multiple_growth_2 <- example2 %>%
    select(country, openc, cg, cgdp, currency, ppp, pg, kg, regress) %>% 
    na.omit() %>%
    nest(-country, -regress) %>% 
    mutate(model = map2(data, regress, ~ lm(as.formula(.y), data = .x)), 
           tidied = map(model, tidy)) %>%
    unnest(tidied)

Vous devriez également supprimer "currency" de formula2. Vous faites un regroupement par pays, donc la plupart (sinon la totalité) de vos dataframes ne contiendront qu'une seule devise, mais au moins deux niveaux (c'est-à-dire devises) de facteurs sont nécessaires pour les contrastes.

Answer 2

Étant donné que vous entraînez votre modèle sur l'ensemble des données, vous pouvez choisir vos formules (ou modèles) en tant qu'objet distinct et les ajouter ultérieurement avec tidyr::crossing :

library(pwt, quietly = TRUE, warn.conflicts = FALSE)
library(dplyr, quietly = TRUE, warn.conflicts = FALSE)
library(tidyr)
library(purrr)
library(broom)

exemple <- as_tibble(pwt7.1)

formules <- c(
        formule1 =  paste("cgdp", "~", "openc", "+", "cg", sep = " "),
        formule2 =  paste("cgdp", "~", "openc", "+", "cg", "+", "ppp", sep = " "),
        formule3 =  paste("cgdp", "~", "pg", "+", "kg", "+", "openc", sep = " ")
)

croissance_multiple_2 <- exemple %>%
        select(pays, openc, cg, cgdp, devise, ppp, pg, kg) %>% 
        na.omit() %>%
        nest(-pays) %>%
        tidyr::crossing(. , formules) %>% 
        mutate(model = pmap(list(x = data, y = formules), function(x, y) lm( as.formula(y), data = x))
        )

# --- Utiliser broom pour

# évaluer les modèles
croissance_multiple_2 %>% 
        mutate(model_glance = map(model, glance) ) %>% 
        unnest(model_glance) %>% 
        select(-data, -model)
#> # A tibble: 570 x 13
#>    pays formules  r.squared adj.r.squared sigma statistic  p.value    df
#>                                 
#>  1 Afghan~ cgdp ~ ~    0.550         0.527   179.     23.2  2.56e- 7     3
#>  2 Afghan~ cgdp ~ ~    0.551         0.514   181.     15.1  1.39e- 6     4
#>  3 Afghan~ cgdp ~ ~    0.599         0.567   171.     18.5  1.74e- 7     4
#>  4 Albanie cgdp ~ ~    0.519         0.494  1247.     20.5  9.17e- 7     3
#>  5 Albanie cgdp ~ ~    0.746         0.726   917.     36.3  4.09e-11     4
#>  6 Albanie cgdp ~ ~    0.626         0.596  1114.     20.7  4.93e- 8     4
#>  7 Algérie cgdp ~ ~    0.0754        0.0368 1916.      1.96 1.52e- 1     3
#>  8 Algérie cgdp ~ ~    0.824         0.813   844.     73.5  9.02e-18     4
#>  9 Algérie cgdp ~ ~    0.482         0.449  1449.     14.6  7.58e- 7     4
#> 10 Angola  cgdp ~ ~    0.581         0.559   971.     26.4  6.56e- 8     3
#> # ... avec 560 lignes supplémentaires, et 5 variables supplémentaires: logLik , AIC ,
#> #   BIC , deviance , df.residual 

# vérifier les coefficients
croissance_multiple_2 %>%
        mutate(model_tidy = map(model, tidy) ) %>% 
        unnest(model_tidy)
#> # A tibble: 2,089 x 7
#>    pays     formules        terme    estimate std.error statistic   p.value
#>                                        
#>  1 Afghanis~ cgdp ~ openc +~ (Inter~   255.       77.7      3.28    2.21e-3
#>  2 Afghanis~ cgdp ~ openc +~ openc      -5.03      1.09    -4.60    4.63e-5
#>  3 Afghanis~ cgdp ~ openc +~ cg         70.0      10.3      6.80    4.55e-8
#>  4 Afghanis~ cgdp ~ openc +~ (Inter~   230.      130.       1.78    8.38e-2
#>  5 Afghanis~ cgdp ~ openc +~ openc      -4.82      1.40    -3.45    1.41e-3
#>  6 Afghanis~ cgdp ~ openc +~ cg         72.7      15.3      4.76    2.92e-5
#>  7 Afghanis~ cgdp ~ openc +~ ppp        -1.88      7.79    -0.241   8.11e-1
#>  8 Afghanis~ cgdp ~ pg + kg~ (Inter~   452.      101.       4.46    7.38e-5
#>  9 Afghanis~ cgdp ~ pg + kg~ pg         -6.11      2.40    -2.54    1.53e-2
#> 10 Afghanis~ cgdp ~ pg + kg~ kg         64.2       9.67     6.63    8.76e-8
#> # ... avec 2,079 lignes supplémentaires

# vérifier la prédiction individuelle
croissance_multiple_2 %>%
        mutate(model_augment = map(model, augment) ) %>% 
        unnest(model_augment)
#> # A tibble: 26,820 x 15
#>    pays     formules  cgdp openc    cg .fitted .se.fit .resid   .hat .sigma
#>                          
#>  1 Afghanis~ cgdp ~ ~  247.  21.7  5.28    515.    42.5  -267. 0.0562   176.
#>  2 Afghanis~ cgdp ~ ~  241.  27.1  5.73    520.    39.3  -278. 0.0481   175.
#>  3 Afghanis~ cgdp ~ ~  240.  32.9  6.11    517.    36.7  -277. 0.0419   176.
#>  4 Afghanis~ cgdp ~ ~  273.  27.7  5.74    518.    39.1  -245. 0.0476   177.
#>  5 Afghanis~ cgdp ~ ~  324.  28.9  5.36    485.    40.7  -160. 0.0517   180.
#>  6 Afghanis~ cgdp ~ ~  363.  26.9  6.99    609.    36.2  -246. 0.0408   177.
#>  7 Afghanis~ cgdp ~ ~  410.  28.1  6.60    576.    36.3  -167. 0.0409   179.
#>  8 Afghanis~ cgdp ~ ~  441.  26.5  6.97    610.    36.4  -169. 0.0413   179.
#>  9 Afghanis~ cgdp ~ ~  487.  24.7  7.08    626.    37.3  -139. 0.0434   180.
#> 10 Afghanis~ cgdp ~ ~  505.  26.4  7.07    617.    36.4  -112. 0.0413   181.
#> # ... avec 26,810 lignes supplémentaires, et 5 variables supplémentaires: .cooksd ,
#> #   .std.resid , ppp , pg , kg 

Note : J'utilise purrr::pmap dans le but de fournir une réponse différente (purrr::map2 fonctionne également !).