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)  <- conds

Get 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
## Mean     4.819277 4.447761  4.349206   5.213333 4.671429 3.830189
## Lower    4.474625 4.035467  3.922099   4.846037 4.313544 3.402031
## Upper    5.163929 4.860055  4.776314   5.580630 5.029313 4.258347
##       UA.B.Condom UA.B.Inj UA.B.None A.B.Condom  A.B.Inj A.B.None
## Mean     4.654545 4.218182  3.913043   5.189655 4.491228 4.234043
## Lower    4.250817 3.840529  3.489237   4.800414 4.096005 3.791661
## Upper    5.058273 4.595835  4.336850   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
## Mean     3.784615 3.980000  3.688889   5.333333 4.321429 3.566667
## Lower    3.343328 3.452237  3.232260   4.858343 3.807931 2.956766
## Upper    4.225903 4.507763  4.145518   5.808323 4.834926 4.176568
##       UA.B.Condom UA.B.Inj UA.B.None A.B.Condom  A.B.Inj A.B.None
## Mean     3.733333 4.107143  3.350000   4.500000 4.321429 3.400000
## Lower    3.253601 3.535506  2.683355   3.881376 3.490088 2.804204
## Upper    4.213066 4.678780  4.016645   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
## Mean     4.819277 4.349206  4.447761   5.213333 4.671429 3.830189
## Lower    4.474625 3.922099  4.035467   4.846037 4.313544 3.402031
## Upper    5.163929 4.776314  4.860055   5.580630 5.029313 4.258347
##       UA.B.Condom UA.B.Inj UA.B.None A.B.Condom  A.B.Inj A.B.None
## Mean     4.654545 4.218182  3.913043   5.189655 4.491228 4.234043
## Lower    4.250817 3.840529  3.489237   4.800414 4.096005 3.791661
## Upper    5.058273 4.595835  4.336850   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
## Mean     3.416667 3.586207  3.150000   5.000000 3.906250 2.800000
## Lower    2.848334 2.963521  2.518888   4.371096 3.138099 2.068912
## Upper    3.984999 4.208892  3.781112   5.628904 4.674401 3.531088
##       UA.B.Condom UA.B.Inj UA.B.None A.B.Condom  A.B.Inj A.B.None
## Mean     2.941176 3.529412  3.111111   3.807692 3.812500 3.750000
## Lower    2.352966 2.655397  1.929983   3.041166 2.778898 1.976532
## Upper    3.529387 4.403427  4.292239   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
## Mean     4.000000 3.558824  3.166667   5.224138 3.954545 3.210526
## Lower    3.360919 2.968745  2.594176   4.604959 3.383105 2.447106
## Upper    4.639081 4.148902  3.739157   5.843317 4.525986 3.973947
##       UA.B.Condom UA.B.Inj UA.B.None A.B.Condom  A.B.Inj A.B.None
## Mean     3.136364 3.391304  3.076923   4.000000 3.761905 3.333333
## Lower    2.519945 2.645276  2.318077   3.140933 2.819039 2.024653
## Upper    3.752783 4.137333  3.835769   4.859067 4.704770 4.642014
rplot <- 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")

dplot <- function(data, label) {  
  data.m  <- matrix(data["Mean",], ncol=4,
                    dimnames=list(c("Condom", "Injection", "None"),
                                  c("Unattr. White", "Attr. White", "Unattr. Black", "Attr. Black")))
  dotchart(data.m, xlim=c(2,7), xlab=label, pch=1, col="black")
  segments(x0=data["Lower",c(3,2,1, 6, 5, 4, 9, 8, 7, 12, 11, 10)],
           x1=data["Upper", c(3,2,1, 6, 5, 4, 9, 8, 7, 12, 11, 10)],
           y0=c(18, 17, 16, 13, 12, 11, 8, 7, 6, 3, 2, 1))
}

dplot(attr.mcl, "Attractivness")

dplot(date.mcl, "Would Date")

dplot(father.mcl, "Good Father")

dplot(strel.mcl, "Short-Term Relationship")

dplot(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.455108
apply(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.503775
apply(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.934668
apply(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.298868
apply(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.457882
apply(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.510170
apply(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.540504
apply(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.23972
apply(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.517947
apply(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.338771

At 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"))
  print(smean.cl.normal(bc.v.nobc))
  print(nmean.sd(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.9450324 
##          n       mean         sd 
## 67.0000000  0.6946517  1.0264902
test.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.2439327 
##          n       mean         sd 
## 45.0000000  0.8185185  1.4160024
test.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.9402170 
##          n       mean         sd 
## 72.0000000  0.6614583  1.1862652
test.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.3651658 
##         n      mean        sd 
## 21.000000  0.890873  1.041956
test.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.5772392 
##         n      mean        sd 
## 31.000000  1.166667  1.119327
test.h2 <- function(data) {
  c.v.i  <- data %*% c(1, -1, 0)
  print(t.test(c.v.i, alt="greater"))
  print(smean.cl.normal(c.v.i))
  print(nmean.sd(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.6676585 
##          n       mean         sd 
## 67.0000000  0.4514925  0.8862195
test.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.0121186 
##          n       mean         sd 
## 45.0000000  0.5851852  1.4210592
test.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.8378411 
##          n       mean         sd 
## 72.0000000  0.5775463  1.1076917
test.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.9225092 
##          n       mean         sd 
## 21.0000000  0.3611111  1.2333146
test.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.21997824 
##          n       mean         sd 
## 31.0000000  0.6236559  1.6257293

Both 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.

Both hypotheses were tested separately using focused contrasts for each dependent measure (Rosenthal, Rosnow, & Rubin, 2000). The first hypothesis was tested by comparing the mean ratings for the photos of men identified as using birth control against those of men not using birth contraol. All five dependent measures provided support for the hypothesis: attractiveness, \(M = 0.69\) (\(SD = 1.03\)), \(t(66) = 5.34\), interest in dating, \(M = 0.82\) (\(SD = 1.42\)), \(t(44) = 3.88\), estimated quality of fatherhood, \(M = 0.66\) (\(SD = 1.19\)), \(t(71) = 4.73\), and interest in short- and long-term relationships \(M = 0.89\) (\(SD = 1.04\)), \(t(20) = 3.92\), and \(M = 1.17\) (\(SD = 1.12\)), \(t(30) = 5.80\), respectively.

The second hypothesis was tested by comparing the mean ratings for the photos of men identified as using condoms against those of men identified as using injectable birth control. In the case, four of the five dependent measures provided support for the hypothesis: attractiveness, \(M = 0.45\) (\(SD = 0.89\)), \(t(66) = 4.17\), interest in dating, \(M = 0.58\) (\(SD = 1.42\)), \(t(44) = 2.76\), estimated quality of fatherhood, \(M = 0.58\) (\(SD = 1.11\)), \(t(71) = 4.42\), and interest in long-term relationships \(M = 0.62\) (\(SD = 1.63\)), \(t(30) = 2.14\). Interest in short-term relationships was not altered significantly, \(M = 0.36\) (\(SD = 1.23\)), \(t(20) = 1.34\), \(p = .0974\).

References

Rosenthal, R., Rosnow, R. L., & Rubin, D. B. (2000). Contrasts and effect sizes in behavioral research: A correlational approach. New York, NY: Cambridge University Press.