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.
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)
- 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.
- 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
- 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