Residuals seem to be spread evenly.
#LMR 8.9
library("faraway")
data(fat, package="faraway")
lmod<-lm(brozek ~ age + weight + height + neck + chest + abdom + hip + thigh + knee + ankle + biceps + forearm + wrist, data = fat)
lmod$coefficients
## (Intercept) age weight height neck
## -15.29254907 0.05678616 -0.08030986 -0.06460028 -0.43754090
## chest abdom hip thigh knee
## -0.02360333 0.88542903 -0.19841862 0.23189542 -0.01167679
## ankle biceps forearm wrist
## 0.16353590 0.15279894 0.43048875 -1.47653692
plot(lmod$residuals)
lmod1<-lm(brozek ~ age + weight + height + neck + chest + abdom + hip + thigh + knee + ankle + biceps + forearm + wrist, data = fat, weights = 1/log(brozek))
lmod1$coefficients
## (Intercept) age weight height neck
## -11.57021007 0.06731935 -0.05456684 -0.05061930 -0.50778483
## chest abdom hip thigh knee
## -0.06666509 0.90256434 -0.25096554 0.27018430 -0.01212306
## ankle biceps forearm wrist
## 0.08372821 0.20344468 0.40589473 -1.52267735
plot(lmod1$residuals)
lmod1<-lm(brozek ~ age + weight + height + neck + chest + abdom + hip + thigh + knee + ankle + biceps + forearm + offset(wrist), data = fat,weights = var(brozek)/log(brozek))
lmod1$coefficients
## (Intercept) age weight height neck
## -25.73046649 0.01925203 -0.08721831 -0.09332275 -0.84578140
## chest abdom hip thigh knee
## -0.05946130 0.96161925 -0.27206495 0.32325594 -0.11575195
## ankle biceps forearm
## -0.15375969 0.17309938 0.23888793
plot(lmod1$residuals)
All x values and confidence levels remain the same, but sum of y coefficients change.
x <-model.matrix(lmod)
x_ <-model.matrix(lmod1)
(x0 <- apply(x,2,median))
## (Intercept) age weight height neck chest
## 1.00 43.00 176.50 70.00 38.00 99.65
## abdom hip thigh knee ankle biceps
## 90.95 99.30 59.00 38.50 22.80 32.05
## forearm wrist
## 28.70 18.30
(x_0 <- apply(x_,2,median))
## (Intercept) age weight height neck chest
## 1.00 43.00 176.50 70.00 38.00 99.65
## abdom hip thigh knee ankle biceps
## 90.95 99.30 59.00 38.50 22.80 32.05
## forearm
## 28.70
(x1 <- apply(x,2,function(x) quantile(x,0.95)))
## (Intercept) age weight height neck chest
## 1.000 67.000 225.650 74.500 41.845 116.340
## abdom hip thigh knee ankle biceps
## 110.760 112.125 68.545 42.645 25.445 37.200
## forearm wrist
## 31.745 19.800
(x_1 <- apply(x_,2,function(x_) quantile(x_,0.95)))
## (Intercept) age weight height neck chest
## 1.000 67.000 225.650 74.500 41.845 116.340
## abdom hip thigh knee ankle biceps
## 110.760 112.125 68.545 42.645 25.445 37.200
## forearm
## 31.745
(y0 <- sum(x0*coef(lmod)))
## [1] 17.49322
(y_0 <- sum(x_0*coef(lmod1)))
## [1] -0.9371959
anova(lmod,lmod1)
## Analysis of Variance Table
##
## Model 1: brozek ~ age + weight + height + neck + chest + abdom + hip +
## thigh + knee + ankle + biceps + forearm + wrist
## Model 2: brozek ~ age + weight + height + neck + chest + abdom + hip +
## thigh + knee + ankle + biceps + forearm + offset(wrist)
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 238 3785
## 2 238 93233 0 -89448