Researchers want to see if using financial incentives produces greater weight loss among dieters.
Load the data (You may need C:/Users instead of /Users below):
setwd("/Users/traves/Dropbox/SM339/day 08")
WL <- read.csv("WeightLossIncentive4.csv")
summary(WL)
## WeightLoss Group
## Min. :-17.00 Control :19
## 1st Qu.: 1.75 Incentive:17
## Median : 7.75
## Mean : 9.47
## 3rd Qu.: 18.62
## Max. : 30.00
head(WL)
## WeightLoss Group
## 1 12.5 Control
## 2 12.0 Control
## 3 1.0 Control
## 4 -5.0 Control
## 5 3.0 Control
## 6 -5.0 Control
Look at the data
attach(WL)
boxplot(WeightLoss ~ Group, main = "Boxplot of Weight Loss by Group", ylab = "Weight Loss in lbs")
It seems that the Incentive group lost more weight (on average) than the control group. Let's try to see if the extra weight lost is statistically significant.
CHOOSE:
We use a model
Y = \( \mu_i + \epsilon \)
where \( \mu_i \) is the population mean for the \( i \)-th group and \( \epsilon \) is normally distributed for each group \( \epsilon \~ N(0,\sigma_i) \).
Partition the WeightLoss data:
WLC = WeightLoss[which(Group == "Control")]
WLI = WeightLoss[which(Group == "Incentive")]
Get some statistics:
mean(WLC)
## [1] 3.921
mean(WLI)
## [1] 15.68
sd(WLC)
## [1] 9.108
sd(WLI)
## [1] 9.414
Plot the residuals for each group to check normality:
require(lattice)
## Loading required package: lattice
require(latticeExtra)
## Loading required package: latticeExtra
## Loading required package: RColorBrewer
densityplot(WLC - mean(WLC), col = "blue", main = "Control residuals")
densityplot(WLI - mean(WLI), col = "red", main = "Incentive residuals")
We could also check some QQ plots:
qqnorm(WLC - mean(WLC), col = "blue", pch = 19)
qqline(WLC - mean(WLC), col = "blue", lwd = 4)
qqnorm(WLI - mean(WLI), col = "red", pch = 19)
qqline(WLI - mean(WLI), col = "red", lwd = 4)
One-sided hypothesis test:
t.test(WeightLoss[which(Group == "Control")], WeightLoss[which(Group == "Incentive")],
conf.level = 0.95, alternative = "less")
##
## Welch Two Sample t-test
##
## data: WeightLoss[which(Group == "Control")] and WeightLoss[which(Group == "Incentive")]
## t = -3.798, df = 33.28, p-value = 0.0002944
## alternative hypothesis: true difference in means is less than 0
## 95 percent confidence interval:
## -Inf -6.519
## sample estimates:
## mean of x mean of y
## 3.921 15.676
Conclude that financial incentives do increase weight loss (at a 5% significance level, or even at a lower significance level since p<0.0003).