I want to do a equation-by-equation instrumental variable (IV) regression with a control function in R (using tidyverse and broom). I want to implement this based on a grouped data frame with a dependent variable, y, an endogenous variable, x, an instrument for this endogenous variable, z1, and an exogeneous variable, z2. Following a Two Stage Least Squares (2SLS) approach, I would run: (1) Regress x on z1 and z2 and (2) Regress y on x, z2 and v(the residuals from (1)). For more details for this approach see: https://www.irp.wisc.edu/newsevents/workshops/appliedmicroeconometrics/participants/slides/Slides_14.pdf. Unfortunately, I am not able to run the second regression without an error (see below).
My data looks like this:
df <- data.frame(
id = sort(rep(seq(1, 20, 1), 5)),
group = rep(seq(1, 4, 1), 25),
y = runif(100),
x = runif(100),
z1 = runif(100),
z2 = runif(100)
)
where id is an identifier for the observations, group is an identifier for the groups and the rest is defined above.
library(tidyverse)
library(broom)
# Nest the data frame
df_nested <- df %>%
group_by(group) %>%
nest()
# Run first stage regression and retrieve residuals
df_fit <- df_nested %>%
mutate(
fit1 = map(data, ~ lm(x ~ z1 + z2, data = .x)),
resids = map(fit1, residuals)
)
Now, I want to run the second stage regression. I've tried two things.
First:
df_fit %>%
group_by(group) %>%
unnest(c(data, resids)) %>%
do(lm(y ~ x + z2, data = .x))
This produces Error in is.data.frame(data) : object '.x' not found.
Second:
df_fit %>%
mutate(
fit2 = map2(data, resids, ~ lm(y ~ x + z2, data = .x))
)
df_fit %>% unnest(fit2)
This produces: Error: Must subset columns with a valid subscript vector. x Subscript has the wrong type `grouped_df< . If you would work with a larger data set, the second approach would even run into storage problems.
How is this done correctly?
The broom package is loaded but there was no tidy applied to the lm output. In addition, the OP's code had some typos i.e. after mutateing to create the fit2, the object 'df_fit' was not updated (<-), thus df_fit %>% unnest(fit2) wouldn't work as the column is not found
library(dplyr)
library(purrr)
library(broom)
library(tidyr)
df_fit %>%
ungroup %>%
mutate(
fit2 = map2(data, resids, ~ tidy(lm(y ~ x + z2, data = .x))
)) %>%
unnest(fit2)
-output
# A tibble: 12 × 9
group data fit1 resids term estimate std.error statistic p.value
<dbl> <list> <list> <list> <chr> <dbl> <dbl> <dbl> <dbl>
1 1 <tibble [25 × 5]> <lm> <dbl [25]> (Intercept) 0.357 0.126 2.82 0.00987
2 1 <tibble [25 × 5]> <lm> <dbl [25]> x -0.0290 0.173 -0.168 0.868
3 1 <tibble [25 × 5]> <lm> <dbl [25]> z2 0.204 0.183 1.11 0.278
4 2 <tibble [25 × 5]> <lm> <dbl [25]> (Intercept) 0.470 0.139 3.38 0.00272
5 2 <tibble [25 × 5]> <lm> <dbl [25]> x 0.168 0.206 0.816 0.423
6 2 <tibble [25 × 5]> <lm> <dbl [25]> z2 0.00615 0.176 0.0350 0.972
7 3 <tibble [25 × 5]> <lm> <dbl [25]> (Intercept) 0.625 0.147 4.25 0.000325
8 3 <tibble [25 × 5]> <lm> <dbl [25]> x 0.209 0.255 0.818 0.422
9 3 <tibble [25 × 5]> <lm> <dbl [25]> z2 -0.398 0.183 -2.18 0.0406
10 4 <tibble [25 × 5]> <lm> <dbl [25]> (Intercept) 0.511 0.235 2.17 0.0407
11 4 <tibble [25 × 5]> <lm> <dbl [25]> x 0.0468 0.247 0.189 0.851
12 4 <tibble [25 × 5]> <lm> <dbl [25]> z2 -0.0246 0.271 -0.0908 0.929
Related
Edited for Clarity
I frequently do stratified analyses. However, to avoid spending Type I error on hypotheses tests
that aren't of interest, I would like to remove certain values before using p.adjust().
library(purrr)
library(dplyr, warn.conflicts = FALSE)
library(broom)
library(tidyr)
mtcars_fit <- mtcars %>%
group_by(cyl) %>% # you can use "cyl" too, very flexible
nest() %>%
mutate(
model = map(data, ~ lm(mpg ~ wt, data = .)),
coeff = map(model, tidy, conf.int = FALSE)
) %>%
unnest(coeff) %>%
select(-statistic)
mtcars_fit
#> # A tibble: 6 × 7
#> # Groups: cyl [3]
#> cyl data model term estimate std.error p.value
#> <dbl> <list> <list> <chr> <dbl> <dbl> <dbl>
#> 1 6 <tibble [7 × 10]> <lm> (Intercept) 28.4 4.18 0.00105
#> 2 6 <tibble [7 × 10]> <lm> wt -2.78 1.33 0.0918
#> 3 4 <tibble [11 × 10]> <lm> (Intercept) 39.6 4.35 0.00000777
#> 4 4 <tibble [11 × 10]> <lm> wt -5.65 1.85 0.0137
#> 5 8 <tibble [14 × 10]> <lm> (Intercept) 23.9 3.01 0.00000405
#> 6 8 <tibble [14 × 10]> <lm> wt -2.19 0.739 0.0118
#If I want to adjust the p-values for multiple comparisons for the weight only and
#save the Type I error as I don't want to test the intercept, I would do something like this
mtcars_adjusted <- mtcars_fit %>%
mutate(
p.value2 = if_else(term != "(Intercept)", p.value, NA_real_),
p.value_adj = if_else(term != "(Intercept)", p.adjust(p.value2, method = "fdr"), NA_real_),
.after = "p.value"
) %>%
select(-p.value2)
mtcars_adjusted
#> # A tibble: 6 × 8
#> # Groups: cyl [3]
#> cyl data model term estimate std.error p.value p.val…¹
#> <dbl> <list> <list> <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 6 <tibble [7 × 10]> <lm> (Intercept) 28.4 4.18 1.05e-3 NA
#> 2 6 <tibble [7 × 10]> <lm> wt -2.78 1.33 9.18e-2 0.0918
#> 3 4 <tibble [11 × 10]> <lm> (Intercept) 39.6 4.35 7.77e-6 NA
#> 4 4 <tibble [11 × 10]> <lm> wt -5.65 1.85 1.37e-2 0.0137
#> 5 8 <tibble [14 × 10]> <lm> (Intercept) 23.9 3.01 4.05e-6 NA
#> 6 8 <tibble [14 × 10]> <lm> wt -2.19 0.739 1.18e-2 0.0118
#> # … with abbreviated variable name ¹p.value_adj
As this discussion on StackOverflow indicates that dplyr and p.adjust() often don't work well together, I applied the function outside the pipe as suggested.
#To check I will filter the dataset and make sure p adjusted values are the same
p.adj <- mtcars_fit %>%
filter(term != "(Intercept)") %>%
mutate(p.value_adj = NA_real_)
p.adj$p.value_adj = p.adjust(p.adj$p.value, method = "fdr")
p.adj
#> # A tibble: 3 × 8
#> # Groups: cyl [3]
#> cyl data model term estimate std.error p.value p.value_adj
#> <dbl> <list> <list> <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 6 <tibble [7 × 10]> <lm> wt -2.78 1.33 0.0918 0.0918
#> 2 4 <tibble [11 × 10]> <lm> wt -5.65 1.85 0.0137 0.0206
#> 3 8 <tibble [14 × 10]> <lm> wt -2.19 0.739 0.0118 0.0206
Created on 2022-08-18 by the reprex package (v2.0.1)
The result is that the adjusted p-values are different, so I am unsure what is correct. The fact that I adjusted the P-values in two different ways -- with objects mtcars_adjusted and p.value_adj -- and got different adjusted P-values is concerning. The adjusted P-values for each object:
mtcars_adjusted: 0.0918, 0.0137, 0.0118
p.adj: 0.0918, 0.0206, 0.0206.
The resulting dataset is that I want to keep the intercept estimates without adjusting them in the p-value. The resulting dataset would look something like mtcars_adjusted, but I want to make sure the p-values are adjusted accurately. How would I go about doing this?
Implementing your adjustment within the pipe chain
You don't need to adjust your p-values outside of mutate() in your example. Below, I show the identical result can be produced within the piping chain.
# Adjust p-values for "wt" parameter estimates using your approach
p.adj <- mtcars_fit %>%
filter(term != "(Intercept)") %>%
mutate(p.value_adj = NA_real_)
p.adj$p.value_adj = p.adjust(p.adj$p.value, method = "fdr")
# Alternative approach
p.adj_alt <- mtcars_fit %>%
ungroup() %>%
filter(term != "(Intercept)") %>%
mutate(p.value_adj = p.adjust(p.adj$p.value, method = "fdr"))
# Show they are identical once ungrouped (which you should do once you are
# done with all by-group operations)
identical(ungroup(p.adj), p.adj_alt)
#> [1] TRUE
Whether you are accomplishing what you intended with your "outside of the pipe" approach is a different question than what you asked in your post, but I encourage you to make sure it is.
Adding the intercepts
Once you have your adjusted estimates, you can add in the intercept rows by filter()ing them from the original object and passing them with your adjusted data to bind_rows(). You can also combine the two p-values columns into a single column if you'd like using coalesce().
# Get intercepts, bind into a single data.frame, and create a coalesced
# column that combined the (un)adjusted p-values
mtcars_fit %>%
filter(term == "(Intercept)") %>%
bind_rows(p.adj) %>%
ungroup() %>%
mutate(p.value_combined = coalesce(p.value, p.value_adj))
#> # A tibble: 6 × 9
#> cyl data model term estim…¹ std.e…² p.value p.val…³ p.val…⁴
#> <dbl> <list> <list> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 6 <tibble [7 × 10]> <lm> (Inte… 28.4 4.18 1.05e-3 NA 1.05e-3
#> 2 4 <tibble [11 × 10]> <lm> (Inte… 39.6 4.35 7.77e-6 NA 7.77e-6
#> 3 8 <tibble [14 × 10]> <lm> (Inte… 23.9 3.01 4.05e-6 NA 4.05e-6
#> 4 6 <tibble [7 × 10]> <lm> wt -2.78 1.33 9.18e-2 0.0918 9.18e-2
#> 5 4 <tibble [11 × 10]> <lm> wt -5.65 1.85 1.37e-2 0.0206 1.37e-2
#> 6 8 <tibble [14 × 10]> <lm> wt -2.19 0.739 1.18e-2 0.0206 1.18e-2
#> # … with abbreviated variable names ¹estimate, ²std.error, ³p.value_adj,
#> # ⁴p.value_combined
I have a dataframe of 4 columns: Dataset, X, Y, Group.
The task is to fit a linear model to each of the five groups (The group column contains 5 groups: a, b, c, d, e) in the dataframe and then compare the slope with the dataframe test_2. For the test_2 I have already fitted a model, as there was no group separation like in the test_1. For the test_1 we have been suggested to use the function nest_by to compute a group-wise linear models
I have tried to fit a model with the function nest_by
Input:
model <- test_1 %>%
nest_by(Group) %>%
mutate(model = list(lm(y ~ x, data = test_1)))
model
Output:
A tibble: 5 x 3
# Rowwise: Group
Group data model
<fct> <list<tibble[,3]>> <list>
1 a [58 x 3] <lm>
2 b [35 x 3] <lm>
3 c [47 x 3] <lm>
4 d [44 x 3] <lm>
5 e [38 x 3] <lm>
I do not know now how to proceed. I thought that I could ungroup them and do a summary(), but would be similar to just fit a model separately with the function filter() and create 5 separated models.
Yes, you can proceed further using tidy from broom package which is better option than summary and then doing unnest.
For example, for mtcars, for each cyl group, we can do the following,
library(tidyr)
library(dplyr)
library(purrr)
library(broom)
mtcars_model <- mtcars %>%
nest(data = -cyl) %>%
mutate(
model = map(data, ~ lm(mpg ~ wt, data = .))
)
# now simply for each cyl, tidy the model output and unnest it
mtcars_model %>%
mutate(
tidy_summary = map(model, tidy)
) %>%
unnest(tidy_summary)
#> # A tibble: 6 × 8
#> cyl data model term estimate std.error statistic p.value
#> <dbl> <list> <list> <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 6 <tibble [7 × 10]> <lm> (Interce… 28.4 4.18 6.79 1.05e-3
#> 2 6 <tibble [7 × 10]> <lm> wt -2.78 1.33 -2.08 9.18e-2
#> 3 4 <tibble [11 × 10]> <lm> (Interce… 39.6 4.35 9.10 7.77e-6
#> 4 4 <tibble [11 × 10]> <lm> wt -5.65 1.85 -3.05 1.37e-2
#> 5 8 <tibble [14 × 10]> <lm> (Interce… 23.9 3.01 7.94 4.05e-6
#> 6 8 <tibble [14 × 10]> <lm> wt -2.19 0.739 -2.97 1.18e-2
Created on 2022-07-09 by the reprex package (v2.0.1)
For additional Information with examples, check here
I have used the solution presented by #StupidWold here to develop a glm and the results are stored in models. The outputs seem to be correct. However I am wondering how to present all of the outputs at once instead of calling each one separately. I tried using the stargazer package but the result is not as neat as I want it to be, mainly the orientation of the html is horizontal rather than vertical (have to scroll to the right).
Here is the code I used for stargazer asking for an html file output:
stargazer(models, type="html", out = "table1.html", flip = T)
Any suggestions? Thank you.
Maybe my steps will help clarify things, here is the structure of data
FIPSCode<- c(4030,3820,33654,65985,62587,62548)
PRC_W<- c(86.7,56.4,64,52,22,13.6)
MHHI <- c(32564,365265,100000,35467365,353212,3514635132)
abide <- c(0,1,1,0,0,0)
stuff<- c(0,0,0,1,1,0)
takers <- c(1,1,0,1,1,0)
passers <- c(0,1,1,1,0,1)
df <- as.data.frame(cbind(FIPScode, PRC_W, MHHI, abide, stuff, takers, passers))
I assume here that the structure of the data is correct, i.e. categorical data are read as factors and so on.
DV = colnames(df)[4:7]
IV = colnames(df)[2:3]
models = vector("list",length(DV))
names(models) = DV
for (y in DV){
form <- reformulate(response=y,IV)
models[[y]] <- glm(form, data = df, family="binomial")
}
the output of models is correct because I can call, for example, summary(abide) and it works perfectly fine.
So my question is how can I look at all the results at once. I have 9000+ DVs and 3 IVs.
I think you could make it work like this.
model_capture <- data.frame()
for (y in DV){
data = (data.frame(df[y], df[IV]))
form <- reformulate(response=y,IV)
dd <- data.frame(vars = y, data) %>%
group_by(vars) %>%
nest()
dm <- dd %>% mutate(model = map(data, function(df) glm(form, data = df, family="binomial")))
model_capture <- rbind(model_capture, dm)
}
model_results <- model_capture %>%
mutate(results = map(model, broom::tidy)) %>%
unnest(results, .drop = TRUE)
model_results
vars data model term estimate std.error statistic p.value
<chr> <list> <list> <chr> <dbl> <dbl> <dbl> <dbl>
1 abide <tibble [6 × 3]> <glm> (Intercept) -5.43e-1 2.73e+0 -0.199 0.843
2 abide <tibble [6 × 3]> <glm> PRC_W 1.01e-2 4.39e-2 0.230 0.818
3 abide <tibble [6 × 3]> <glm> MHHI -1.74e-7 6.30e-7 -0.276 0.782
4 stuff <tibble [6 × 3]> <glm> (Intercept) 6.12e+2 8.21e+5 0.000745 0.999
5 stuff <tibble [6 × 3]> <glm> PRC_W -1.12e+1 1.50e+4 -0.000749 0.999
6 stuff <tibble [6 × 3]> <glm> MHHI -1.38e-7 1.97e-4 -0.000701 0.999
7 takers <tibble [6 × 3]> <glm> (Intercept) 2.84e+0 3.86e+0 0.735 0.463
8 takers <tibble [6 × 3]> <glm> PRC_W -2.42e-2 5.93e-2 -0.409 0.683
9 takers <tibble [6 × 3]> <glm> MHHI -2.50e-9 6.66e-9 -0.376 0.707
10 passers <tibble [6 × 3]> <glm> (Intercept) -6.02e+0 7.73e+0 -0.779 0.436
11 passers <tibble [6 × 3]> <glm> PRC_W 6.64e-2 8.77e-2 0.757 0.449
12 passers <tibble [6 × 3]> <glm> MHHI 1.07e-5 1.45e-5 0.734 0.463
I try to transfer the problem from this post to a setting where you use different formulas in the lm()
function in R.
Here a basic setup to reproduce the problem:
library(dplyr)
library(broom)
library(purrr)
library(tidyr)
# Generate data
set.seed(324)
dt <- data.frame(
t = sort(rep(c(1,2), 50)),
w1 = rnorm(100),
w2 = rnorm(100),
x1 = rnorm(100),
x2 = rnorm(100)
)
# Generate formulas
fm <- map(1:2, ~as.formula(paste0("w", .x, "~ x", .x)))
Now I try to run different regressions for each group t with models specified in formulas object fm :
# Approach 1:
dt %>% group_by(t) %>%
do(fit = tidy(map(fm, ~lm(.x, data = .)))) %>%
unnest(fit)
# Approach 2
dt %>% nest(-t) %>%
mutate(
fit = map(fm, ~lm(.x, data = .)),
tfit = tidy(fit)
)
This produces an error indicating that the formula cannot be converted to a data.frame . What am I doing wrong?
This needs map2 instead of map as the data column from nest is also a list of data.frame, and thus we need to loop over the corresponding elements of 'fm' list and data (map2 does that)
library(tidyr)
library(purrr)
library(dplyr)
library(broom)
out <- dt %>%
nest(data = -t) %>%
mutate(
fit = map2(fm, data, ~lm(.x, data = .y)),
tfit = map(fit, tidy))
-output
> out
# A tibble: 2 × 4
t data fit tfit
<dbl> <list> <list> <list>
1 1 <tibble [50 × 4]> <lm> <tibble [2 × 5]>
2 2 <tibble [50 × 4]> <lm> <tibble [2 × 5]>
> bind_rows(out$tfit)
# A tibble: 4 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 0.0860 0.128 0.670 0.506
2 x1 0.262 0.119 2.19 0.0331
3 (Intercept) -0.00285 0.152 -0.0187 0.985
4 x2 -0.115 0.154 -0.746 0.459
Or may also use
> imap_dfr(fm, ~ lm(.x, data = dt %>%
filter(t == .y)) %>%
tidy)
# A tibble: 4 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 0.0860 0.128 0.670 0.506
2 x1 0.262 0.119 2.19 0.0331
3 (Intercept) -0.00285 0.152 -0.0187 0.985
4 x2 -0.115 0.154 -0.746 0.459
If we want to have all the combinations of 'fm' for each level of 't', then use crossing
dt %>%
nest(data = -t) %>%
crossing(fm) %>%
mutate(fit = map2(fm, data, ~ lm(.x, data = .y)),
tfit = map(fit, tidy))
-output
# A tibble: 4 × 5
t data fm fit tfit
<dbl> <list> <list> <list> <list>
1 1 <tibble [50 × 4]> <formula> <lm> <tibble [2 × 5]>
2 1 <tibble [50 × 4]> <formula> <lm> <tibble [2 × 5]>
3 2 <tibble [50 × 4]> <formula> <lm> <tibble [2 × 5]>
4 2 <tibble [50 × 4]> <formula> <lm> <tibble [2 × 5]>
I want to use summarise/across with lm to fit regressions using different columns in a tibble. Like this:
library(tidyverse)
library(broom)
fits <- tibble(mtcars) %>%
summarise(across(c(vs, am), ~list(tidy(lm(wt ~ .x + mpg)))))
But the columns that get passed into lm as '.x', end up labeled as .x in the regression output.
fits %>% unnest(vs)
# A tibble: 3 x 6
term estimate std.error statistic p.value am
<chr> <dbl> <dbl> <dbl> <dbl> <list>
1 (Intercept) 6.10 0.353 17.3 8.36e-17 <tibble [3 × 5]>
2 .x 0.0738 0.239 0.308 7.60e- 1 <tibble [3 × 5]>
3 mpg -0.145 0.0200 -7.24 5.63e- 8 <tibble [3 × 5]>
I can preserve the name if I build the lm formula on the fly, and use cur_column(), but this feels kludgy:
tibble(mtcars) %>%
summarise(across(c(vs, am),
~list(tidy(lm(formula(paste0("wt ~ ", cur_column(), " + mpg"))))))) %>%
unnest(vs)
# A tibble: 3 x 6
term estimate std.error statistic p.value am
<chr> <dbl> <dbl> <dbl> <dbl> <list>
1 (Intercept) 6.10 0.353 17.3 8.36e-17 <tibble [3 × 5]>
2 vs 0.0738 0.239 0.308 7.60e- 1 <tibble [3 × 5]>
3 mpg -0.145 0.0200 -7.24 5.63e- 8 <tibble [3 × 5]>
I want the output to correctly use the true column name of .x, without having to do this workaround, but still using the summarise/across motif, without incorporating map.
Seems like this should be possible. Any suggestions?
*copying my comment from #akrun's answer to clarify what i'm looking for:
What I really want to know is, is the column name preserved in the summarise/across operation in a way that I can reference it directly in lm. Something like {{.x}} or rlang::as_name(.x). I mean, I know those don't work, but it seems like name information should be preserved, aside from just the string version in cur_column.
Can make it shorter with reformulate
library(dplyr)
library(broom)
library(tidyr)
tibble(mtcars) %>%
summarise(across(c(vs, am), ~
list(tidy(lm(reformulate(c(cur_column(), "mpg"), "wt")))))) %>%
unnest(vs)
-output
# A tibble: 3 x 6
# term estimate std.error statistic p.value am
# <chr> <dbl> <dbl> <dbl> <dbl> <list>
#1 (Intercept) 6.10 0.353 17.3 8.36e-17 <tibble [3 × 5]>
#2 vs 0.0738 0.239 0.308 7.60e- 1 <tibble [3 × 5]>
#3 mpg -0.145 0.0200 -7.24 5.63e- 8 <tibble [3 × 5]>