library(tidyverse)
## Warning: package 'tibble' was built under R version 4.0.4
library(openintro)

FORUM DESCRIPTION

Using R, build a regression model for data that interests you. Conduct residual analysis. Was the linear model appropriate? Why or why not?

This discussion uses the hsb2(link provided here) dataset from the openintro library which is sourced from the UCLA Institute for Digital Research & Education - Statistical Consulting. The variables taken into account for the linear regression model below are reading and math scores where the reading score has been used as the independent variable and math scores are used as the dependent variable (reading comprehension skills are important for word problems in math).

https://www.openintro.org/data/index.php?data=hsb2︎

hsb2
## # A tibble: 200 x 11
##       id gender race        ses   schtyp prog     read write  math science socst
##    <int> <chr>  <chr>       <fct> <fct>  <fct>   <int> <int> <int>   <int> <int>
##  1    70 male   white       low   public general    57    52    41      47    57
##  2   121 female white       midd~ public vocati~    68    59    53      63    61
##  3    86 male   white       high  public general    44    33    54      58    31
##  4   141 male   white       high  public vocati~    63    44    47      53    56
##  5   172 male   white       midd~ public academ~    47    52    57      53    61
##  6   113 male   white       midd~ public academ~    44    52    51      63    61
##  7    50 male   african am~ midd~ public general    50    59    42      53    61
##  8    11 male   hispanic    midd~ public academ~    34    46    45      39    36
##  9    84 male   white       midd~ public general    63    57    54      58    51
## 10    48 male   african am~ midd~ public academ~    57    55    52      50    51
## # ... with 190 more rows
plot(hsb2$read, hsb2$math)

my_lm <- lm(hsb2$math ~ hsb2$read)
summary(my_lm)
## 
## Call:
## lm(formula = hsb2$math ~ hsb2$read)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -24.1624  -5.1624  -0.4135   4.7775  16.4684 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 21.03816    2.58945   8.125 4.76e-14 ***
## hsb2$read    0.60515    0.04865  12.438  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.037 on 198 degrees of freedom
## Multiple R-squared:  0.4386, Adjusted R-squared:  0.4358 
## F-statistic: 154.7 on 1 and 198 DF,  p-value: < 2.2e-16

Residual Analysis

The residual of an observation is the difference between the predicted outcome value minus the true observation value.

Residuals tell us how good a model fits the data i.e. is error large or small?

The below plot shows the size of the residual value using color coding (red signifies a higher residual, while the green shows a smaller residual) .

hsb2$predicted <- predict(my_lm)   # Save the predicted values
hsb2$residuals <- residuals(my_lm) # Save the residual values
ggplot(hsb2, aes(x = read, y = math)) +
  geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +     # regression line  
  geom_segment(aes(xend = read, yend = predicted), alpha = .2) +      # draw line from point to line
  geom_point(aes(color = abs(residuals), size = abs(residuals))) +  # size of the points
  scale_color_continuous(low = "green", high = "red") +             # colour of the points mapped to residual size - green smaller, red larger
  guides(color = FALSE, size = FALSE) +                             # Size legend removed
  geom_point(aes(y = predicted), shape = 1) +
  theme_bw()
## `geom_smooth()` using formula 'y ~ x'

Below in the Residuals vs. Fitted plot, we can see it is mostly homoscedastic meaning the residuals are equally distributed along the regression line with exception to the first half of the graph. The red line in the Residuals vs. Fitted plot is also fairly flat, meaning linearity has been met.

The Scale_location plot shows some increasing variance at the left, but then seems to flatten out after 55.

#par(mfrow=c(2,2)) #prints out two rows, two columns of plots
plot(my_lm)

Is the linear model appropriate?

In order to determine appropriateness of the linear model, we must take into consideration the four criteria listed and explained below.

There are four assumptions associated with a linear regression model:

Linearity: The relationship between X and the mean of Y is linear. Based on the Residuals vs. Fitted plot, the the red line is approximately horizontal at zero, suggesting linearity. The first plot above also shows there is somewhat of a linear relationship between the two variables.

Homoscedasticity: The variance of residual is the same for any value of X. The Scale-Location plot shows if residuals are spread equally along the ranges of predictor. We have an approximately horizontal line with most points equally spread with the exception of the far left of the graph.

Independence: Observations are independent of each other. Upon examining the Residuals vs. Fitted plot, we can see the correlation is approximately zero and looks like no relationship exists.

Normality: For any fixed value of X, Y is normally distributed. The QQ plot of residuals can be used to visually check the normality assumption. Based on the plot, it looks like the points show little deviance away from the line meaning both sets are approximately normally distributed.

It looks like the model fits the above criteria and can be considered an appropriate linear model.

LS0tDQp0aXRsZTogIkRBVEEgNjA1IFdFRUsgMTEgZGlzY3Vzc2lvbiINCmF1dGhvcjogRGVlcGFrIHNoYXJtYQ0KZGF0ZTogImByIFN5cy5EYXRlKClgIg0Kb3V0cHV0OiBvcGVuaW50cm86OmxhYl9yZXBvcnQNCmVkaXRvcl9vcHRpb25zOiANCiAgY2h1bmtfb3V0cHV0X3R5cGU6IGNvbnNvbGUNCi0tLQ0KDQpgYGB7ciBsb2FkLXBhY2thZ2VzLCBtZXNzYWdlPUZBTFNFfQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KG9wZW5pbnRybykNCmBgYA0KIyMjIEZPUlVNIERFU0NSSVBUSU9ODQpVc2luZyBSLCBidWlsZCBhIHJlZ3Jlc3Npb24gbW9kZWwgZm9yIGRhdGEgdGhhdCBpbnRlcmVzdHMgeW91LiBDb25kdWN0IHJlc2lkdWFsIGFuYWx5c2lzLiBXYXMgdGhlIGxpbmVhciBtb2RlbCBhcHByb3ByaWF0ZT8gV2h5IG9yIHdoeSBub3Q/DQoNClRoaXMgZGlzY3Vzc2lvbiB1c2VzIHRoZSBoc2IyKGxpbmsgcHJvdmlkZWQgaGVyZSkgZGF0YXNldCBmcm9tIHRoZSBvcGVuaW50cm8gbGlicmFyeSB3aGljaCBpcyBzb3VyY2VkIGZyb20gdGhlIFVDTEEgSW5zdGl0dXRlIGZvciBEaWdpdGFsIFJlc2VhcmNoICYgRWR1Y2F0aW9uIC0gU3RhdGlzdGljYWwgQ29uc3VsdGluZy4gVGhlIHZhcmlhYmxlcyB0YWtlbiBpbnRvIGFjY291bnQgZm9yIHRoZSBsaW5lYXIgcmVncmVzc2lvbiBtb2RlbCBiZWxvdyBhcmUgcmVhZGluZyBhbmQgbWF0aCBzY29yZXMgd2hlcmUgdGhlIHJlYWRpbmcgc2NvcmUgaGFzIGJlZW4gdXNlZCBhcyB0aGUgaW5kZXBlbmRlbnQgdmFyaWFibGUgYW5kIG1hdGggc2NvcmVzIGFyZSB1c2VkIGFzIHRoZSBkZXBlbmRlbnQgdmFyaWFibGUgKHJlYWRpbmcgY29tcHJlaGVuc2lvbiBza2lsbHMgYXJlIGltcG9ydGFudCBmb3Igd29yZCBwcm9ibGVtcyBpbiBtYXRoKS4NCg0KImh0dHBzOi8vd3d3Lm9wZW5pbnRyby5vcmcvZGF0YS9pbmRleC5waHA/ZGF0YT1oc2Iy77iOIg0KDQpgYGB7cn0NCiANCmhzYjINCg0KcGxvdChoc2IyJHJlYWQsIGhzYjIkbWF0aCkNCg0KbXlfbG0gPC0gbG0oaHNiMiRtYXRoIH4gaHNiMiRyZWFkKQ0Kc3VtbWFyeShteV9sbSkNCg0KYGBgDQojIyMgUmVzaWR1YWwgQW5hbHlzaXMNCg0KVGhlIHJlc2lkdWFsIG9mIGFuIG9ic2VydmF0aW9uIGlzIHRoZSBkaWZmZXJlbmNlIGJldHdlZW4gdGhlIHByZWRpY3RlZCBvdXRjb21lIHZhbHVlIG1pbnVzIHRoZSB0cnVlIG9ic2VydmF0aW9uIHZhbHVlLg0KDQpSZXNpZHVhbHMgdGVsbCB1cyBob3cgZ29vZCBhIG1vZGVsIGZpdHMgdGhlIGRhdGEgaS5lLiBpcyBlcnJvciBsYXJnZSBvciBzbWFsbD8NCg0KVGhlIGJlbG93IHBsb3Qgc2hvd3MgdGhlIHNpemUgb2YgdGhlIHJlc2lkdWFsIHZhbHVlIHVzaW5nIGNvbG9yIGNvZGluZyAocmVkIHNpZ25pZmllcyBhIGhpZ2hlciByZXNpZHVhbCwgd2hpbGUgdGhlIGdyZWVuIHNob3dzIGEgc21hbGxlciByZXNpZHVhbCkgLg0KYGBge3J9DQoNCmhzYjIkcHJlZGljdGVkIDwtIHByZWRpY3QobXlfbG0pICAgIyBTYXZlIHRoZSBwcmVkaWN0ZWQgdmFsdWVzDQpoc2IyJHJlc2lkdWFscyA8LSByZXNpZHVhbHMobXlfbG0pICMgU2F2ZSB0aGUgcmVzaWR1YWwgdmFsdWVzDQpnZ3Bsb3QoaHNiMiwgYWVzKHggPSByZWFkLCB5ID0gbWF0aCkpICsNCiAgZ2VvbV9zbW9vdGgobWV0aG9kID0gImxtIiwgc2UgPSBGQUxTRSwgY29sb3IgPSAibGlnaHRncmV5IikgKyAgICAgIyByZWdyZXNzaW9uIGxpbmUgIA0KICBnZW9tX3NlZ21lbnQoYWVzKHhlbmQgPSByZWFkLCB5ZW5kID0gcHJlZGljdGVkKSwgYWxwaGEgPSAuMikgKyAgICAgICMgZHJhdyBsaW5lIGZyb20gcG9pbnQgdG8gbGluZQ0KICBnZW9tX3BvaW50KGFlcyhjb2xvciA9IGFicyhyZXNpZHVhbHMpLCBzaXplID0gYWJzKHJlc2lkdWFscykpKSArICAjIHNpemUgb2YgdGhlIHBvaW50cw0KICBzY2FsZV9jb2xvcl9jb250aW51b3VzKGxvdyA9ICJncmVlbiIsIGhpZ2ggPSAicmVkIikgKyAgICAgICAgICAgICAjIGNvbG91ciBvZiB0aGUgcG9pbnRzIG1hcHBlZCB0byByZXNpZHVhbCBzaXplIC0gZ3JlZW4gc21hbGxlciwgcmVkIGxhcmdlcg0KICBndWlkZXMoY29sb3IgPSBGQUxTRSwgc2l6ZSA9IEZBTFNFKSArICAgICAgICAgICAgICAgICAgICAgICAgICAgICAjIFNpemUgbGVnZW5kIHJlbW92ZWQNCiAgZ2VvbV9wb2ludChhZXMoeSA9IHByZWRpY3RlZCksIHNoYXBlID0gMSkgKw0KICB0aGVtZV9idygpDQoNCmBgYA0KDQpCZWxvdyBpbiB0aGUgUmVzaWR1YWxzIHZzLiBGaXR0ZWQgcGxvdCwgd2UgY2FuIHNlZSBpdCBpcyBtb3N0bHkgaG9tb3NjZWRhc3RpYyBtZWFuaW5nIHRoZSByZXNpZHVhbHMgYXJlIGVxdWFsbHkgZGlzdHJpYnV0ZWQgYWxvbmcgdGhlIHJlZ3Jlc3Npb24gbGluZSB3aXRoIGV4Y2VwdGlvbiB0byB0aGUgZmlyc3QgaGFsZiBvZiB0aGUgZ3JhcGguIFRoZSByZWQgbGluZSBpbiB0aGUgUmVzaWR1YWxzIHZzLiBGaXR0ZWQgcGxvdCBpcyBhbHNvIGZhaXJseSBmbGF0LCBtZWFuaW5nIGxpbmVhcml0eSBoYXMgYmVlbiBtZXQuDQoNClRoZSBTY2FsZV9sb2NhdGlvbiBwbG90IHNob3dzIHNvbWUgaW5jcmVhc2luZyB2YXJpYW5jZSBhdCB0aGUgbGVmdCwgYnV0IHRoZW4gc2VlbXMgdG8gZmxhdHRlbiBvdXQgYWZ0ZXIgNTUuDQoNCmBgYHtyfQ0KI3BhcihtZnJvdz1jKDIsMikpICNwcmludHMgb3V0IHR3byByb3dzLCB0d28gY29sdW1ucyBvZiBwbG90cw0KcGxvdChteV9sbSkNCg0KYGBgDQoNCiMjIyBJcyB0aGUgbGluZWFyIG1vZGVsIGFwcHJvcHJpYXRlPw0KDQpJbiBvcmRlciB0byBkZXRlcm1pbmUgYXBwcm9wcmlhdGVuZXNzIG9mIHRoZSBsaW5lYXIgbW9kZWwsIHdlIG11c3QgdGFrZSBpbnRvIGNvbnNpZGVyYXRpb24gdGhlIGZvdXIgY3JpdGVyaWEgbGlzdGVkIGFuZCBleHBsYWluZWQgYmVsb3cuDQoNClRoZXJlIGFyZSBmb3VyIGFzc3VtcHRpb25zIGFzc29jaWF0ZWQgd2l0aCBhIGxpbmVhciByZWdyZXNzaW9uIG1vZGVsOiANCg0KTGluZWFyaXR5OiBUaGUgcmVsYXRpb25zaGlwIGJldHdlZW4gWCBhbmQgdGhlIG1lYW4gb2YgWSBpcyBsaW5lYXIuDQpCYXNlZCBvbiB0aGUgUmVzaWR1YWxzIHZzLiBGaXR0ZWQgcGxvdCwgdGhlIHRoZSByZWQgbGluZSBpcyBhcHByb3hpbWF0ZWx5IGhvcml6b250YWwgYXQgemVybywgc3VnZ2VzdGluZyBsaW5lYXJpdHkuIFRoZSBmaXJzdCBwbG90IGFib3ZlIGFsc28gc2hvd3MgdGhlcmUgaXMgc29tZXdoYXQgb2YgYSBsaW5lYXIgcmVsYXRpb25zaGlwIGJldHdlZW4gdGhlIHR3byB2YXJpYWJsZXMuDQoNCkhvbW9zY2VkYXN0aWNpdHk6IFRoZSB2YXJpYW5jZSBvZiByZXNpZHVhbCBpcyB0aGUgc2FtZSBmb3IgYW55IHZhbHVlIG9mIFguDQpUaGUgU2NhbGUtTG9jYXRpb24gcGxvdCBzaG93cyBpZiByZXNpZHVhbHMgYXJlIHNwcmVhZCBlcXVhbGx5IGFsb25nIHRoZSByYW5nZXMgb2YgcHJlZGljdG9yLiBXZSBoYXZlIGFuIGFwcHJveGltYXRlbHkgaG9yaXpvbnRhbCBsaW5lIHdpdGggbW9zdCBwb2ludHMgZXF1YWxseSBzcHJlYWQgd2l0aCB0aGUgZXhjZXB0aW9uIG9mIHRoZSBmYXIgbGVmdCBvZiB0aGUgZ3JhcGguDQoNCkluZGVwZW5kZW5jZTogT2JzZXJ2YXRpb25zIGFyZSBpbmRlcGVuZGVudCBvZiBlYWNoIG90aGVyLg0KVXBvbiBleGFtaW5pbmcgdGhlIFJlc2lkdWFscyB2cy4gRml0dGVkIHBsb3QsIHdlIGNhbiBzZWUgdGhlIGNvcnJlbGF0aW9uIGlzIGFwcHJveGltYXRlbHkgemVybyBhbmQgbG9va3MgbGlrZSBubyByZWxhdGlvbnNoaXAgZXhpc3RzLg0KDQpOb3JtYWxpdHk6IEZvciBhbnkgZml4ZWQgdmFsdWUgb2YgWCwgWSBpcyBub3JtYWxseSBkaXN0cmlidXRlZC4NClRoZSBRUSBwbG90IG9mIHJlc2lkdWFscyBjYW4gYmUgdXNlZCB0byB2aXN1YWxseSBjaGVjayB0aGUgbm9ybWFsaXR5IGFzc3VtcHRpb24uIEJhc2VkIG9uIHRoZSBwbG90LCBpdCBsb29rcyBsaWtlIHRoZSBwb2ludHMgc2hvdyBsaXR0bGUgZGV2aWFuY2UgYXdheSBmcm9tIHRoZSBsaW5lIG1lYW5pbmcgYm90aCBzZXRzIGFyZSBhcHByb3hpbWF0ZWx5IG5vcm1hbGx5IGRpc3RyaWJ1dGVkLg0KDQpJdCBsb29rcyBsaWtlIHRoZSBtb2RlbCBmaXRzIHRoZSBhYm92ZSBjcml0ZXJpYSBhbmQgY2FuIGJlIGNvbnNpZGVyZWQgYW4gYXBwcm9wcmlhdGUgbGluZWFyIG1vZGVsLg0KDQoNCiA=