data(turnout)

Extend the log-liklihood function to include educate and age

ols.lf2 <- function(param){
  mu <- param[1]
  theta <- param[-1]
  y <- as.vector(turnout$income)
  x <- cbind(1, turnout$educate, turnout$age)
  sigma <- x%*%theta
  sum(dnorm(y, mu, sigma, log = TRUE))
} 

Obtain the maximum likelihood estimates

library(maxLik)
mle_ols2 <- maxLik(logLik = ols.lf2, start = c(mu = 1, theta1 = 1, theta2 = 1, theta3 = 1), method = "BFGS")
NaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs producedNaNs produced
summary(mle_ols2)
--------------------------------------------
Maximum Likelihood estimation
BFGS maximization, 150 iterations
Return code 0: successful convergence 
Log-Likelihood: -4843.15 
4  free parameters
Estimates:
       Estimate Std. error t value  Pr(> t)    
mu     3.555011   0.069193  51.378  < 2e-16 ***
theta1 0.362114   0.204550   1.770   0.0767 .  
theta2 0.133349   0.010756  12.398  < 2e-16 ***
theta3 0.017507   0.002852   6.139 8.32e-10 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
--------------------------------------------

In this assignment we were asked to determine how education and age influence the dispersion of income using our own maximum likelihood estimation. This is different than work that is traditionally done in this field of study, because we are observing the dispersion of points(sigma) rather than the average(mu). In the analysis above, we are able to determine that education and age both have a significant effect on the dispersion of income in the turnout dataset. This effect is increasing, such that the dispersion of income increases as a function of education and age. In other words, both education and age make the distribution of income more variable, whereas younger people and less educated people will experience a more limited income than their counterparts. The effect on income variability is larger for education than for age, which indicates that one could supplement their limited income better with education than just by aging alone, but when taken together, increased education and aging will affect income dispersion the most tremendously than one independent variable alone.

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQpgYGB7cn0KZGF0YSh0dXJub3V0KQpgYGAKCiMjRXh0ZW5kIHRoZSBsb2ctbGlrbGlob29kIGZ1bmN0aW9uIHRvIGluY2x1ZGUgZWR1Y2F0ZSBhbmQgYWdlCmBgYHtyfQpvbHMubGYyIDwtIGZ1bmN0aW9uKHBhcmFtKXsKICBtdSA8LSBwYXJhbVsxXQogIHRoZXRhIDwtIHBhcmFtWy0xXQogIHkgPC0gYXMudmVjdG9yKHR1cm5vdXQkaW5jb21lKQogIHggPC0gY2JpbmQoMSwgdHVybm91dCRlZHVjYXRlLCB0dXJub3V0JGFnZSkKICBzaWdtYSA8LSB4JSoldGhldGEKICBzdW0oZG5vcm0oeSwgbXUsIHNpZ21hLCBsb2cgPSBUUlVFKSkKfSAKYGBgCiMjT2J0YWluIHRoZSBtYXhpbXVtIGxpa2VsaWhvb2QgZXN0aW1hdGVzCmBgYHtyfQpsaWJyYXJ5KG1heExpaykKbWxlX29sczIgPC0gbWF4TGlrKGxvZ0xpayA9IG9scy5sZjIsIHN0YXJ0ID0gYyhtdSA9IDEsIHRoZXRhMSA9IDEsIHRoZXRhMiA9IDEsIHRoZXRhMyA9IDEpLCBtZXRob2QgPSAiQkZHUyIpCnN1bW1hcnkobWxlX29sczIpCmBgYAoKSW4gdGhpcyBhc3NpZ25tZW50IHdlIHdlcmUgYXNrZWQgdG8gZGV0ZXJtaW5lIGhvdyBlZHVjYXRpb24gYW5kIGFnZSBpbmZsdWVuY2UgdGhlIGRpc3BlcnNpb24gb2YgaW5jb21lIHVzaW5nIG91ciBvd24gbWF4aW11bSBsaWtlbGlob29kIGVzdGltYXRpb24uIFRoaXMgaXMgZGlmZmVyZW50IHRoYW4gd29yayB0aGF0IGlzIHRyYWRpdGlvbmFsbHkgZG9uZSBpbiB0aGlzIGZpZWxkIG9mIHN0dWR5LCBiZWNhdXNlIHdlIGFyZSBvYnNlcnZpbmcgdGhlIGRpc3BlcnNpb24gb2YgcG9pbnRzKHNpZ21hKSByYXRoZXIgdGhhbiB0aGUgYXZlcmFnZShtdSkuCkluIHRoZSBhbmFseXNpcyBhYm92ZSwgd2UgYXJlIGFibGUgdG8gZGV0ZXJtaW5lIHRoYXQgZWR1Y2F0aW9uIGFuZCBhZ2UgYm90aCBoYXZlIGEgc2lnbmlmaWNhbnQgZWZmZWN0IG9uIHRoZSBkaXNwZXJzaW9uIG9mIGluY29tZSBpbiB0aGUgdHVybm91dCBkYXRhc2V0LiBUaGlzIGVmZmVjdCBpcyBpbmNyZWFzaW5nLCBzdWNoIHRoYXQgdGhlIGRpc3BlcnNpb24gb2YgaW5jb21lIGluY3JlYXNlcyBhcyBhIGZ1bmN0aW9uIG9mIGVkdWNhdGlvbiBhbmQgYWdlLiBJbiBvdGhlciB3b3JkcywgYm90aCBlZHVjYXRpb24gYW5kIGFnZSBtYWtlIHRoZSBkaXN0cmlidXRpb24gb2YgaW5jb21lIG1vcmUgdmFyaWFibGUsIHdoZXJlYXMgeW91bmdlciBwZW9wbGUgYW5kIGxlc3MgZWR1Y2F0ZWQgcGVvcGxlIHdpbGwgZXhwZXJpZW5jZSBhIG1vcmUgbGltaXRlZCBpbmNvbWUgdGhhbiB0aGVpciBjb3VudGVycGFydHMuIFRoZSBlZmZlY3Qgb24gaW5jb21lIHZhcmlhYmlsaXR5IGlzIGxhcmdlciBmb3IgZWR1Y2F0aW9uIHRoYW4gZm9yIGFnZSwgd2hpY2ggaW5kaWNhdGVzIHRoYXQgb25lIGNvdWxkIHN1cHBsZW1lbnQgdGhlaXIgbGltaXRlZCBpbmNvbWUgYmV0dGVyIHdpdGggZWR1Y2F0aW9uIHRoYW4ganVzdCBieSBhZ2luZyBhbG9uZSwgYnV0IHdoZW4gdGFrZW4gdG9nZXRoZXIsIGluY3JlYXNlZCBlZHVjYXRpb24gYW5kIGFnaW5nIHdpbGwgYWZmZWN0IGluY29tZSBkaXNwZXJzaW9uIHRoZSBtb3N0IHRyZW1lbmRvdXNseSB0aGFuIG9uZSBpbmRlcGVuZGVudCB2YXJpYWJsZSBhbG9uZS4KCgo=