THE PROBLEM:
I would like to see how the weight of a car affects its gas mileage (MPG). Supposedly the heavier the car, the worse gas mileage it gets. An SUV would get a lower MPG than a compact car. Prove it…

REVIEW OF THE LITERATURE:
“While cost savings will vary depending on vocation, application and operating conditions, states a Kenworth White Paper published a few years ago, weight savings can improve the life cycle cost of a vehicle in two respects: increased payload capacity and better fuel economy.”
-Skydel, Seth. “Fuel Economy: Weight Savings.” Fleet Equipment 33.10 (2007): 47-48. Web.

It appears other people have come up with the same idea. They find that weight savings in freight trucks allow for cost savings. They can load more stuff onto their truck for the same cost in fuel.

THE ECONOMIC MODEL:
The model I will use is a simple linear regression. In plain english, fuel economy (MPG) is a function of its weight(Lbs).
\(MPG = f(Weight)\)
A car’s fuel economy in miles per gallon depends on its weight in pounds.

THE DATA:
“The data was extracted from the 1974 Motor Trend US magazine, and comprises fuel consumption and 10 aspects of automobile design and performance for 32 automobiles (1973–74 models).”
-Henderson and Velleman (1981), Building multiple regression models interactively. Biometrics, 37, 391–411.

Variable Name What it is
mpg Miles/(US) gallon
cyl Number of cylinders
disp Displacement (cu.in.)
hp Gross horsepower
drat Rear axle ratio
wt Weight (1000 lbs)
qsec 1/4 mile time
vs Engine (0 = V-shaped, 1 = straight)
am Transmission (0 = automatic, 1 = manual)
gear Number of forward gears
carb Number of carburetors

CORRELATION AND REGRESSION:
1. Import the Data

#import a copy of the mtcars dataset from a CSV and store it in a vairable named mtcars.
mtcars <- read.csv("~/mtCars/mtcars.csv")

(R has mtcars preloaded but this will be more realistic)

  1. Plot the Data
#plot the cars weight on the x-axis, their mpg on the y-axis,  
#additionally label the x and y axis, finally give the plot a main title.
plot(mtcars$wt, mtcars$mpg, 
     xlab = "Weight (1000 lbs)",   
     ylab = "Miles/(US) gallon",   
     main = "Miles per Gallon by Weight")

It sure looks like there is a correlation where heavier cars have worse fuel economy.

  1. The linear model
#I need the stats package for the linear model call.
#Make sure you download the package,
#then you can call it from your library.
library(stats)

#myLinearModel gets the linear model of mpg as a function of weight using data from mtcars. 
myLinearModel <- lm(formula = mpg ~ wt, data = mtcars)

#show me the summary of my model
summary(myLinearModel)

Call:
lm(formula = mpg ~ wt, data = mtcars)

Residuals:
    Min      1Q  Median      3Q     Max 
-4.5432 -2.3647 -0.1252  1.4096  6.8727 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  37.2851     1.8776  19.858  < 2e-16 ***
wt           -5.3445     0.5591  -9.559 1.29e-10 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 3.046 on 30 degrees of freedom
Multiple R-squared:  0.7528,    Adjusted R-squared:  0.7446 
F-statistic: 91.38 on 1 and 30 DF,  p-value: 1.294e-10
  1. Plot the model and the regression line on top of it.
#plot mpg as a function of weight then put the regression line over it.
plot(mtcars$mpg ~ mtcars$wt, 
     xlab = "Weight (1000 lbs)",   
     ylab = "Miles/(US) gallon",   
     main = "Miles per Gallon by Weight")  
  abline(myLinearModel, col = "red")

LS0tDQp0aXRsZTogIkJ1c2luZXNzIFN0YXRzLiBDb3JyZWxhdGlvbiBhbmQgUmVncmVzc2lvbiINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoqKioNCioqVEhFIFBST0JMRU06KiogIA0KSSB3b3VsZCBsaWtlIHRvIHNlZSBob3cgdGhlIHdlaWdodCBvZiBhIGNhciBhZmZlY3RzIGl0cyBnYXMgbWlsZWFnZSAoTVBHKS4NClN1cHBvc2VkbHkgdGhlIGhlYXZpZXIgdGhlIGNhciwgdGhlIHdvcnNlIGdhcyBtaWxlYWdlIGl0IGdldHMuIEFuIFNVViB3b3VsZCBnZXQgYSBsb3dlciBNUEcgdGhhbiBhIGNvbXBhY3QgY2FyLiBQcm92ZSBpdC4uLg0KDQoqKlJFVklFVyBPRiBUSEUgTElURVJBVFVSRToqKiAgDQoiV2hpbGUgY29zdCBzYXZpbmdzIHdpbGwgdmFyeSBkZXBlbmRpbmcgb24gdm9jYXRpb24sIGFwcGxpY2F0aW9uIGFuZCBvcGVyYXRpbmcgY29uZGl0aW9ucywgc3RhdGVzIGEgS2Vud29ydGggV2hpdGUgUGFwZXIgcHVibGlzaGVkIGEgZmV3IHllYXJzIGFnbywgd2VpZ2h0IHNhdmluZ3MgY2FuIGltcHJvdmUgdGhlIGxpZmUgY3ljbGUgY29zdCBvZiBhIHZlaGljbGUgaW4gdHdvIHJlc3BlY3RzOiBpbmNyZWFzZWQgcGF5bG9hZCBjYXBhY2l0eSBhbmQgYmV0dGVyIGZ1ZWwgZWNvbm9teS4iICAgDQotU2t5ZGVsLCBTZXRoLiAiRnVlbCBFY29ub215OiBXZWlnaHQgU2F2aW5ncy4iIEZsZWV0IEVxdWlwbWVudCAzMy4xMCAoMjAwNyk6IDQ3LTQ4LiBXZWIuDQogIA0KSXQgYXBwZWFycyBvdGhlciBwZW9wbGUgaGF2ZSBjb21lIHVwIHdpdGggdGhlIHNhbWUgaWRlYS4gVGhleSBmaW5kIHRoYXQgd2VpZ2h0IHNhdmluZ3MgaW4gZnJlaWdodCB0cnVja3MgYWxsb3cgZm9yIGNvc3Qgc2F2aW5ncy4gVGhleSBjYW4gbG9hZCBtb3JlIHN0dWZmIG9udG8gdGhlaXIgdHJ1Y2sgZm9yIHRoZSBzYW1lIGNvc3QgaW4gZnVlbC4NCg0KKipUSEUgRUNPTk9NSUMgTU9ERUw6KiogIA0KVGhlIG1vZGVsIEkgd2lsbCB1c2UgaXMgYSBzaW1wbGUgbGluZWFyIHJlZ3Jlc3Npb24uIEluIHBsYWluIGVuZ2xpc2gsIGZ1ZWwgZWNvbm9teSAoTVBHKSBpcyBhIGZ1bmN0aW9uIG9mIGl0cyB3ZWlnaHQoTGJzKS4gIA0KJE1QRyA9IGYoV2VpZ2h0KSQgIA0KQSBjYXIncyBmdWVsIGVjb25vbXkgaW4gbWlsZXMgcGVyIGdhbGxvbiBkZXBlbmRzIG9uIGl0cyB3ZWlnaHQgaW4gcG91bmRzLiANCg0KKipUSEUgREFUQToqKiAgDQoiVGhlIGRhdGEgd2FzIGV4dHJhY3RlZCBmcm9tIHRoZSAxOTc0IE1vdG9yIFRyZW5kIFVTIG1hZ2F6aW5lLCBhbmQgY29tcHJpc2VzIGZ1ZWwgY29uc3VtcHRpb24gYW5kIDEwIGFzcGVjdHMgb2YgYXV0b21vYmlsZSBkZXNpZ24gYW5kIHBlcmZvcm1hbmNlIGZvciAzMiBhdXRvbW9iaWxlcyAoMTk3M+KAkzc0IG1vZGVscykuIiAgDQotSGVuZGVyc29uIGFuZCBWZWxsZW1hbiAoMTk4MSksIEJ1aWxkaW5nIG11bHRpcGxlIHJlZ3Jlc3Npb24gbW9kZWxzIGludGVyYWN0aXZlbHkuIEJpb21ldHJpY3MsIDM3LCAzOTHigJM0MTEuIA0KDQpWYXJpYWJsZSBOYW1lIHwgV2hhdCBpdCBpcw0KLS0tLS0tLS0tLS0tLS18LS0tLS0tLS0tLS0tDQptcGcgfAlNaWxlcy8oVVMpIGdhbGxvbiANCmN5bCB8CU51bWJlciBvZiBjeWxpbmRlcnMgIA0KZGlzcCB8CURpc3BsYWNlbWVudCAoY3UuaW4uKSAgDQpocCB8CUdyb3NzIGhvcnNlcG93ZXIgIA0KZHJhdCB8CVJlYXIgYXhsZSByYXRpbyAgDQp3dCB8CVdlaWdodCAoMTAwMCBsYnMpICANCnFzZWMgfAkxLzQgbWlsZSB0aW1lICANCnZzIHwJRW5naW5lICgwID0gVi1zaGFwZWQsIDEgPSBzdHJhaWdodCkgIA0KYW0gfAlUcmFuc21pc3Npb24gKDAgPSBhdXRvbWF0aWMsIDEgPSBtYW51YWwpDQpnZWFyIHwJTnVtYmVyIG9mIGZvcndhcmQgZ2VhcnMgIA0KY2FyYiB8CU51bWJlciBvZiBjYXJidXJldG9ycyAgICAgDQoNCg0KKipDT1JSRUxBVElPTiBBTkQgUkVHUkVTU0lPTjoqKiAgDQoxLiBJbXBvcnQgdGhlIERhdGENCmBgYHtyfQ0KI2ltcG9ydCBhIGNvcHkgb2YgdGhlIG10Y2FycyBkYXRhc2V0IGZyb20gYSBDU1YgYW5kIHN0b3JlIGl0IGluIGEgdmFpcmFibGUgbmFtZWQgbXRjYXJzLg0KbXRjYXJzIDwtIHJlYWQuY3N2KCJ+L210Q2Fycy9tdGNhcnMuY3N2IikNCmBgYCAgDQoNCihSIGhhcyBtdGNhcnMgcHJlbG9hZGVkIGJ1dCB0aGlzIHdpbGwgYmUgbW9yZSByZWFsaXN0aWMpDQoNCjIuIFBsb3QgdGhlIERhdGENCmBgYHtyfQ0KI3Bsb3QgdGhlIGNhcnMgd2VpZ2h0IG9uIHRoZSB4LWF4aXMsIHRoZWlyIG1wZyBvbiB0aGUgeS1heGlzLCAgDQojYWRkaXRpb25hbGx5IGxhYmVsIHRoZSB4IGFuZCB5IGF4aXMsIGZpbmFsbHkgZ2l2ZSB0aGUgcGxvdCBhIG1haW4gdGl0bGUuDQpwbG90KG10Y2FycyR3dCwgbXRjYXJzJG1wZywgDQogICAgIHhsYWIgPSAiV2VpZ2h0ICgxMDAwIGxicykiLCAgIA0KICAgICB5bGFiID0gIk1pbGVzLyhVUykgZ2FsbG9uIiwgICANCiAgICAgbWFpbiA9ICJNaWxlcyBwZXIgR2FsbG9uIGJ5IFdlaWdodCIpDQpgYGANCg0KSXQgc3VyZSBsb29rcyBsaWtlIHRoZXJlIGlzIGEgY29ycmVsYXRpb24gd2hlcmUgaGVhdmllciBjYXJzIGhhdmUgd29yc2UgZnVlbCBlY29ub215Lg0KICANCjMuIFRoZSBsaW5lYXIgbW9kZWwNCmBgYHtyfQ0KI0kgbmVlZCB0aGUgc3RhdHMgcGFja2FnZSBmb3IgdGhlIGxpbmVhciBtb2RlbCBjYWxsLg0KI01ha2Ugc3VyZSB5b3UgZG93bmxvYWQgdGhlIHBhY2thZ2UsDQojdGhlbiB5b3UgY2FuIGNhbGwgaXQgZnJvbSB5b3VyIGxpYnJhcnkuDQpsaWJyYXJ5KHN0YXRzKQ0KDQojbXlMaW5lYXJNb2RlbCBnZXRzIHRoZSBsaW5lYXIgbW9kZWwgb2YgbXBnIGFzIGEgZnVuY3Rpb24gb2Ygd2VpZ2h0IHVzaW5nIGRhdGEgZnJvbSBtdGNhcnMuIA0KbXlMaW5lYXJNb2RlbCA8LSBsbShmb3JtdWxhID0gbXBnIH4gd3QsIGRhdGEgPSBtdGNhcnMpDQoNCiNzaG93IG1lIHRoZSBzdW1tYXJ5IG9mIG15IG1vZGVsDQpzdW1tYXJ5KG15TGluZWFyTW9kZWwpDQpgYGANCg0KNC4gUGxvdCB0aGUgbW9kZWwgYW5kIHRoZSByZWdyZXNzaW9uIGxpbmUgb24gdG9wIG9mIGl0Lg0KYGBge3J9DQojcGxvdCBtcGcgYXMgYSBmdW5jdGlvbiBvZiB3ZWlnaHQgdGhlbiBwdXQgdGhlIHJlZ3Jlc3Npb24gbGluZSBvdmVyIGl0Lg0KcGxvdChtdGNhcnMkbXBnIH4gbXRjYXJzJHd0LCANCiAgICAgeGxhYiA9ICJXZWlnaHQgKDEwMDAgbGJzKSIsICAgDQogICAgIHlsYWIgPSAiTWlsZXMvKFVTKSBnYWxsb24iLCAgIA0KICAgICBtYWluID0gIk1pbGVzIHBlciBHYWxsb24gYnkgV2VpZ2h0IikgIA0KICBhYmxpbmUobXlMaW5lYXJNb2RlbCwgY29sID0gInJlZCIpDQpgYGANCg0K