In the STAR experiment, children were randomly assigned within schools into three types of classes: small classes with 13–17 students, regular-sized classes with 22–25 students, and regular-sized classes with a full-time teacher aide to assist the teacher. Student scores on achievement tests were recorded, as was some information about the students, teachers, and schools. Data for the kindergarten classes are contained in the data file star.dat.
Let’s load and view the data’s first few lines as well as summary statistics about it
# load the data
load("./data/star.rda")
kable(head(star))
| id | schid | tchid | tchexper | absent | readscore | mathscore | totalscore | boy | white_asian | black | tchwhite | tchmasters | freelunch | schurban | schrural | small | regular | aide |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 10133 | 169280 | 16928003 | 7 | 5 | 427 | 478 | 905 | 1 | 0 | 1 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 1 |
| 10246 | 218562 | 21856202 | 8 | 28 | 450 | 494 | 944 | 0 | 1 | 0 | 1 | 1 | 0 | 1 | 0 | 0 | 0 | 1 |
| 10263 | 205492 | 20549204 | 3 | 2 | 483 | 513 | 996 | 0 | 0 | 1 | 1 | 0 | 1 | 0 | 0 | 1 | 0 | 0 |
| 10266 | 257899 | 25789904 | 12 | 10 | 456 | 513 | 969 | 1 | 1 | 0 | 1 | 1 | 0 | 0 | 1 | 0 | 1 | 0 |
| 10275 | 161176 | 16117602 | 2 | 3 | 411 | 468 | 879 | 1 | 1 | 0 | 1 | 0 | 0 | 0 | 1 | 0 | 0 | 1 |
| 10281 | 189382 | 18938204 | 7 | 2 | 443 | 473 | 916 | 1 | 1 | 0 | 1 | 1 | 0 | 0 | 0 | 1 | 0 | 0 |
kable(tidy(star))
## Warning: 'tidy.data.frame' is deprecated.
## See help("Deprecated")
| column | n | mean | sd | median | trimmed | mad | min | max | range | skew | kurtosis | se |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| id | 5786 | 1.559306e+04 | 2.694317e+03 | 15380.5 | 1.543933e+04 | 1862 | 10133 | 21580 | 11447 | 0.4033242 | 2.498993 | 3.542089e+01 |
| schid | 5786 | 2.110018e+05 | 3.838193e+04 | 215533.0 | 2.138217e+05 | 29243 | 112038 | 264945 | 152907 | -0.5868482 | 2.365732 | 5.045887e+02 |
| tchid | 5786 | 2.110019e+07 | 3.838193e+06 | 21553306.0 | 2.138217e+07 | 2924296 | 11203801 | 26494505 | 15290704 | -0.5868482 | 2.365732 | 5.045887e+04 |
| tchexper | 5766 | 9.306452e+00 | 5.767684e+00 | 9.0 | 9.003034e+00 | 4 | 0 | 27 | 27 | NA | NA | 7.595640e-02 |
| absent | 5765 | 1.027511e+01 | 9.270640e+00 | 8.0 | 8.893778e+00 | 5 | 0 | 79 | 79 | NA | NA | 1.220984e-01 |
| readscore | 5786 | 4.367297e+02 | 3.171347e+01 | 433.0 | 4.338069e+02 | 19 | 315 | 627 | 312 | 1.3400597 | 6.844684 | 4.169217e-01 |
| mathscore | 5786 | 4.855990e+02 | 4.769394e+01 | 484.0 | 4.831495e+02 | 30 | 320 | 626 | 306 | 0.4760213 | 3.294667 | 6.270092e-01 |
| totalscore | 5786 | 9.223287e+02 | 7.374660e+01 | 915.0 | 9.179244e+02 | 46 | 635 | 1253 | 618 | 0.6301511 | 3.745125 | 9.695111e-01 |
| boy | 5786 | 5.134808e-01 | 4.998614e-01 | 1.0 | 5.168467e-01 | 0 | 0 | 1 | 1 | -0.0539429 | 1.002910 | 6.571400e-03 |
| white_asian | 5786 | 6.766333e-01 | 4.678018e-01 | 1.0 | 7.207343e-01 | 0 | 0 | 1 | 1 | -0.7552281 | 1.570369 | 6.150000e-03 |
| black | 5786 | 3.209471e-01 | 4.668809e-01 | 0.0 | 2.762419e-01 | 0 | 0 | 1 | 1 | 0.7670838 | 1.588418 | 6.137900e-03 |
| tchwhite | 5786 | 8.354649e-01 | 3.707925e-01 | 1.0 | 9.192225e-01 | 0 | 0 | 1 | 1 | -1.8096048 | 4.274669 | 4.874600e-03 |
| tchmasters | 5786 | 3.517110e-01 | 4.775456e-01 | 0.0 | 3.146868e-01 | 0 | 0 | 1 | 1 | 0.6211000 | 1.385765 | 6.278100e-03 |
| freelunch | 5786 | 4.816799e-01 | 4.997074e-01 | 0.0 | 4.771058e-01 | 0 | 0 | 1 | 1 | 0.0733296 | 1.005377 | 6.569400e-03 |
| schurban | 5786 | 3.128241e-01 | 4.636834e-01 | 0.0 | 2.660907e-01 | 0 | 0 | 1 | 1 | 0.8074134 | 1.651917 | 6.095800e-03 |
| schrural | 5786 | 4.709644e-01 | 4.991994e-01 | 0.0 | 4.637149e-01 | 0 | 0 | 1 | 1 | 0.1163387 | 1.013535 | 6.562700e-03 |
| small | 5786 | 3.003802e-01 | 4.584629e-01 | 0.0 | 2.505400e-01 | 0 | 0 | 1 | 1 | 0.8708971 | 1.758462 | 6.027200e-03 |
| regular | 5786 | 3.465261e-01 | 4.759043e-01 | 0.0 | 3.082073e-01 | 0 | 0 | 1 | 1 | 0.6450337 | 1.416068 | 6.256500e-03 |
| aide | 5786 | 3.530937e-01 | 4.779728e-01 | 0.0 | 3.164147e-01 | 0 | 0 | 1 | 1 | 0.6147589 | 1.377928 | 6.283700e-03 |
# added school fixed effects by "factor(school_id)"
math.fixed <- lm(mathscore ~ small + aide + tchexper +
boy + white_asian + factor(schid)-1,
data = star)
School Fixed effects Model: Classroom Features effects on Math Scores
| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| small | 9.3495834 | 1.3970221 | 6.692509 | 0.0000000 |
| aide | 0.5268855 | 1.3491170 | 0.390541 | 0.6961512 |
| tchexper | 0.4201512 | 0.1083858 | 3.876441 | 0.0001072 |
| boy | -6.6312110 | 1.1133604 | -5.956033 | 0.0000000 |
| white_asian | 23.6509406 | 2.3108789 | 10.234608 | 0.0000000 |
| factor(schid)112038 | 433.4416543 | 6.1915004 | 70.005915 | 0.0000000 |
| factor(schid)123056 | 448.2977456 | 6.4407403 | 69.603450 | 0.0000000 |
| factor(schid)128068 | 443.4064908 | 6.2685431 | 70.735175 | 0.0000000 |
| factor(schid)128076 | 443.4736630 | 6.0680868 | 73.082947 | 0.0000000 |
| factor(schid)128079 | 434.9700466 | 6.0159497 | 72.302807 | 0.0000000 |
| factor(schid)130085 | 455.0002352 | 5.7344680 | 79.344803 | 0.0000000 |
| factor(schid)159171 | 485.2103480 | 4.8297836 | 100.462131 | 0.0000000 |
| factor(schid)161176 | 450.5546086 | 5.4446595 | 82.751659 | 0.0000000 |
| factor(schid)161183 | 476.6336042 | 4.8551802 | 98.170116 | 0.0000000 |
| factor(schid)162184 | 460.0258998 | 5.9868061 | 76.839952 | 0.0000000 |
| factor(schid)164198 | 464.5300240 | 6.2850936 | 73.909802 | 0.0000000 |
| factor(schid)165199 | 490.5138727 | 6.4041624 | 76.592978 | 0.0000000 |
| factor(schid)166203 | 446.1648065 | 5.6974915 | 78.308991 | 0.0000000 |
| factor(schid)168211 | 459.1896239 | 5.2751913 | 87.047008 | 0.0000000 |
| factor(schid)168214 | 485.3243089 | 6.2627177 | 77.494202 | 0.0000000 |
| factor(schid)169219 | 484.7343721 | 6.7015248 | 72.331953 | 0.0000000 |
| factor(schid)169229 | 473.5326526 | 4.4214784 | 107.098263 | 0.0000000 |
| factor(schid)169231 | 438.6436570 | 6.0257813 | 72.794487 | 0.0000000 |
| factor(schid)169280 | 462.4427156 | 6.2918758 | 73.498386 | 0.0000000 |
| factor(schid)170295 | 461.7120027 | 5.9148825 | 78.059371 | 0.0000000 |
| factor(schid)173312 | 491.5293455 | 6.1513337 | 79.906143 | 0.0000000 |
| factor(schid)176329 | 479.6244542 | 5.8925086 | 81.395631 | 0.0000000 |
| factor(schid)180344 | 465.2790091 | 4.8702851 | 95.534246 | 0.0000000 |
| factor(schid)189378 | 439.0862883 | 5.7169389 | 76.804440 | 0.0000000 |
| factor(schid)189382 | 450.0979675 | 6.0424637 | 74.489147 | 0.0000000 |
| factor(schid)189396 | 444.6735027 | 5.9280641 | 75.011588 | 0.0000000 |
| factor(schid)191411 | 453.1603965 | 6.8780427 | 65.885081 | 0.0000000 |
| factor(schid)193422 | 473.8613131 | 6.0915237 | 77.790277 | 0.0000000 |
| factor(schid)193423 | 474.4369684 | 5.6083034 | 84.595454 | 0.0000000 |
| factor(schid)201449 | 480.0881863 | 4.6273530 | 103.750067 | 0.0000000 |
| factor(schid)203452 | 446.9405868 | 5.2891302 | 84.501718 | 0.0000000 |
| factor(schid)203457 | 469.3473431 | 7.0753889 | 66.335201 | 0.0000000 |
| factor(schid)205488 | 456.0238430 | 6.2316347 | 73.178848 | 0.0000000 |
| factor(schid)205489 | 462.0905394 | 6.3582369 | 72.675893 | 0.0000000 |
| factor(schid)205490 | 425.2598669 | 5.6116565 | 75.781521 | 0.0000000 |
| factor(schid)205491 | 460.2467039 | 5.7835045 | 79.579207 | 0.0000000 |
| factor(schid)205492 | 494.3397358 | 5.0780955 | 97.347467 | 0.0000000 |
| factor(schid)208501 | 462.6245100 | 6.0193562 | 76.856144 | 0.0000000 |
| factor(schid)208503 | 443.5864645 | 6.0212478 | 73.670189 | 0.0000000 |
| factor(schid)209510 | 441.2641751 | 5.1770397 | 85.234844 | 0.0000000 |
| factor(schid)212522 | 470.0526927 | 5.9385167 | 79.153216 | 0.0000000 |
| factor(schid)215533 | 489.4558886 | 4.5342554 | 107.946255 | 0.0000000 |
| factor(schid)216536 | 462.9346546 | 4.9934517 | 92.708347 | 0.0000000 |
| factor(schid)218562 | 475.0435181 | 6.1369286 | 77.407372 | 0.0000000 |
| factor(schid)221571 | 417.6265317 | 4.7687794 | 87.575141 | 0.0000000 |
| factor(schid)221574 | 446.7331245 | 5.8582226 | 76.257452 | 0.0000000 |
| factor(schid)225585 | 450.9408926 | 5.5539973 | 81.192134 | 0.0000000 |
| factor(schid)228606 | 479.7092685 | 5.4446322 | 88.106827 | 0.0000000 |
| factor(schid)230612 | 496.0533470 | 6.0411844 | 82.111936 | 0.0000000 |
| factor(schid)231616 | 476.0860030 | 6.3219494 | 75.306836 | 0.0000000 |
| factor(schid)234628 | 464.1989788 | 5.0906699 | 91.186226 | 0.0000000 |
| factor(schid)244697 | 441.0988498 | 4.5819219 | 96.269395 | 0.0000000 |
| factor(schid)244708 | 443.2820927 | 4.1997491 | 105.549661 | 0.0000000 |
| factor(schid)244723 | 444.5766881 | 4.3098299 | 103.154114 | 0.0000000 |
| factor(schid)244727 | 474.5772920 | 4.9480977 | 95.911058 | 0.0000000 |
| factor(schid)244728 | 446.4440489 | 6.1128748 | 73.033403 | 0.0000000 |
| factor(schid)244736 | 501.1558006 | 6.0305482 | 83.102860 | 0.0000000 |
| factor(schid)244745 | 492.9133982 | 5.2290374 | 94.264654 | 0.0000000 |
| factor(schid)244746 | 478.4434703 | 5.9198110 | 80.820734 | 0.0000000 |
| factor(schid)244755 | 484.7687833 | 3.9533237 | 122.623095 | 0.0000000 |
| factor(schid)244764 | 471.0968437 | 7.3331620 | 64.241979 | 0.0000000 |
| factor(schid)244774 | 474.2716313 | 4.3675713 | 108.589327 | 0.0000000 |
| factor(schid)244776 | 461.6985601 | 3.8661461 | 119.420876 | 0.0000000 |
| factor(schid)244780 | 545.4808369 | 5.7576685 | 94.739882 | 0.0000000 |
| factor(schid)244796 | 458.3082722 | 5.8530133 | 78.302961 | 0.0000000 |
| factor(schid)244799 | 468.4503308 | 5.4401940 | 86.109123 | 0.0000000 |
| factor(schid)244801 | 473.5923761 | 5.3249229 | 88.938822 | 0.0000000 |
| factor(schid)244806 | 500.9792528 | 3.8218885 | 131.081597 | 0.0000000 |
| factor(schid)244818 | 455.1998711 | 4.9339839 | 92.258079 | 0.0000000 |
| factor(schid)244831 | 462.0976048 | 5.9883646 | 77.165910 | 0.0000000 |
| factor(schid)244839 | 519.3557376 | 5.1045488 | 101.743711 | 0.0000000 |
| factor(schid)252885 | 469.8948803 | 5.6770513 | 82.770941 | 0.0000000 |
| factor(schid)253888 | 466.4495285 | 7.2087178 | 64.706310 | 0.0000000 |
| factor(schid)257899 | 447.7188038 | 5.0124125 | 89.322019 | 0.0000000 |
| factor(schid)257905 | 458.8989956 | 4.6675227 | 98.317464 | 0.0000000 |
| factor(schid)259915 | 461.0594547 | 6.1924181 | 74.455478 | 0.0000000 |
| factor(schid)261927 | 477.8229310 | 5.3460476 | 89.378727 | 0.0000000 |
| factor(schid)262937 | 496.4755341 | 5.9311651 | 83.706241 | 0.0000000 |
| factor(schid)264945 | 481.7808675 | 5.0198832 | 95.974517 | 0.0000000 |
Technical comments: The function factor() generates dummy variables for all categories of the variable, taking the first category as the reference. To include the reference in the output, one needs to exclude the constant from the regression model by including the term −1 in the regression formula. When the constant is not excluded, the coefficients of the dummy variables represent, as usual, the difference between the respective category and the benchmark one.
However in R we can use the “plm” (panel) models to build a model object inherent to that idea:
# fixed effects using plm "within" method
math.fixed.within <- plm(mathscore ~ small + aide +
tchexper + boy + white_asian,
data = star,
model="within",
index=c("schid"))
kable(tidy(math.fixed.within))
| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| small | 9.3495834 | 1.3970221 | 6.692509 | 0.0000000 |
| aide | 0.5268855 | 1.3491170 | 0.390541 | 0.6961512 |
| tchexper | 0.4201512 | 0.1083858 | 3.876441 | 0.0001072 |
| boy | -6.6312110 | 1.1133604 | -5.956033 | 0.0000000 |
| white_asian | 23.6509406 | 2.3108789 | 10.234608 | 0.0000000 |
This model showed still no significance of AIDE, but the school fixed effects were very (the most possible) significant.
Including the fixed effects (accounting for individual heterogeneity) significantly lowers the marginal effects of the variables. That is to be expected, since the previously the variables needed to explain all (or as much as possible) of the variance between individuals; but now belonging to each particular school can explain much of that variance.
I will test it with the F test for fixed effects:
# Fixed effects test: Ho='No fixed effects'
kable(tidy(pFtest(math.fixed.within, math.pooled)), caption="Fixed effects test: Ho='No fixed effects'")
| df1 | df2 | statistic | p.value | method | alternative |
|---|---|---|---|---|---|
| 78 | 5682 | 18.06606 | 0 | F test for individual effects | significant effects |
The fixed effects are all significant. By using the F Test for Individual Effects, with the Null Hypothesis that the fixed effects are zero, the F test shows that the p-value is 0 and the null hypothesis can be rejected, meaning that the fixed effects are indeed significant.
As further verification, we could already detecte that the regression output results for the fixed effects regression model showed that they all have the lowest possible p-value (under 2e-16), which is lower than the other variables in the models.
This means that studying in each particular school accounts for more variance than each of the other variables does, and can better explain the variation in Math outcomes. This stems from the fact that each school is different on many other attributes, including hidden variables that we don’t have data on (such as potentially the demographic composition of the school, area in town, income level distribution of the parents, or even number of hours taught math).
We would expect fixed effects to have little influence on the coefficient estimates of the remaining variables in cases where they don’t help to explain the variance better than the other variables included (although we shouldn’t include other variables which are constant per entity when including fixed effects).
t statistic 15.37
Where the parameter of interest is \(b_k\); denote the fixed effects estimate is\(b_{FE,k}\) and the random effects estimate as \(b_{RE,k}\).
# set the results as data tables for easy indexing
library(data.table)
cfs <- merge(setDT(tidy(math.fixed.within)), setDT(tidy(math.random)), all.y = T, by="term")
kable(cfs)
| term | estimate.x | std.error.x | statistic.x | p.value.x | estimate.y | std.error.y | statistic.y | p.value.y |
|---|---|---|---|---|---|---|---|---|
| (Intercept) | NA | NA | NA | NA | 466.5626599 | 3.0802179 | 151.4706687 | 0.0000000 |
| aide | 0.5268855 | 1.3491170 | 0.390541 | 0.6961512 | 0.4852552 | 1.3483438 | 0.3598898 | 0.7189295 |
| boy | -6.6312110 | 1.1133604 | -5.956033 | 0.0000000 | -6.7140946 | 1.1134201 | -6.0301540 | 0.0000000 |
| small | 9.3495834 | 1.3970221 | 6.692509 | 0.0000000 | 9.3011197 | 1.3964264 | 6.6606588 | 0.0000000 |
| tchexper | 0.4201512 | 0.1083858 | 3.876441 | 0.0001072 | 0.4373365 | 0.1076016 | 4.0644060 | 0.0000482 |
| white_asian | 23.6509406 | 2.3108789 | 10.234608 | 0.0000000 | 22.4403265 | 2.1529340 | 10.4231372 | 0.0000000 |
# columns with X are for Fixed Effects, and Y is for Random Effects results.
# use 15.37 to calculate the F statistic per term:
t_stats = (data.frame((cfs$estimate.x - cfs$estimate.y) / (((cfs$std.error.x)^2 - (cfs$std.error.y)^2)^(1/2))))
t_stats = cbind(cfs$term, t_stats)
names(t_stats) = c("term", "t_statistic")
t_stats['t>1.96?'] <- t_stats$t_statistic > 1.96
kable(t_stats)
| term | t_statistic | t>1.96? |
|---|---|---|
| (Intercept) | NA | NA |
| aide | 0.911566 | FALSE |
| boy | NaN | NA |
| small | 1.188071 | FALSE |
| tchexper | -1.320459 | FALSE |
| white_asian | 1.441783 | FALSE |
This shows the t statistics obtained from the calculation given in 15.37. Using the standard 5% large sample critical value of 1.96, we cannot reject the hypothesis that any of the estimators yield identical results.
Our conclusion is that the random effects estimator is inconsistent, and that we should use the fixed effects estimator, or should attempt to improve the model specification. The null hypothesis will be rejected for any reason that makes the two sets of estimates differ, including a misspecified model. There may be nonlinearities in the relationship we have not captured with our model, and other explanatory variables may be relevant.
In fact, more commonly, we would use the Hausman test to test this hypothesis, and I will do this below. The Hausman test tests for the null hypothesis that the individual random effects are exogenous.
Random effects estimator are reliable under the assumption that individual characteristics (heterogeneity) are exogenous, that is, they are independent with respect to the regressors in the random effects equation. The We can therefore use the Hausman test for endogeneity, with the null hypothesis that individual random effects are exogenous. The test function phtest() compares the fixed effects and the random effects models; the next code chunk performs the Hausman endogeneity test.
kable(tidy(phtest(math.fixed.within, math.random)), caption =
"Hausman endogeneity test for the random effects Math Scores model")
| statistic | p.value | parameter | method | alternative |
|---|---|---|---|---|
| 25.3505 | 0.0001192 | 5 | Hausman Test | one model is inconsistent |
The Hausman Test shows a very low (highly significant) p-value of the test, which indicates that the null hypothesis saying that the individual random effects are exogenous is rejected, which makes the random effects equation inconsistent. In this case the fixed effects model is the correct solution.
A consulting firm run by Mr. John Chardonnay is investigating the relative efficiency of wine production at 75 California wineries. John sets up the production function:
\(Q=β_1+β_2MGT+β_3CAP+β_4LAB+e\)
where Q is an index of wine output for a winery, taking into account both quantity and quality, MGT is a variable that reflects the efficiency of management, CAP is an index of capital input, and LAB is an index of labor input. Because he cannot get data on management efficiency, John collects observations on the number of years of experience (XPER) of each winery manager and uses that variable in place of MGT. The 75 observations are stored in chard.dat.
First let’s look at the data
load("./data/chard.rda")
kable(summary(chard))
| q | xper | cap | lab | age | |
|---|---|---|---|---|---|
| Min. : 0.0788 | Min. : 3.00 | Min. :-0.8358 | Min. : 0.0068 | Min. :25.00 | |
| 1st Qu.: 6.5458 | 1st Qu.:11.00 | 1st Qu.: 5.4192 | 1st Qu.: 6.7858 | 1st Qu.:34.00 | |
| Median : 9.8072 | Median :14.00 | Median : 7.5045 | Median : 9.1171 | Median :43.00 | |
| Mean : 9.6344 | Mean :13.88 | Mean : 7.8347 | Mean :10.0467 | Mean :42.95 | |
| 3rd Qu.:12.3151 | 3rd Qu.:17.00 | 3rd Qu.:10.3621 | 3rd Qu.:13.3645 | 3rd Qu.:52.00 | |
| Max. :19.1759 | Max. :27.00 | Max. :18.7152 | Max. :23.8201 | Max. :63.00 |
lm1 <- lm(q ~ xper + cap + lab, data=chard)
summary(lm1)
##
## Call:
## lm(formula = q ~ xper + cap + lab, data = chard)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.3447 -1.6842 -0.1289 1.3112 9.4533
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.76226 1.05535 1.670 0.099354 .
## xper 0.14684 0.06343 2.315 0.023517 *
## cap 0.43796 0.11756 3.725 0.000388 ***
## lab 0.23916 0.09980 2.396 0.019195 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.756 on 71 degrees of freedom
## Multiple R-squared: 0.5616, Adjusted R-squared: 0.543
## F-statistic: 30.31 on 3 and 71 DF, p-value: 9.986e-13
The R squared is 0.56 (or adjusted to 0.543), meaning that this linear model can only explain about half of the variability of the data around its mean, which is considered not a good fit, so we shouldn’t count much on the estimates to reflect reality. Still, higher experience, higher capital and more labor all seem to increase the output (intuitively), and all of significant at the 5% level, whereas captial gains seem to be much more significant even at the 1% level with a p-value of 0.0004.
setDT(chard)
chard.sample <- chard[, .(xper=c(10,20,30), cap=mean(chard$cap), lab=mean(chard$lab))]
predictions <- as.data.frame(cbind(c(10,20,30), predict(lm1, chard.sample, interval = "predict")))
names(predictions)[1] <- "xper"
kable(predictions)
| xper | fit | lwr | upr |
|---|---|---|---|
| 10 | 9.064691 | 3.510797 | 14.61858 |
| 20 | 10.533072 | 4.947011 | 16.11913 |
| 30 | 12.001454 | 6.105526 | 17.89738 |
The intervals seem reasonable, somewhat wide for detecting meaningful differences between 10,20 and 30 years of experience (for example, any quantity between 7-14 could have come from either of them at the 95% confidence level).
We could use the 2SLS regression method, where we first predict the insterumented variable with the instrument and use those predictions as the instruements for the missing variable; however that would still yeild incorrect standard errors. Luckily, R has a package that estimates instrumental variables with correct errors. To test this, let’s specify an instrumental variables regression
# in R ivyreg function, use the original regresssors | replaced (instrumented) regressors
iv.age.xper <- ivreg(q ~ xper + cap + lab |
age + cap + lab,
data=chard)
summary(iv.age.xper, diagnostics=TRUE)
##
## Call:
## ivreg(formula = q ~ xper + cap + lab | age + cap + lab, data = chard)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.40413 -2.17750 -0.09044 2.28339 10.62769
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.4867 2.7226 -0.913 0.3642
## xper 0.5121 0.2205 2.323 0.0231 *
## cap 0.3321 0.1545 2.150 0.0349 *
## lab 0.2400 0.1209 1.985 0.0510 .
##
## Diagnostic tests:
## df1 df2 statistic p-value
## Weak instruments 1 71 9.814 0.00252 **
## Wu-Hausman 1 70 4.830 0.03127 *
## Sargan 0 NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.338 on 71 degrees of freedom
## Multiple R-Squared: 0.3568, Adjusted R-squared: 0.3296
## Wald test: 21.24 on 3 and 71 DF, p-value: 6.307e-10
The results for the quantity IV model are as follows:
stargazer(lm1, iv.age.xper, type="text")
##
## =================================================================
## Dependent variable:
## -----------------------------------
## q
## OLS instrumental
## variable
## (1) (2)
## -----------------------------------------------------------------
## xper 0.147** 0.512**
## (0.063) (0.220)
##
## cap 0.438*** 0.332**
## (0.118) (0.154)
##
## lab 0.239** 0.240*
## (0.100) (0.121)
##
## Constant 1.762* -2.487
## (1.055) (2.723)
##
## -----------------------------------------------------------------
## Observations 75 75
## R2 0.562 0.357
## Adjusted R2 0.543 0.330
## Residual Std. Error (df = 71) 2.756 3.338
## F Statistic 30.312*** (df = 3; 71)
## =================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
Comparing the results of the OLS versus the Instrumental Variable models, we can see that: * The effect of Experience (xper) is much larger (4 times larger) in the IV model instrumenting it with age * The effect of Capital is smaller in the IV model (~75% of its value before). * The effect of Labor remains about the same. * The standard errors are greater in the IV model; espeically for the instrumented variable and the intercept. * However, the R2 and Adjusted R2 are considerably smaller for the IV model; from ~0.5 to ~0.3.
Using the IV regression model, I build a synthetic small dataset with the desired values to predict for, and predict the the result given those values. Now, to report the confidence intervals, I will use the corrected standard errors given from the ivreg model, as reported in the previous table (comparison table).
setDT(chard)
chard.sample <- chard[, .(xper=c(10,20,30), cap=mean(chard$cap), lab=mean(chard$lab), age=mean(chard$age))]
preds <- predict(iv.age.xper, chard.sample, interval = "predict")
preds.intervals <- as.data.frame(cbind( c(10,20,30), preds, preds - 1.96*iv.age.xper$sigma^2, preds+1.96*iv.age.xper$sigma^2))
names(preds.intervals) <- c("xper", "q_estimate", "lower", "upper")
kable(preds.intervals)
| xper | q_estimate | lower | upper |
|---|---|---|---|
| 10 | 7.647467 | -14.194997 | 29.48993 |
| 20 | 12.768487 | -9.073976 | 34.61095 |
| 30 | 17.889508 | -3.952956 | 39.73197 |
Comparing these interval estimates with those obtained in part (2b), these intervals are MUCH wider - more than twice as wide. The intervals seem much less relevant for interpretation, both because of their mangitude and the resulting nonsensicle result of yielding a negative amount of wine barrels (which makes no since). They present a very wide overlap - between -3 and 29, meaning for example any quantity in the range could have come from either of them at the 95% confidence level).