Regression, Confidence Interval and Prediction Interval with Bodyfat Data

Bodyfat data description

Lists estimates of the percentage of body fat determined by underwater weighing and various body circumference measurements for 252 men. Accurate measurement of body fat is inconvenient/costly and it is desirable to have easy methods of estimating body fat that are not inconvenient/costly.

Abdomen: abdomen circumference (cm)

Bodyfat: percent body fat from Siriโ€™s (1956) equation

library(plotly)
library(ggplot2)
library(BAS)
data(bodyfat)
summary(bodyfat)
##     Density         Bodyfat           Age            Weight     
##  Min.   :0.995   Min.   : 0.00   Min.   :22.00   Min.   :118.5  
##  1st Qu.:1.041   1st Qu.:12.47   1st Qu.:35.75   1st Qu.:159.0  
##  Median :1.055   Median :19.20   Median :43.00   Median :176.5  
##  Mean   :1.056   Mean   :19.15   Mean   :44.88   Mean   :178.9  
##  3rd Qu.:1.070   3rd Qu.:25.30   3rd Qu.:54.00   3rd Qu.:197.0  
##  Max.   :1.109   Max.   :47.50   Max.   :81.00   Max.   :363.1  
##      Height           Neck           Chest           Abdomen      
##  Min.   :29.50   Min.   :31.10   Min.   : 79.30   Min.   : 69.40  
##  1st Qu.:68.25   1st Qu.:36.40   1st Qu.: 94.35   1st Qu.: 84.58  
##  Median :70.00   Median :38.00   Median : 99.65   Median : 90.95  
##  Mean   :70.15   Mean   :37.99   Mean   :100.82   Mean   : 92.56  
##  3rd Qu.:72.25   3rd Qu.:39.42   3rd Qu.:105.38   3rd Qu.: 99.33  
##  Max.   :77.75   Max.   :51.20   Max.   :136.20   Max.   :148.10  
##       Hip            Thigh            Knee           Ankle     
##  Min.   : 85.0   Min.   :47.20   Min.   :33.00   Min.   :19.1  
##  1st Qu.: 95.5   1st Qu.:56.00   1st Qu.:36.98   1st Qu.:22.0  
##  Median : 99.3   Median :59.00   Median :38.50   Median :22.8  
##  Mean   : 99.9   Mean   :59.41   Mean   :38.59   Mean   :23.1  
##  3rd Qu.:103.5   3rd Qu.:62.35   3rd Qu.:39.92   3rd Qu.:24.0  
##  Max.   :147.7   Max.   :87.30   Max.   :49.10   Max.   :33.9  
##      Biceps         Forearm          Wrist      
##  Min.   :24.80   Min.   :21.00   Min.   :15.80  
##  1st Qu.:30.20   1st Qu.:27.30   1st Qu.:17.60  
##  Median :32.05   Median :28.70   Median :18.30  
##  Mean   :32.27   Mean   :28.66   Mean   :18.23  
##  3rd Qu.:34.33   3rd Qu.:30.00   3rd Qu.:18.80  
##  Max.   :45.00   Max.   :34.90   Max.   :21.40
x = bodyfat$Abdomen
y= bodyfat$Bodyfat
bodyfat.lm = lm(Bodyfat ~ Abdomen, data=bodyfat)

xnew <- seq(min(x), max(x), length.out = 100)
ynewc <- data.frame(predict(bodyfat.lm, newdata = data.frame(Abdomen = xnew),
                           interval = "confidence", level = 0.95))

ynewp <- data.frame(predict(bodyfat.lm, newdata = data.frame(Abdomen = xnew),
                           interval = "prediction", level = 0.95))


plot_ly(bodyfat,x=~Abdomen,y=~Bodyfat,mode="markers",type="scatter",color = I("red"),name="abdomen and bodyfat data")%>%
  layout(title="Abdomen and Bodyfat Regression with Prediction and Confidence Intervals")%>%
  add_trace(y=~ynewc$lwr,x=~xnew,color = I("blue"),name="lower confidence interval")%>%
  add_trace(y=~ynewc$upr,x=~xnew,color = I("green"),name="upper confidence interval")%>%
  add_lines(y=~ynewp$lwr,x=~xnew,color = I("orange"),name="lower prediction interval")%>%
  add_lines(y=~ynewp$upr,x=~xnew,color = I("purple"),name="upper prediction interval")