Multiple LM model returning the same coefficients - r

Hello Stack Community,
I am trying to model wage growth across US territories using linear models to forecast into the future. I want to try and create a model for each state/ territory (DC, VI, and PR), however, when I look at the coefficients for my models, they are the same for each state.
I have used a combination of plyr ,dplyr, and broom thus far to create and sort my data frame (named stuben_dat) for this project
#Wage Growth
state_data = stuben_dat %>% group_by(st) %>%
do (state_wg= lm(wage_growth ~ us_wage_growth + lag_wage_growth + dum1
+dum2 +dum3,
data= stuben_dat, subset=yr>= (current_year - 5)))
#The dummy variables adjust for seasonality (q1 vs q2 vs q3 vs q4)
#The current_year = whatever year I last updated the program
#The current_year-5 value lets me change the look back period
#This look back period can be used to exclude recessions or outliers
Here is just a snapshot of my output, and as you can see, the beta coefficients and regression statistics are exactly the same for each state (Just AK and AL) are shown here. However, I want to build a different model for each state.
# A tibble: 318 x 6
# Groups: st [53]
st term estimate std.error statistic p.value
<chr> <chr> <dbl> <dbl> <dbl> <dbl>
1 AK (Intercept) -1.75 0.294 -5.97 3.28e- 9
2 AK us_wage_growth 996. 23.6 42.2 1.82e-228
3 AK lag_wage_growth 0.191 0.0205 9.34 5.58e- 20
4 AK dum1 -0.245 0.304 -0.806 4.21e- 1
5 AK dum2 -0.321 0.304 -1.06 2.90e- 1
6 AK dum3 0.0947 0.303 0.312 7.55e- 1
7 AL (Intercept) -1.75 0.294 -5.97 3.28e- 9
8 AL us_wage_growth 996. 23.6 42.2 1.82e-228
9 AL lag_wage_growth 0.191 0.0205 9.34 5.58e- 20
10 AL dum1 -0.245 0.304 -0.806 4.21e- 1
# ... with 308 more rows

It is because you are using the same data in your do() call. Try out:
state_data = stuben_dat %>%
group_by(st) %>%
do(state_wg = lm(wage_growth ~ us_wage_growth + lag_wage_growth +
dum1 + dum2 + dum3,
data = ., subset = (yr >= (current_year - 5))))

Related

Mapping broom::tidy to nested list of {fixest} models and keep name of list element

I want to apply broom::tidy() to models nested in a fixest_multi object and extract the names of each list level as data frame columns. Here's an example of what I mean.
library(fixest)
library(tidyverse)
library(broom)
multiple_est <- feols(c(Ozone, Solar.R) ~ Wind + Temp, airquality, fsplit = ~Month)
This command estimates two models for each dep. var. (Ozone and Solar.R) for a subset of each Month plus the full sample. Here's how the resulting object looks like:
> names(multiple_est)
[1] "Full sample" "5" "6" "7" "8" "9"
> names(multiple_est$`Full sample`)
[1] "Ozone" "Solar.R"
I now want to tidy each model object, but keep the information of the Month / Dep.var. combination as columns in the tidied data frame. My desired output would look something like this:
I can run map_dfr from the tidyr package, giving me this result:
> map_dfr(multiple_est, tidy, .id ="Month") %>% head(9)
# A tibble: 9 x 6
Month term estimate std.error statistic p.value
<chr> <chr> <dbl> <dbl> <dbl> <dbl>
1 Full sample (Intercept) -71.0 23.6 -3.01 3.20e- 3
2 Full sample Wind -3.06 0.663 -4.61 1.08e- 5
3 Full sample Temp 1.84 0.250 7.36 3.15e-11
4 5 (Intercept) -76.4 82.0 -0.931 3.53e- 1
5 5 Wind 2.21 2.31 0.958 3.40e- 1
6 5 Temp 3.07 0.878 3.50 6.15e- 4
7 6 (Intercept) -70.6 46.8 -1.51 1.45e- 1
8 6 Wind -1.34 1.13 -1.18 2.50e- 1
9 6 Temp 1.64 0.609 2.70 1.29e- 2
But this tidies only the first model of each Month, the model with the Ozone outcome.
My desired output would look something like this:
Month outcome term estimate more columns from tidy
Full sample Ozone (Intercept) -71.0
Full sample Ozone Wind -3.06
Full sample Ozone Temp 1.84
Full sample Solar.R (Intercept) some value
Full sample Solar.R Wind some value
Full sample Solar.R Temp some value
... rows repeated for each month 5, 6, 7, 8, 9
How can I apply tidy to all models and add another column that indicates the outcome of the model (which is stored in the name of the model object)?
So, fixest_mult has a pretty strange setup as I delved deeper. As you noticed, mapping across it or using apply just accesses part of the data frames. In fact, it isn't just the data frames for "Ozone", but actually just the data frames for the first 6 data frames (those for c("Full sample", "5", "6").
If you convert to a list, it access the data attribute, which is a sequential list of all 12 data frames, but dropping the relevant names you're looking for. So, as a workaround, could use pmap() and the names (found in the attributes of the object) to tidy() and then use mutate() for your desired columns.
library(fixest)
library(tidyverse)
library(broom)
multiple_est <- feols(c(Ozone, Solar.R) ~ Wind + Temp, airquality, fsplit = ~Month)
nms <- attr(multiple_est, "meta")$all_names
pmap_dfr(
list(
data = as.list(multiple_est),
month = rep(nms$sample, each = length(nms$lhs)),
outcome = rep(nms$lhs, length(nms$sample))
),
~ tidy(..1) %>%
mutate(
Month = ..2,
outcome = ..3,
.before = 1
)
)
#> # A tibble: 36 × 7
#> Month outcome term estimate std.error statistic p.value
#> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 Full sample Ozone (Intercept) -71.0 23.6 -3.01 3.20e- 3
#> 2 Full sample Ozone Wind -3.06 0.663 -4.61 1.08e- 5
#> 3 Full sample Ozone Temp 1.84 0.250 7.36 3.15e-11
#> 4 Full sample Solar.R (Intercept) -76.4 82.0 -0.931 3.53e- 1
#> 5 Full sample Solar.R Wind 2.21 2.31 0.958 3.40e- 1
#> 6 Full sample Solar.R Temp 3.07 0.878 3.50 6.15e- 4
#> 7 5 Ozone (Intercept) -70.6 46.8 -1.51 1.45e- 1
#> 8 5 Ozone Wind -1.34 1.13 -1.18 2.50e- 1
#> 9 5 Ozone Temp 1.64 0.609 2.70 1.29e- 2
#> 10 5 Solar.R (Intercept) -284. 262. -1.08 2.89e- 1
#> # … with 26 more rows

Looping over grouped data using the nls function in R

I have a grouped dataset. I have my data grouped by GaugeID. I have an nls function that I want to loop over each group and provide an output value.
library(tidyverse)
library(stats)
# sample of data (yearly), first column is gauge (grouping variable), year, then two formula inputs PETvP and ETvP
# A tibble: 10 x 4
GaugeID WATERYR PETvP ETvP
<chr> <dbl> <dbl> <dbl>
1 06892000 1981 0.854 0.754
2 06892000 1982 0.798 0.708
3 06892000 1983 1.12 0.856
4 06892000 1984 0.905 0.720
5 06892000 1985 0.721 0.618
6 06892000 1986 0.717 0.625
7 06892000 1987 0.930 0.783
8 06892000 1988 1.57 0.945
9 06892000 1989 1.15 0.739
10 06892000 1990 0.933 0.805
11 08171300 1981 0.854 0.754
12 08171300 1982 0.798 0.708
13 08171300 1983 1.12 0.856
14 08171300 1984 0.905 0.720
15 08171300 1985 0.721 0.618
16 08171300 1986 0.717 0.625
17 08171300 1987 0.930 0.783
18 08171300 1988 1.57 0.945
19 08171300 1989 1.15 0.739
20 08171300 1990 0.933 0.805
# attempted for loop
for (i in unique(yearly$GaugeID)) {
myValue = nls(ETvP[i] ~ I(1 + PETvP[i] - (1 + PETvP[i]^(w))^(1/w)), data = yearly,
start = list(w = 2), trace = TRUE)
}
I get the following error
Error in model.frame.default(formula = ~ETvP + i + PETvP, data = yearly) :
variable lengths differ (found for 'i')
I haven't found much information regarding looping with the nls function. Essentially, I am producing curves and need the value of the curve (w) to output for each gauge.
It works if I assign the formula to just one gauge (if I subset the data, i.e for the first gauge), but not when I try to use it on the entire data frame with grouped data.
For example, this works
# gaugeA
# A tibble: 10 x 4
GaugeID WATERYR PETvP ETvP
<chr> <dbl> <dbl> <dbl>
1 06892000 1981 0.854 0.754
2 06892000 1982 0.798 0.708
3 06892000 1983 1.12 0.856
4 06892000 1984 0.905 0.720
5 06892000 1985 0.721 0.618
6 06892000 1986 0.717 0.625
7 06892000 1987 0.930 0.783
8 06892000 1988 1.57 0.945
9 06892000 1989 1.15 0.739
10 06892000 1990 0.933 0.805
test = nls(ETvP ~ I(1 + PETvP - (1 + PETvP^(w))^(1/w)), data = gaugeA,
start = list(w = 2), trace = TRUE)
1.574756 (4.26e+00): par = (2)
0.2649549 (1.46e+00): par = (2.875457)
0.09466832 (3.32e-01): par = (3.59986)
0.08543699 (2.53e-02): par = (3.881397)
0.08538308 (9.49e-05): par = (3.907099)
0.08538308 (1.13e-06): par = (3.907001)
> test
Nonlinear regression model
model: ETvP ~ I(1 + PETvP - (1 + PETvP^(w))^(1/w))
data: gaugeA
w
3.907
residual sum-of-squares: 0.08538
Number of iterations to convergence: 5
Achieved convergence tolerance: 1.128e-06
Any ideas on how I can get the subset results for my entire grouped dataframe? It has over 600 different gauges in it. Thank you in advance.
Any of the following will work:
Using summarise:
df %>%
group_by(GaugeID) %>%
summarise(result = list(nls(ETvP ~ I(1 + PETvP - (1 + PETvP^(w))^(1/w)),
data = cur_data(),
start = list(w = 2)))) %>%
pull(result)
[[1]]
Nonlinear regression model
model: ETvP ~ I(1 + PETvP - (1 + PETvP^(w))^(1/w))
data: cur_data()
w
3.607
residual sum-of-squares: 0.01694
Number of iterations to convergence: 5
Achieved convergence tolerance: 7.11e-08
[[2]]
Nonlinear regression model
model: ETvP ~ I(1 + PETvP - (1 + PETvP^(w))^(1/w))
data: cur_data()
w
1.086
residual sum-of-squares: 0.1532
Number of iterations to convergence: 5
Achieved convergence tolerance: 2.685e-07
Using map:
df %>%
group_split(GaugeID) %>%
map(~nls(ETvP ~ I(1 + PETvP - (1 + PETvP^(w))^(1/w)),
data = .x,
start = list(w = 2)))
I usally prefer purrr and dplyr for looping functions on grouped data.
I cant edit the data, but maybe this works:
library(dplyr)
library(purrr)
yearly %>% group_by(GaugeID) %>% summarise(test = nls(ETvP ~ I(1 + PETvP - (1 + PETvP^(w))^(1/w)), data = gaugeA, start = list(w = 2), trace = TRUE)
A single model can be formulated eliminating loops. Ensure that GaugeID is a factor, subscript w by GaugeID in the formula and provide a starting value list whose w component is a vector with a starting value for each level of GaugeID.
df$GaugeID <- factor(df$GaugeID)
fo <- ETvP ~ 1 + PETvP - (1 + PETvP^(w[GaugeID]))^(1/w[GaugeID])
st <- list(w = rep(2, nlevels(df$GaugeID)))
fm <- nls(fo, df, start = st)
fm
summary(fm)
data.frame(GaugeID = levels(df$GaugeID), coef(summary(fm)), check.names = FALSE)

R run linear model by group in dataset [duplicate]

This question already has answers here:
Linear Regression and group by in R
(10 answers)
Closed 2 years ago.
My dataset looks like this
df = data.frame(site=c(rep('A',95),rep('B',110),rep('C',250)),
nps_score=c(floor(runif(455, min=0, max=10))),
service_score=c(floor(runif(455, min=0, max=10))),
food_score=c(floor(runif(455, min=0, max=10))),
clean_score=c(floor(runif(455, min=0, max=10))))
I'd like to run a linear model on each group (i.e. for each site), and produce the coefficients for each group in a dataframe, along with the significance levels of each variable.
I am trying to group_by the site variable and then run the model for each site but it doesn't seem to be working. I've looked at some existing solutions on stack overflow but cannot seem to adapt the code to my solution.
#Trying to run this by group, and output the resulting coefficients per site in a separate df with their signficance levels.
library(MASS)
summary(ols <- rlm(nps_score ~ ., data = df))
Any help on this would be greatly appreciated
library(tidyverse)
library(broom)
library(MASS)
# We first create a formula object
my_formula <- as.formula(paste("nps_score ~ ", paste(df %>% select(-site, -nps_score) %>% names(), collapse= "+")))
# Now we can group by site and use the formula object within the pipe.
results <- df %>%
group_by(site) %>%
do(tidy(rlm(formula(my_formula), data = .)))
which gives:
# A tibble: 12 x 5
# Groups: site [3]
site term estimate std.error statistic
<chr> <chr> <dbl> <dbl> <dbl>
1 A (Intercept) 5.16 0.961 5.37
2 A service_score -0.0656 0.110 -0.596
3 A food_score -0.0213 0.102 -0.209
4 A clean_score -0.0588 0.110 -0.536
5 B (Intercept) 2.22 0.852 2.60
6 B service_score 0.221 0.103 2.14
7 B food_score 0.163 0.104 1.56
8 B clean_score -0.0383 0.0928 -0.413
9 C (Intercept) 5.47 0.609 8.97
10 C service_score -0.0367 0.0721 -0.509
11 C food_score -0.0585 0.0724 -0.808
12 C clean_score -0.0922 0.0691 -1.33
Note: i'm not familiar with the rlm function and if it provides p-values in the first place. But at least the tidy function doesn't offer p-values for rlm. If a simple linear regression would fit your suits, you could replace the rlm function by lm in which case a sixth column with p-values would be added.

Many regressions using tidyverse and broom: Same dependent variable, different independent variables

This link shows how to answer my question in the case where we have the same independent variables, but potentially many different dependent variables: Use broom and tidyverse to run regressions on different dependent variables.
But my question is, how can I apply the same approach (e.g., tidyverse and broom) to run many regressions where we have the reverse situation: same dependent variables but different independent variable. In line with the code in the previous link, something like:
mod = lm(health ~ cbind(sex,income,happiness) + faculty, ds) %>% tidy()
However, this code does not do exactly what I want, and instead, produces:
Call:
lm(formula = income ~ cbind(sex, health) + faculty, data = ds)
Coefficients:
(Intercept) cbind(sex, health)sex
945.049 -47.911
cbind(sex, health)health faculty
2.342 1.869
which is equivalent to:
lm(formula = income ~ sex + health + faculty, data = ds)
Basically you'll need some way to create all the different formulas you want. Here's one way
qq <- expression(sex,income,happiness)
formulae <- lapply(qq, function(v) bquote(health~.(v)+faculty))
# [[1]]
# health ~ sex + faculty
# [[2]]
# health ~ income + faculty
# [[3]]
# health ~ happiness + faculty
Once you have all your formula, you can map them to lm and then to tidy()
library(purrr)
library(broom)
formulae %>% map(~lm(.x, ds)) %>% map_dfr(tidy, .id="model")
# A tibble: 9 x 6
# model term estimate std.error statistic p.value
# <chr> <chr> <dbl> <dbl> <dbl> <dbl>
# 1 1 (Intercept) 19.5 0.504 38.6 1.13e-60
# 2 1 sex 0.755 0.651 1.16 2.49e- 1
# 3 1 faculty -0.00360 0.291 -0.0124 9.90e- 1
# 4 2 (Intercept) 19.8 1.70 11.7 3.18e-20
# 5 2 income -0.000244 0.00162 -0.150 8.81e- 1
# 6 2 faculty 0.143 0.264 0.542 5.89e- 1
# 7 3 (Intercept) 18.4 1.88 9.74 4.79e-16
# 8 3 happiness 0.205 0.299 0.684 4.96e- 1
# 9 3 faculty 0.141 0.262 0.539 5.91e- 1
Using sample data
set.seed(11)
ds <- data.frame(income = rnorm(100, mean=1000,sd=200),
happiness = rnorm(100, mean = 6, sd=1),
health = rnorm(100, mean=20, sd = 3),
sex = c(0,1),
faculty = c(0,1,2,3))
You could use the combn function to get all combinations of n independent variables and then iterate over them. Let's say n=3 here:
library(tidyverse)
ds <- data.frame(income = rnorm(100, mean=1000,sd=200),
happiness = rnorm(100, mean = 6, sd=1),
health = rnorm(100, mean=20, sd = 3),
sex = c(0,1),
faculty = c(0,1,2,3))
ivs = combn(names(ds)[names(ds)!="income"], 3, simplify=FALSE)
# Or, to get all models with 1 to 4 variables:
# ivs = map(1:4, ~combn(names(ds)[names(ds)!="income"], .x, simplify=FALSE)) %>%
# flatten()
names(ivs) = map(ivs, ~paste(.x, collapse="-"))
models = map(ivs,
~lm(as.formula(paste("income ~", paste(.x, collapse="+"))), data=ds))
map_df(models, broom::tidy, .id="model")
model term estimate std.error statistic p.value
* <chr> <chr> <dbl> <dbl> <dbl> <dbl>
1 happiness-health-sex (Intercept) 1086. 201. 5.39 5.00e- 7
2 happiness-health-sex happiness -25.4 21.4 -1.19 2.38e- 1
3 happiness-health-sex health 3.58 6.99 0.512 6.10e- 1
4 happiness-health-sex sex 11.5 41.5 0.277 7.82e- 1
5 happiness-health-faculty (Intercept) 1085. 197. 5.50 3.12e- 7
6 happiness-health-faculty happiness -25.8 20.9 -1.23 2.21e- 1
7 happiness-health-faculty health 3.45 6.98 0.494 6.23e- 1
8 happiness-health-faculty faculty 7.86 18.2 0.432 6.67e- 1
9 happiness-sex-faculty (Intercept) 1153. 141. 8.21 1.04e-12
10 happiness-sex-faculty happiness -25.9 21.4 -1.21 2.28e- 1
11 happiness-sex-faculty sex 3.44 46.2 0.0744 9.41e- 1
12 happiness-sex-faculty faculty 7.40 20.2 0.366 7.15e- 1
13 health-sex-faculty (Intercept) 911. 143. 6.35 7.06e- 9
14 health-sex-faculty health 3.90 7.03 0.554 5.81e- 1
15 health-sex-faculty sex 15.6 45.6 0.343 7.32e- 1
16 health-sex-faculty faculty 7.02 20.4 0.345 7.31e- 1

Loop through variables to make regressions

I am wondering if I can run multiple regressions over this data frame:
Country Years FDI_InFlow_MilUSD FDI_InFlow_percGDP FDI_InStock_MilUSD FDI_OutFlow_MilUSD FDI_OutFlow_percGDP
1 Netherlands 1990 11063.31 3.52 71827.79 14371.94 34.96
2 Romania 1990 0.01 0.00 0.01 18.00 0.16
3 Netherlands 1991 6074.61 1.88 75404.38 13484.54 37.09
4 Romania 1991 40.00 0.13 44.00 3.00 0.29
5 Netherlands 1992 6392.10 1.78 73918.54 13153.78 33.15
6 Romania 1992 77.00 0.37 122.00 4.00 0.38
I would like to run the regression over all variables of interest 3:7 in this case(my original data has 10 variables but I think that's enough to get the point of what I want). Also I would like to have the lm results stored in a data frame and also grouped by Country(if that's possible), rather than making 2 dfs for each Country and then looping through them..
Here's an example of a wanted df(this one isn't grouped):
# term estimate std.error statistic p.value
# 1 (Intercept) -3.2002150 0.256885790 -12.457735 8.141394e-25
# 2 Sepal.Length 0.7529176 0.043530170 17.296454 2.325498e-37
# 3 (Intercept) 3.1568723 0.413081984 7.642242 2.474053e-12
# 4 Sepal.Width -0.6402766 0.133768277 -4.786461 4.073229e-06
# 5 (Intercept) -0.3630755 0.039761990 -9.131221 4.699798e-16
# 6 Petal.Length 0.4157554 0.009582436 43.387237 4.675004e-86
Here's and example of desired result: in this case the calculations are for both countries and are just assigned twice for each Country
Country term estimate std.error statistic p.value
1 Netherlands (Intercept) -67825.16741 2.229068e+04 -3.042759 3.615586e-03
2 Netherlands GDP_pcap_USD 14.04734 7.908839e-01 17.761576 3.285528e-24
3 Romania (Intercept) -67825.16741 2.229068e+04 -3.042759 3.615586e-03
4 Romania GDP_pcap_USD 14.04734 7.908839e-01 17.761576 3.285528e-24
I used this line of code: FDI2 %>% group_by(Country) %>% do(tidy(lm(FDI_InStock_MilUSD ~ GDP_pcap_USD, data= FDI2)))
If I understand correctly, the following will do what you want. All that is needed is to note that lm can fit a multiple regression model and return an object of class "mlm".
models <- lm(as.matrix(df1[-(1:2)]) ~ Country + Years, df1)
class(models)
#[1] "mlm" "lm"
smry <- summary(models)
result <- lapply(smry, coef)
result <- do.call(rbind, result)
head(result)
Estimate Std. Error t value Pr(>|t|)
#(Intercept) 2.294616e+06 1.847179e+06 1.2422273 0.30241037
#CountryRomania -7.804337e+03 1.515033e+03 -5.1512655 0.01418200
#Years -1.148555e+03 9.277644e+02 -1.2379813 0.30377452
#(Intercept) 6.843108e+02 7.063395e+02 0.9688129 0.40410011
#CountryRomania -2.226667e+00 5.793307e-01 -3.8435157 0.03107572
#Years -3.425000e-01 3.547662e-01 -0.9654247 0.40554755

Resources