#clean environment
rm(list = ls())
library("AER")
data<- data("CASchools")

Estimate the linear regression showing the effect of income on average test scores in the 520 California counties.

lm_math <- lm(CASchools$math ~ CASchools$income)

Linear Regression:

plot(CASchools$math ~ CASchools$income)
regLine(lm_math)

summary(lm_math)

Call:
lm(formula = CASchools$math ~ CASchools$income)

Residuals:
    Min      1Q  Median      3Q     Max 
-39.045  -8.997   0.308   8.416  34.246 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)      625.53948    1.53627  407.18   <2e-16 ***
CASchools$income   1.81523    0.09073   20.01   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 13.42 on 418 degrees of freedom
Multiple R-squared:  0.4892,    Adjusted R-squared:  0.4879 
F-statistic: 400.3 on 1 and 418 DF,  p-value: < 2.2e-16
summary(lm_math)

Call:
lm(formula = CASchools$math ~ CASchools$income)

Residuals:
    Min      1Q  Median      3Q     Max 
-39.045  -8.997   0.308   8.416  34.246 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)      625.53948    1.53627  407.18   <2e-16 ***
CASchools$income   1.81523    0.09073   20.01   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 13.42 on 418 degrees of freedom
Multiple R-squared:  0.4892,    Adjusted R-squared:  0.4879 
F-statistic: 400.3 on 1 and 418 DF,  p-value: < 2.2e-16

Polynomial Regression:

poly_math <- lm(CASchools$math ~ poly(CASchools$income,3))
plot(CASchools$math ~ CASchools$income)
lines(sort(CASchools$income),fitted(poly_math)[order(CASchools$income)],col="red")

summary(poly_math)

Call:
lm(formula = CASchools$math ~ poly(CASchools$income, 3))

Residuals:
    Min      1Q  Median      3Q     Max 
-39.491  -9.006   0.045   8.108  39.520 

Coefficients:
                           Estimate Std. Error  t value Pr(>|t|)    
(Intercept)                 653.343      0.633 1032.206  < 2e-16 ***
poly(CASchools$income, 3)1  268.491     12.972   20.698  < 2e-16 ***
poly(CASchools$income, 3)2  -72.255     12.972   -5.570 4.58e-08 ***
poly(CASchools$income, 3)3    7.963     12.972    0.614     0.54    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 12.97 on 416 degrees of freedom
Multiple R-squared:  0.525, Adjusted R-squared:  0.5216 
F-statistic: 153.3 on 3 and 416 DF,  p-value: < 2.2e-16

Test the null hypothesis that the population regression function is linear for a polynomial regression model of degree 3. Test the significance of the individual coefficients in cubic regression function relating district income to test scores (\(Test Scores = beta_1 + beta_2 income + beta_3 income^2 + beta_4 income^3\))

#For quadratics:
(-72.25 - 0) / (12.972) #notice it is the same in the table.
[1] -5.569689

\(5.5\) is much more than \(1.96\).

#For the third degree:
(-7.96 - 0) / (12.972)  #notice it is the same in the table.
[1] -0.6136294

The third degree is not statistically significant.

Based on the t-statistic can we reject the null that the regression function is quadratic?

No, as shown above the beta for the quadratic term is significant.

In the previous (1) regression function what is value of the F-statistic testing the null hypothesis that the coefficients of quadratic and cubic transformations are both zero? \(153.3\)

f <- 153.3
(7.96+72.25-0)/sqrt(f)
[1] 6.478246

\(6.4\) and the effect would be capped by:

esitimated_effect<-(7.96+72.25)
esitimated_effect + 1.96*6.4
[1] 92.754
esitimated_effect - 1.96*6.4
[1] 67.666

Can we reject this null against the alternative that it is either quadratic or cubic? Yes, it is clearly nonlinear.

Generate two new variables by logarithmic transformation of the variables on income and test scores. Call them log_income and log_testscores.

log_income  <- log(CASchools$income)
log_testscore <- log(CASchools$math)

Run and interpret these three regression models (I) \(Test Scores = beta_1 + beta_2 log_income\)

log_model <- lm(CASchools$math~log_income)
plot(CASchools$math ~ log(CASchools$income))
lines(sort(log(CASchools$income)),fitted(log_model)[order(log(CASchools$income))],col="red")

(II) $log_testscores = beta_1 + beta_2 income

log_model <- lm(CASchools$math~log_income)
plot(CASchools$math ~ log(CASchools$income))
lines(sort(log(CASchools$income)),fitted(log_model)[order(log(CASchools$income))],col="red")

(III) log_testscores = beta_1 + beta_2 log_income$

log_model1<- lm(log_testscore~log_income)
plot(CASchools$math ~ log(CASchools$income))
lines(sort(log(CASchools$income)),fitted(log_model1)[order(log(CASchools$income))],col="red")

Generate the binary variable \(D_i\) (= 1, if class-size < median) indicating low class-size.

teacher_stu_ratio <- ifelse(CASchools$students/CASchools$teachers < median(CASchools$students/CASchools$teachers),1,0)
head(teacher_stu_ratio)
[1] 1 0 1 1 1 0

Generate an interaction term (\(Income_D_i\)) by multiplying income with binary dummy indicating low class-size.

intercation <- CASchools$income*teacher_stu_ratio

Run and interpret this regression model (I) \(Test Scores = beta_1 + beta_2 income_D_i\)

last_model <- lm(CASchools$math~ intercation)
plot(CASchools$math ~ CASchools$income)
lines(sort(intercation),fitted(last_model)[order(intercation)],col="red")

LS0tCnRpdGxlOiAiU1MxNTQgLSAzLjEiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KYGBge3J9CiNjbGVhbiBlbnZpcm9ubWVudApybShsaXN0ID0gbHMoKSkKbGlicmFyeSgiQUVSIikKZGF0YTwtIGRhdGEoIkNBU2Nob29scyIpCmBgYAoKRXN0aW1hdGUgdGhlIGxpbmVhciByZWdyZXNzaW9uIHNob3dpbmcgdGhlIGVmZmVjdCBvZiBpbmNvbWUgb24gYXZlcmFnZSB0ZXN0IHNjb3JlcyBpbiB0aGUgNTIwIENhbGlmb3JuaWEgY291bnRpZXMuIApgYGB7cn0KbG1fbWF0aCA8LSBsbShDQVNjaG9vbHMkbWF0aCB+IENBU2Nob29scyRpbmNvbWUpCmBgYAoKTGluZWFyIFJlZ3Jlc3Npb246CmBgYHtyfQpwbG90KENBU2Nob29scyRtYXRoIH4gQ0FTY2hvb2xzJGluY29tZSkKcmVnTGluZShsbV9tYXRoKQpgYGAKCmBgYHtyfQpzdW1tYXJ5KGxtX21hdGgpCmBgYAoKClBvbHlub21pYWwgUmVncmVzc2lvbjoKCmBgYHtyfQpwb2x5X21hdGggPC0gbG0oQ0FTY2hvb2xzJG1hdGggfiBwb2x5KENBU2Nob29scyRpbmNvbWUsMykpCnBsb3QoQ0FTY2hvb2xzJG1hdGggfiBDQVNjaG9vbHMkaW5jb21lKQpsaW5lcyhzb3J0KENBU2Nob29scyRpbmNvbWUpLGZpdHRlZChwb2x5X21hdGgpW29yZGVyKENBU2Nob29scyRpbmNvbWUpXSxjb2w9InJlZCIpCmBgYApgYGB7cn0Kc3VtbWFyeShwb2x5X21hdGgpCmBgYAoqKlRlc3QgdGhlIG51bGwgaHlwb3RoZXNpcyB0aGF0IHRoZSBwb3B1bGF0aW9uIHJlZ3Jlc3Npb24gZnVuY3Rpb24gaXMgbGluZWFyIGZvciBhIHBvbHlub21pYWwgcmVncmVzc2lvbiBtb2RlbCBvZiBkZWdyZWUgMy4gVGVzdCB0aGUgc2lnbmlmaWNhbmNlIG9mIHRoZSBpbmRpdmlkdWFsIGNvZWZmaWNpZW50cyBpbiBjdWJpYyByZWdyZXNzaW9uIGZ1bmN0aW9uIHJlbGF0aW5nIGRpc3RyaWN0IGluY29tZSB0byB0ZXN0IHNjb3JlcyAoJFRlc3QgU2NvcmVzID0gYmV0YV8xICsgYmV0YV8yIGluY29tZSArIGJldGFfMyBpbmNvbWVeMiArIGJldGFfNCBpbmNvbWVeMyQpKioKYGBge3J9CiNGb3IgcXVhZHJhdGljczoKKC03Mi4yNSAtIDApIC8gKDEyLjk3MikgI25vdGljZSBpdCBpcyB0aGUgc2FtZSBpbiB0aGUgdGFibGUuCmBgYAokNS41JCBpcyBtdWNoIG1vcmUgdGhhbiAkMS45NiQuCmBgYHtyfQojRm9yIHRoZSB0aGlyZCBkZWdyZWU6CigtNy45NiAtIDApIC8gKDEyLjk3MikgICNub3RpY2UgaXQgaXMgdGhlIHNhbWUgaW4gdGhlIHRhYmxlLgpgYGAKKlRoZSB0aGlyZCBkZWdyZWUgaXMgbm90IHN0YXRpc3RpY2FsbHkgc2lnbmlmaWNhbnQuKgoKKipCYXNlZCBvbiB0aGUgdC1zdGF0aXN0aWMgY2FuIHdlIHJlamVjdCB0aGUgbnVsbCB0aGF0IHRoZSByZWdyZXNzaW9uIGZ1bmN0aW9uIGlzIHF1YWRyYXRpYz8qKgoKTm8sIGFzIHNob3duIGFib3ZlIHRoZSBiZXRhIGZvciB0aGUgcXVhZHJhdGljIHRlcm0gaXMgc2lnbmlmaWNhbnQuCgpJbiB0aGUgcHJldmlvdXMgKDEpIHJlZ3Jlc3Npb24gZnVuY3Rpb24gd2hhdCBpcyB2YWx1ZSBvZiB0aGUgRi1zdGF0aXN0aWMgdGVzdGluZyB0aGUgbnVsbCBoeXBvdGhlc2lzIHRoYXQgdGhlIGNvZWZmaWNpZW50cyBvZiBxdWFkcmF0aWMgYW5kIGN1YmljIHRyYW5zZm9ybWF0aW9ucyBhcmUgYm90aCB6ZXJvPwokMTUzLjMkCmBgYHtyfQpmIDwtIDE1My4zCig3Ljk2KzcyLjI1LTApL3NxcnQoZikKYGBgCiQ2LjQkIGFuZCB0aGUgZWZmZWN0IHdvdWxkIGJlIGNhcHBlZCBieToKYGBge3J9CmVzaXRpbWF0ZWRfZWZmZWN0PC0oNy45Nis3Mi4yNSkKZXNpdGltYXRlZF9lZmZlY3QgKyAxLjk2KjYuNAplc2l0aW1hdGVkX2VmZmVjdCAtIDEuOTYqNi40CmBgYAoKKipDYW4gd2UgcmVqZWN0IHRoaXMgbnVsbCBhZ2FpbnN0IHRoZSBhbHRlcm5hdGl2ZSB0aGF0IGl0IGlzIGVpdGhlciBxdWFkcmF0aWMgb3IgY3ViaWM/KioKKlllcywgaXQgaXMgY2xlYXJseSBub25saW5lYXIuKgoKKipHZW5lcmF0ZSB0d28gbmV3IHZhcmlhYmxlcyBieSBsb2dhcml0aG1pYyB0cmFuc2Zvcm1hdGlvbiBvZiB0aGUgdmFyaWFibGVzIG9uIGluY29tZSBhbmQgdGVzdCBzY29yZXMuIENhbGwgdGhlbSBsb2dfaW5jb21lIGFuZCBsb2dfdGVzdHNjb3Jlcy4qKgpgYGB7cn0KbG9nX2luY29tZSAgPC0gbG9nKENBU2Nob29scyRpbmNvbWUpCmxvZ190ZXN0c2NvcmUgPC0gbG9nKENBU2Nob29scyRtYXRoKQpgYGAKCioqUnVuIGFuZCBpbnRlcnByZXQgdGhlc2UgdGhyZWUgcmVncmVzc2lvbiBtb2RlbHMgKEkpICRUZXN0IFNjb3JlcyA9IGJldGFfMSArIGJldGFfMiBsb2dfaW5jb21lJCoqCmBgYHtyfQpsb2dfbW9kZWwgPC0gbG0oQ0FTY2hvb2xzJG1hdGh+bG9nX2luY29tZSkKcGxvdChDQVNjaG9vbHMkbWF0aCB+IGxvZyhDQVNjaG9vbHMkaW5jb21lKSkKbGluZXMoc29ydChsb2coQ0FTY2hvb2xzJGluY29tZSkpLGZpdHRlZChsb2dfbW9kZWwpW29yZGVyKGxvZyhDQVNjaG9vbHMkaW5jb21lKSldLGNvbD0icmVkIikKYGBgCgoqKihJSSkgJGxvZ190ZXN0c2NvcmVzID0gYmV0YV8xICsgYmV0YV8yIGluY29tZSAqKgpgYGB7cn0KbG9nX21vZGVsIDwtIGxtKENBU2Nob29scyRtYXRofmxvZ19pbmNvbWUpCnBsb3QoQ0FTY2hvb2xzJG1hdGggfiBsb2coQ0FTY2hvb2xzJGluY29tZSkpCmxpbmVzKHNvcnQobG9nKENBU2Nob29scyRpbmNvbWUpKSxmaXR0ZWQobG9nX21vZGVsKVtvcmRlcihsb2coQ0FTY2hvb2xzJGluY29tZSkpXSxjb2w9InJlZCIpCmBgYAoKKiooSUlJKSBsb2dfdGVzdHNjb3JlcyA9IGJldGFfMSArIGJldGFfMiBsb2dfaW5jb21lJCoqCmBgYHtyfQpsb2dfbW9kZWwxPC0gbG0obG9nX3Rlc3RzY29yZX5sb2dfaW5jb21lKQpwbG90KENBU2Nob29scyRtYXRoIH4gbG9nKENBU2Nob29scyRpbmNvbWUpKQpsaW5lcyhzb3J0KGxvZyhDQVNjaG9vbHMkaW5jb21lKSksZml0dGVkKGxvZ19tb2RlbDEpW29yZGVyKGxvZyhDQVNjaG9vbHMkaW5jb21lKSldLGNvbD0icmVkIikKYGBgCgoqKkdlbmVyYXRlIHRoZSBiaW5hcnkgdmFyaWFibGUgJERfaSQgKD0gMSwgaWYgY2xhc3Mtc2l6ZSA8IG1lZGlhbikgaW5kaWNhdGluZyBsb3cgY2xhc3Mtc2l6ZS4gKioKYGBge3J9CnRlYWNoZXJfc3R1X3JhdGlvIDwtIGlmZWxzZShDQVNjaG9vbHMkc3R1ZGVudHMvQ0FTY2hvb2xzJHRlYWNoZXJzIDwgbWVkaWFuKENBU2Nob29scyRzdHVkZW50cy9DQVNjaG9vbHMkdGVhY2hlcnMpLDEsMCkKaGVhZCh0ZWFjaGVyX3N0dV9yYXRpbykKYGBgCgoqKkdlbmVyYXRlIGFuIGludGVyYWN0aW9uIHRlcm0gKCRJbmNvbWVfRF9pJCkgYnkgbXVsdGlwbHlpbmcgaW5jb21lIHdpdGggYmluYXJ5IGR1bW15IGluZGljYXRpbmcgbG93IGNsYXNzLXNpemUuKioKYGBge3J9CmludGVyY2F0aW9uIDwtIENBU2Nob29scyRpbmNvbWUqdGVhY2hlcl9zdHVfcmF0aW8KYGBgCgoqKlJ1biBhbmQgaW50ZXJwcmV0IHRoaXMgcmVncmVzc2lvbiBtb2RlbCAoSSkgJFRlc3QgU2NvcmVzID0gYmV0YV8xICsgYmV0YV8yIGluY29tZV9EX2kkKioKYGBge3J9Cmxhc3RfbW9kZWwgPC0gbG0oQ0FTY2hvb2xzJG1hdGh+IGludGVyY2F0aW9uKQpwbG90KENBU2Nob29scyRtYXRoIH4gQ0FTY2hvb2xzJGluY29tZSkKbGluZXMoc29ydChpbnRlcmNhdGlvbiksZml0dGVkKGxhc3RfbW9kZWwpW29yZGVyKGludGVyY2F0aW9uKV0sY29sPSJyZWQiKQpgYGAKCg==