Effect of Birth Control on Attractivness
author: Michael A. Erickson date: 17 May 2015
Introduction
Read in the Data
desc
For collaborating, I suppose it is good to figure out how to deal with SPSS files. They can be accessed via .csv files, but then a lot of the information about variables is lost.
I have used the foreign library in the past, but it looks like memisc is actually really well set up to do this and to do and report regression analyses.
## read.spss() is from the foreign library -- note the errors
## rto.raw <- read.spss("../TRAUMA_FEB_25_2014_final merge_Edman_WATSON.sav", to.data.frame=TRUE, use.value.labels=TRUE)
## rm(rto.raw)
## spss.system.file() is from the memisc library
## "aumer data mate selction 1a.sav"
## "AUMER DATA MATE SELECTION.sav"
## "AUMER DATA MATE SELECTION.sav 23.sav"
## mbc <- spss.system.file("aumer data mate selction 1a.sav")
mbc <- spss.system.file("AUMER DATA MATE SELECTION.sav")
mbc.ds <- as.data.set(mbc)
mbc.df <- as.data.frame(mbc.ds)Need to make data matrices. As far as I can tell, the data for unattractive white males has no bc in the 2nd column and injection in the third. That’s the opposite of the others, so I swap those two.
attr <- apply(mbc.df[,seq(201, 260, 5)], 2, as.numeric); attr <- attr[,c(1,3,2,4:12)]
date <- apply(mbc.df[,seq(202, 260, 5)], 2, as.numeric); date <- date[,c(1,3,2,4:12)]
father <- apply(mbc.df[,seq(203, 260, 5)], 2, as.numeric); attr <- father[,c(1,3,2,4:12)]
strel <- apply(mbc.df[,seq(204, 260, 5)], 2, as.numeric); strel <- strel[,c(1,3,2,4:12)]
ltrel <- apply(mbc.df[,seq(205, 260, 5)], 2, as.numeric); ltrel <- ltrel[,c(1,3,2,4:12)]
conds <- c("UA.W.Condom", "UA.W.Inj", "UA.W.None", "A.W.Condom", "A.W.Inj", "A.W.None",
"UA.B.Condom", "UA.B.Inj", "UA.B.None", "A.B.Condom", "A.B.Inj", "A.B.None")
colnames(attr) <- conds
colnames(date) <- conds
colnames(father) <- conds
colnames(strel) <- conds
colnames(ltrel) <- condsGet error bar info
(attr.mcl <- apply(attr, 2, smean.cl.normal))## UA.W.Condom UA.W.Inj UA.W.None A.W.Condom A.W.Inj A.W.None UA.B.Condom UA.B.Inj UA.B.None
## Mean 4.819277 4.447761 4.349206 5.213333 4.671429 3.830189 4.654545 4.218182 3.913043
## Lower 4.474625 4.035467 3.922099 4.846037 4.313544 3.402031 4.250817 3.840529 3.489237
## Upper 5.163929 4.860055 4.776314 5.580630 5.029313 4.258347 5.058273 4.595835 4.336850
## A.B.Condom A.B.Inj A.B.None
## Mean 5.189655 4.491228 4.234043
## Lower 4.800414 4.096005 3.791661
## Upper 5.578896 4.886451 4.676424(date.mcl <- apply(date, 2, smean.cl.normal))## UA.W.Condom UA.W.Inj UA.W.None A.W.Condom A.W.Inj A.W.None UA.B.Condom UA.B.Inj UA.B.None
## Mean 3.784615 3.980000 3.688889 5.333333 4.321429 3.566667 3.733333 4.107143 3.350000
## Lower 3.343328 3.452237 3.232260 4.858343 3.807931 2.956766 3.253601 3.535506 2.683355
## Upper 4.225903 4.507763 4.145518 5.808323 4.834926 4.176568 4.213066 4.678780 4.016645
## A.B.Condom A.B.Inj A.B.None
## Mean 4.500000 4.321429 3.400000
## Lower 3.881376 3.490088 2.804204
## Upper 5.118624 5.152769 3.995796(father.mcl <- apply(father, 2, smean.cl.normal))## UA.W.Condom UA.W.Inj UA.W.None A.W.Condom A.W.Inj A.W.None UA.B.Condom UA.B.Inj UA.B.None
## Mean 4.819277 4.349206 4.447761 5.213333 4.671429 3.830189 4.654545 4.218182 3.913043
## Lower 4.474625 3.922099 4.035467 4.846037 4.313544 3.402031 4.250817 3.840529 3.489237
## Upper 5.163929 4.776314 4.860055 5.580630 5.029313 4.258347 5.058273 4.595835 4.336850
## A.B.Condom A.B.Inj A.B.None
## Mean 5.189655 4.491228 4.234043
## Lower 4.800414 4.096005 3.791661
## Upper 5.578896 4.886451 4.676424(strel.mcl <- apply(strel, 2, smean.cl.normal))## UA.W.Condom UA.W.Inj UA.W.None A.W.Condom A.W.Inj A.W.None UA.B.Condom UA.B.Inj UA.B.None
## Mean 3.416667 3.586207 3.150000 5.000000 3.906250 2.800000 2.941176 3.529412 3.111111
## Lower 2.848334 2.963521 2.518888 4.371096 3.138099 2.068912 2.352966 2.655397 1.929983
## Upper 3.984999 4.208892 3.781112 5.628904 4.674401 3.531088 3.529387 4.403427 4.292239
## A.B.Condom A.B.Inj A.B.None
## Mean 3.807692 3.812500 3.750000
## Lower 3.041166 2.778898 1.976532
## Upper 4.574219 4.846102 5.523468(ltrel.mcl <- apply(ltrel, 2, smean.cl.normal))## UA.W.Condom UA.W.Inj UA.W.None A.W.Condom A.W.Inj A.W.None UA.B.Condom UA.B.Inj UA.B.None
## Mean 4.000000 3.558824 3.166667 5.224138 3.954545 3.210526 3.136364 3.391304 3.076923
## Lower 3.360919 2.968745 2.594176 4.604959 3.383105 2.447106 2.519945 2.645276 2.318077
## Upper 4.639081 4.148902 3.739157 5.843317 4.525986 3.973947 3.752783 4.137333 3.835769
## A.B.Condom A.B.Inj A.B.None
## Mean 4.000000 3.761905 3.333333
## Lower 3.140933 2.819039 2.024653
## Upper 4.859067 4.704770 4.642014rplot <- function(data, label) {
barplot(matrix(data["Mean",], ncol=4), col=c("red", "blue", "green"), beside=TRUE, ylim=c(0, 7),
names.arg=c("Unattr. White", "Attr. White", "Unattr. Black", "Attr. Black"), legend.text=c("Condom", "Injection", "No Birth Ctrl."),
args.legend=list(x="topleft", bty="n"), ylab=label)
arrows(x0=1:3 + rep(seq(0.5, 12.5, by=4), each=3), y0=data["Lower",], y1=data["Upper",], angle=90, code=3, length=.1)
}
rplot(attr.mcl, "Attractivness")
rplot(date.mcl, "Would Date")
rplot(father.mcl, "Good Father")
rplot(strel.mcl, "Short-Term Relationship")
rplot(ltrel.mcl, "Long-Term Relationship")
A lot of Ss did not respond for all 12 faces. That seems problematic. The trick is that attractiveness and race are unrelated to the main hypotheses, so if neither interacts with the effect of condom use, I can average over those factors.
mkbc <- function(data) {
res <- cbind(apply(data[,seq(1, 12, 3)], 1, mean, na.rm=TRUE),
apply(data[,seq(2, 12, 3)], 1, mean, na.rm=TRUE),
apply(data[,seq(3, 12, 3)], 1, mean, na.rm=TRUE))
res <- res[apply(res, 1, function(x) all(!is.na(x))),]
colnames(res) <- c("Condom", "Injection", "None")
return(res)
}
attr.bc <- mkbc(attr)
date.bc <- mkbc(date)
father.bc <- mkbc(father)
strel.bc <- mkbc(strel)
ltrel.bc <- mkbc(ltrel)
apply(attr.bc, 2, smean.cl.normal, na.rm=TRUE)## Condom Injection None
## Mean 5.008706 4.557214 4.088308
## Lower 4.715314 4.231850 3.721509
## Upper 5.302098 4.882578 4.455108apply(attr.bc, 2, nmean.sd, na.rm=TRUE)## Condom Injection None
## n 67.000000 67.000000 67.000000
## mean 5.008706 4.557214 4.088308
## sd 1.202825 1.333902 1.503775apply(date.bc, 2, smean.cl.normal, na.rm=TRUE)## Condom Injection None
## Mean 4.655556 4.070370 3.544444
## Lower 4.245919 3.639370 3.154221
## Upper 5.065192 4.501371 3.934668apply(date.bc, 2, nmean.sd, na.rm=TRUE)## Condom Injection None
## n 45.000000 45.000000 45.000000
## mean 4.655556 4.070370 3.544444
## sd 1.363485 1.434596 1.298868apply(father.bc, 2, smean.cl.normal, na.rm=TRUE)## Condom Injection None
## Mean 5.053241 4.475694 4.103009
## Lower 4.751777 4.142860 3.748137
## Upper 5.354704 4.808529 4.457882apply(father.bc, 2, nmean.sd, na.rm=TRUE)## Condom Injection None
## n 72.000000 72.000000 72.000000
## mean 5.053241 4.475694 4.103009
## sd 1.282886 1.416386 1.510170apply(strel.bc, 2, smean.cl.normal, na.rm=TRUE)## Condom Injection None
## Mean 4.047619 3.686508 2.976190
## Lower 3.445385 2.950385 2.411877
## Upper 4.649853 4.422631 3.540504apply(strel.bc, 2, nmean.sd, na.rm=TRUE)## Condom Injection None
## n 21.000000 21.000000 21.00000
## mean 4.047619 3.686508 2.97619
## sd 1.323026 1.617162 1.23972apply(ltrel.bc, 2, smean.cl.normal, na.rm=TRUE)## Condom Injection None
## Mean 4.505376 3.881720 3.026882
## Lower 3.876909 3.321988 2.535816
## Upper 5.133844 4.441453 3.517947apply(ltrel.bc, 2, nmean.sd, na.rm=TRUE)## Condom Injection None
## n 31.000000 31.000000 31.000000
## mean 4.505376 3.881720 3.026882
## sd 1.713365 1.525975 1.338771At this point, it’s most straightforward to use Rosenthal’s Contrast Analysis to test the two hypotheses.
- Hypothesis 1 is that women will prefer men who use birth control to men who do not (with “prefer” measured using 5 different questions), and
- Hypothesis 2 is that women with prefer men who use condoms to men who use injection.
test.h1 <- function(data) {
bc.v.nobc <- data %*% c(.5, .5, -1)
print(t.test(bc.v.nobc, alt="greater"))
smean.cl.normal(bc.v.nobc)
}
test.h1(attr.bc)##
## One Sample t-test
##
## data: bc.v.nobc
## t = 5.5392, df = 66, p-value = 2.846e-07
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.4854411 Inf
## sample estimates:
## mean of x
## 0.6946517## Mean Lower Upper
## 0.6946517 0.4442711 0.9450324test.h1(date.bc)##
## One Sample t-test
##
## data: bc.v.nobc
## t = 3.8777, df = 44, p-value = 0.0001741
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.4638469 Inf
## sample estimates:
## mean of x
## 0.8185185## Mean Lower Upper
## 0.8185185 0.3931043 1.2439327test.h1(father.bc)##
## One Sample t-test
##
## data: bc.v.nobc
## t = 4.7314, df = 71, p-value = 5.513e-06
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.4284632 Inf
## sample estimates:
## mean of x
## 0.6614583## Mean Lower Upper
## 0.6614583 0.3826997 0.9402170test.h1(strel.bc)##
## One Sample t-test
##
## data: bc.v.nobc
## t = 3.9181, df = 20, p-value = 0.000426
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.4987178 Inf
## sample estimates:
## mean of x
## 0.890873## Mean Lower Upper
## 0.8908730 0.4165802 1.3651658test.h1(ltrel.bc)##
## One Sample t-test
##
## data: bc.v.nobc
## t = 5.8032, df = 30, p-value = 1.21e-06
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.8254542 Inf
## sample estimates:
## mean of x
## 1.166667## Mean Lower Upper
## 1.1666667 0.7560941 1.5772392test.h2 <- function(data) {
c.v.i <- data %*% c(1, -1, 0)
print(t.test(c.v.i, alt="greater"))
smean.cl.normal(c.v.i)
}
test.h2(attr.bc)##
## One Sample t-test
##
## data: c.v.i
## t = 4.1701, df = 66, p-value = 4.535e-05
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.2708707 Inf
## sample estimates:
## mean of x
## 0.4514925## Mean Lower Upper
## 0.4514925 0.2353266 0.6676585test.h2(date.bc)##
## One Sample t-test
##
## data: c.v.i
## t = 2.7624, df = 44, p-value = 0.004171
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.2292469 Inf
## sample estimates:
## mean of x
## 0.5851852## Mean Lower Upper
## 0.5851852 0.1582517 1.0121186test.h2(father.bc)##
## One Sample t-test
##
## data: c.v.i
## t = 4.4242, df = 71, p-value = 1.71e-05
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.3599838 Inf
## sample estimates:
## mean of x
## 0.5775463## Mean Lower Upper
## 0.5775463 0.3172515 0.8378411test.h2(strel.bc)##
## One Sample t-test
##
## data: c.v.i
## t = 1.3418, df = 20, p-value = 0.09735
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## -0.1030646 Inf
## sample estimates:
## mean of x
## 0.3611111## Mean Lower Upper
## 0.3611111 -0.2002869 0.9225092test.h2(ltrel.bc)##
## One Sample t-test
##
## data: c.v.i
## t = 2.1359, df = 30, p-value = 0.02048
## alternative hypothesis: true mean is greater than 0
## 95 percent confidence interval:
## 0.1280734 Inf
## sample estimates:
## mean of x
## 0.6236559## Mean Lower Upper
## 0.62365591 0.02733359 1.21997824Both hypotheses are supported for all preference ratings except for short-term relationships. In that case, there is no evidence for a preference for condoms over injections as a method of birth control.