{"id":650,"date":"2014-08-09T15:18:25","date_gmt":"2014-08-09T19:18:25","guid":{"rendered":"http:\/\/www.clayford.net\/statistics\/?p=650"},"modified":"2020-09-13T10:18:01","modified_gmt":"2020-09-13T14:18:01","slug":"partial-residuals-and-the-termplot-function","status":"publish","type":"post","link":"https:\/\/www.clayford.net\/statistics\/partial-residuals-and-the-termplot-function\/","title":{"rendered":"Partial Residuals and the termplot function"},"content":{"rendered":"

Earlier this year I taught an Intro to R Graphics workshop<\/a>. While preparing for it I came across the termplot<\/code> function. I had no idea it existed. Of course now that I know about it, I come across it fairly regularly. (That's the Baader-Meinhof Phenomenon<\/a> for you.)<\/p>\n

?termplot<\/code> will tell you what it does: “Plots regression terms against their predictors, optionally with standard errors and partial residuals added.” If you read on, you'll see “Nothing sensible happens for interaction terms, and they may cause errors.” Duly noted.<\/p>\n

Let's try this out and see what it does. <\/p>\n

First we'll fit a model using the mtcars<\/code> dataset that comes with R. Below mpg<\/code> = Miles\/(US) gallon, drat<\/code> = Rear axle ratio, qsec<\/code> = ¼ mile time, disp<\/code> = Displacement (cu.in.), and wt<\/code> = Weight (lb\/1000). <\/p>\n

lm.cars <- lm(mpg ~ wt + disp + drat + qsec, data=mtcars)\r\nsummary(lm.cars)\r\n<\/code><\/pre>\n
## \r\n## Call:\r\n## lm(formula = mpg ~ wt + disp + drat + qsec, data = mtcars)\r\n## \r\n## Residuals:\r\n##    Min     1Q Median     3Q    Max \r\n## -4.143 -1.933 -0.149  0.919  5.541 \r\n## \r\n## Coefficients:\r\n##             Estimate Std. Error t value Pr(>|t|)    \r\n## (Intercept)  9.03223    9.58829    0.94  0.35454    \r\n## wt          -4.86768    1.20872   -4.03  0.00041 ***\r\n## disp         0.00522    0.01105    0.47  0.64021    \r\n## drat         1.87086    1.32462    1.41  0.16926    \r\n## qsec         1.05248    0.34778    3.03  0.00539 ** \r\n## ---\r\n## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\r\n## \r\n## Residual standard error: 2.6 on 27 degrees of freedom\r\n## Multiple R-squared:  0.838,  Adjusted R-squared:  0.814 \r\n## F-statistic:   35 on 4 and 27 DF,  p-value: 2.55e-10\r\n<\/pre>\n
par(mfrow=c(2,2))\r\ntermplot(lm.cars)\r\n<\/code><\/pre>\n
\"plot <\/p>\n
Compare the coefficients in the summary output to the slopes of the lines in the graphs. See how the coefficients match the slopes of the lines? That's because they are<\/em> the slopes of the lines. For example, wt<\/code> has a coefficient of about -5. Likewise the termplot for that coefficient has a negative slope that appears to be about -5. Using these plots we can see at a glance the respective contributions of the predictors. wt<\/code> and qsec<\/code> seem to contribute to the model due to the steepness of their slopes, but disp<\/code> and drat<\/code> not so much. This matches the summary output that shows wt<\/code> and qsec<\/code> as being significant. <\/p>\n
Now termplot<\/code> also has an argument called partial.resid<\/code> that will add partial residuals if set to TRUE. Let's try that out, with color set to “purple” since the default gray can be hard to see (at least to my eyes):<\/p>\n
par(mfrow=c(2,2))\r\ntermplot(lm.cars, partial.resid=TRUE, col.res = "purple")\r\n<\/code><\/pre>\n
\"plot <\/p>\n
How are these points generated? The x-axis is clear enough. That's just the predictor values. But the y-axis says “Partial for [variable name]”, i.e. partial residuals. What does that mean? Put as simply as possible,  partial residuals are the sum of the residuals and predictor terms. Hopefully you know what residuals are. Those are just the difference between the observed and fitted response values. “Predictor terms” is a little trickier.<\/p>\n
To understand them, it helps to know that <\/p>\n
\\[y = \\bar{y} + b_{1}(x_{1} – \\bar{x}_{1}) + b_{2}(x_{2} – \\bar{x}_{2}) + b_{3}(x_{3} – \\bar{x}_{3}) + b_{4}(x_{4} – \\bar{x}_{4}) + e\\]<\/p>\n
is another way of writing<\/p>\n
\\[y = b_{0} + b_{1}x_{1} + b_{2}x_{2}+ b_{3}x_{3}+ b_{4}x_{4} + e\\]<\/p>\n
So the first equation above has \\(\\bar{y}\\) as the intercept and centered predictors. If we center the predictors and fit a model, we'll see that's precisely what we get:<\/p>\n
# center the variables\r\nmtcars <- transform(mtcars, wtC = wt-mean(wt), dispC = disp-mean(disp),\r\n                    dratC=drat-mean(drat), qsecC=qsec-mean(qsec))\r\n# now fit model using centered predictors\r\nlm.terms.cars <- lm(mpg ~ wtC + dispC + dratC + qsecC, data=mtcars)\r\ncoef(lm.terms.cars)[1]\r\n<\/code><\/pre>\n
## (Intercept) \r\n##       20.09\r\n<\/pre>\n
mean(mtcars$mpg)\r\n<\/code><\/pre>\n
## [1] 20.09\r\n<\/pre>\n
Now if we take the centered predictor values and multiply them by their respective coefficients, we get what are referred to in R as terms<\/em>. For example, the terms for the first record in the data set are as follows:<\/p>\n
# take all coefficients but the intercept...\r\ncoef(lm.terms.cars)[-1]\r\n<\/code><\/pre>\n
##       wtC     dispC     dratC     qsecC \r\n## -4.867682  0.005222  1.870855  1.052478\r\n<\/pre>\n
# ...and first record of data...\r\nlm.terms.cars$model[1,-1]\r\n<\/code><\/pre>\n
##               wtC  dispC  dratC  qsecC\r\n## Mazda RX4 -0.5972 -70.72 0.3034 -1.389\r\n<\/pre>\n
# ...and multiply:\r\ncoef(lm.terms.cars)[-1]*t(lm.terms.cars$model[1,-1])\r\n<\/code><\/pre>\n
##       Mazda RX4\r\n## wtC      2.9072\r\n## dispC   -0.3693\r\n## dratC    0.5677\r\n## qsecC   -1.4616\r\n<\/pre>\n
So for the first record, the term due to wt<\/code> is 2.91, the term due to disp<\/code> is -0.37, and so on. These are the predictor terms I mentioned earlier. These are what we add to the residuals to make partial residuals<\/em>. <\/p>\n
You'll be happy to know we don't have to center predictors and fit a new model to extract terms. R can do that for us on the original model object when you specify type="terms"<\/code> with the predict<\/code> function, like so:<\/p>\n
# notice we're calling this on the original model object, lm.cars\r\npterms <- predict(lm.cars, type="terms")\r\npterms[1,] # compare to above; the same\r\n<\/code><\/pre>\n
##      wt    disp    drat    qsec \r\n##  2.9072 -0.3693  0.5677 -1.4616\r\n<\/pre>\n
To calculate the partial residuals ourselves and make our own partial residual plots, we can do this:<\/p>\n
# add residuals to each column of pterms (i.e., the terms for each predictor)\r\npartial.residuals <- apply(pterms,2,function(x)x+resid(lm.cars))\r\n# create our own termplot of partial residuals\r\npar(mfrow=c(2,2))\r\n# the model in lm.cars includes the response in first column, so we index with i + 1\r\nfor(i in 1:4){\r\n  plot(x=lm.cars$model[,(i+1)],y=partial.residuals[,i], col="purple", ylim=c(-10,10))\r\n  abline(lm(partial.residuals[,i] ~ lm.cars$model[,(i+1)]), col="red")\r\n}\r\n<\/code><\/pre>\n
\"plot <\/p>\n
So that's what termplot does for us: it takes the terms for each predictor, adds the residuals to the terms to create partial residuals, and then plots partial residuals versus their respective predictor, (if you specify partial.resid=TRUE<\/code>). And of course it plots a fitted line, the result of regressing the predictor's partial residuals on itself. Recall ealier I mentioned the slope of the line in the termplot graphs is the coefficient in the summary output. We can indeed verify that:<\/p>\n
# coefficient for wt\r\ncoef(lm.cars)[2]\r\n<\/code><\/pre>\n
##     wt \r\n## -4.868\r\n<\/pre>\n
coef(lm(partial.residuals[,1] ~ mtcars$wt))[2]\r\n<\/code><\/pre>\n
## mtcars$wt \r\n##    -4.868\r\n<\/pre>\n
Ultimately what this whole partial residual\/termplot thing is doing is splitting the response value<\/em> into different parts: an overall mean, a term that is due to wt<\/code>, a term that is due to disp<\/code>, a term that is due to drat<\/code>, and a term that is due to qsec<\/code>. And you have the residual. So when we create the partial residual for wt<\/code>, what we're doing is adding the wt<\/code> term and the residual. This sum accounts for the part of the response not explained by the other terms<\/em>.<\/p>\n
Again let's look at the overall mean, the terms for the first observation and its residual:<\/p>\n
# overall mean of response\r\nmean(mtcars$mpg)\r\n<\/code><\/pre>\n
## [1] 20.09\r\n<\/pre>\n
# terms of first observation\r\npterms[1,]\r\n<\/code><\/pre>\n
##      wt    disp    drat    qsec \r\n##  2.9072 -0.3693  0.5677 -1.4616\r\n<\/pre>\n
# the residual of the first observation\r\nresid(lm.cars)[1]\r\n<\/code><\/pre>\n
## Mazda RX4 \r\n##   -0.7346\r\n<\/pre>\n
If we add those up, we get the observed value<\/p>\n
# add overall mean, terms and residual for first observation\r\nmean(mtcars$mpg) + sum(pterms[1,]) + resid(lm.cars)[1]\r\n<\/code><\/pre>\n
## Mazda RX4 \r\n##        21\r\n<\/pre>\n
# same as observed in data\r\nmtcars$mpg[1]\r\n<\/code><\/pre>\n
## [1] 21\r\n<\/pre>\n
So the wt<\/code> term value of 2.9072 represents the part of the response that is not explained by the other terms.<\/p>\n
Finally, we can add another argument to termplot<\/code>, smooth=panel.smooth<\/code> that will draw a smooth lowess line through the points. This can help us assess departures from linearity.<\/p>\n
par(mfrow=c(2,2))\r\ntermplot(lm.cars, partial.resid=TRUE, col.res = "purple", smooth=panel.smooth)\r\n<\/code><\/pre>\n
\"plot <\/p>\n
Notice how the dashed line bends around the straight line for wt<\/code>. Perhaps wt<\/code> requires a quadratic term? Let's try that using the poly<\/code> function, which creates orthogonal polynomials.<\/p>\n
lm.cars2 <- lm(mpg ~ poly(wt,2) + disp + drat + qsec, data=mtcars)\r\npar(mfrow=c(2,2))\r\ntermplot(lm.cars2, partial.resid=TRUE, col.res = "purple", smooth=panel.smooth)\r\n<\/code><\/pre>\n
\"plot <\/p>\n
We now see a better fit with the regressed line matching closely to the smooth line.<\/p>\n","protected":false},"excerpt":{"rendered":"
Earlier this year I taught an Intro to R Graphics workshop. While preparing for it I came across the termplot… Read more<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[12,13],"tags":[43,42],"class_list":["post-650","post","type-post","status-publish","format-standard","hentry","category-regression","category-using-r","tag-partial-residuals","tag-termplot"],"_links":{"self":[{"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/posts\/650","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/comments?post=650"}],"version-history":[{"count":5,"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/posts\/650\/revisions"}],"predecessor-version":[{"id":691,"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/posts\/650\/revisions\/691"}],"wp:attachment":[{"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/media?parent=650"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/categories?post=650"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.clayford.net\/statistics\/wp-json\/wp\/v2\/tags?post=650"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}