For this exercise, please try to reproduce the results from Study 1 of the associated paper (Joel, Teper, & MacDonald, 2014). The PDF of the paper is included in the same folder as this Rmd file.
In study 1, 150 introductory psychology students were randomly assigned to a “real” or a “hypothetical” condition. In the real condition, participants believed that they would have a real opportuniy to connect with potential romantic partners. In the hypothetical condition, participants simply imagined that they are on a date. All participants were required to select their favorite profile and answer whether they were willing to exchange contact information.
Below is the specific result you will attempt to reproduce (quoted directly from the results section of Study 1):
We next tested our primary hypothesis that participants would be more reluctant to reject the unattractive date when they believed the situation to be real rather than hypothetical. Only 10 of the 61 participants in the hypothetical condition chose to exchange contact information with the unattractive potential date (16%). In contrast, 26 of the 71 participants in the real condition chose to exchange contact information (37%). A chi-square test of independence indicated that participants were significantly less likely to reject the unattractive potential date in the real condition compared with the hypothetical condition, X^2(1, N = 132) = 6.77, p = .009.
library(tidyverse) # for data munging
library(knitr) # for kable table formating
library(haven) # import and export 'SPSS', 'Stata' and 'SAS' Files
library(readxl) # import excel files
# #optional packages:
# library(broom)
# library(labelled)# converts SPSS's labelled to R's factor # Just Study 1
d <- read_sav('data/Empathy Gap Study 1 data.sav')
d## # A tibble: 132 × 125
## ID attachment1 attachment2 attachment3 attachment4 attachment5 attachment6
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 53 3 4 5 3 2 3
## 2 93 5 1 3 4 2 2
## 3 83 3 6 3 6 5 4
## 4 27 2 6 5 2 5 5
## 5 6 3 6 3 5 5 5
## 6 116 4 7 5 6 6 6
## 7 24 6 5 6 3 2 2
## 8 127 6 2 6 5 4 5
## 9 32 5 5 5 4 4 2
## 10 73 4 6 3 6 3 4
## # … with 122 more rows, and 118 more variables: attachment7 <dbl>,
## # attachment8 <dbl>, attachment9 <dbl>, attachment10 <dbl>,
## # attachment11 <dbl>, attachment12 <dbl>, attachment13 <dbl>,
## # attachment14 <dbl>, attachment15 <dbl>, attachment16 <dbl>,
## # attachment17 <dbl>, attachment18 <dbl>, attachment19 <dbl>,
## # attachment20 <dbl>, attachment21 <dbl>, attachment22 <dbl>,
## # attachment23 <dbl>, attachment24 <dbl>, attachment25 <dbl>, …colnames(d)## [1] "ID" "attachment1"
## [3] "attachment2" "attachment3"
## [5] "attachment4" "attachment5"
## [7] "attachment6" "attachment7"
## [9] "attachment8" "attachment9"
## [11] "attachment10" "attachment11"
## [13] "attachment12" "attachment13"
## [15] "attachment14" "attachment15"
## [17] "attachment16" "attachment17"
## [19] "attachment18" "attachment19"
## [21] "attachment20" "attachment21"
## [23] "attachment22" "attachment23"
## [25] "attachment24" "attachment25"
## [27] "attachment26" "attachment27"
## [29] "attachment28" "attachment29"
## [31] "attachment30" "attachment31"
## [33] "attachment32" "attachment33"
## [35] "attachment34" "attachment35"
## [37] "attachment36" "FOBA1"
## [39] "FOBA2" "FOBA3"
## [41] "FOBA4" "FOBA5"
## [43] "FOBA6" "empathy1"
## [45] "empathy2" "empathy3"
## [47] "empathy4" "empathy5"
## [49] "empathy6" "empathy7"
## [51] "empathy8" "empathy9"
## [53] "empathy10" "empathy11"
## [55] "empathy12" "empathy13"
## [57] "empathy14" "empathy15"
## [59] "empathy16" "empathy17"
## [61] "empathy18" "empathy19"
## [63] "empathy20" "empathy21"
## [65] "empathy22" "empathy23"
## [67] "empathy24" "empathy25"
## [69] "empathy26" "empathy27"
## [71] "empathy28" "age"
## [73] "livedincanada" "orientation"
## [75] "inrel" "longterm"
## [77] "dating" "shortterm"
## [79] "intimate" "otheropen"
## [81] "drink" "children"
## [83] "responseq1" "responseq2"
## [85] "responseq3" "responseq4"
## [87] "reasontrue1" "motives1"
## [89] "reasontrue2" "motives2"
## [91] "reasontrue3" "motives3"
## [93] "reasontrue4" "motives4"
## [95] "reasontrue5" "motives5"
## [97] "reasontrue6" "motives6"
## [99] "reasontrue7" "motives7"
## [101] "reasontrue8" "motives8"
## [103] "suspicious" "selfattractive"
## [105] "otherattractive" "EmpathyPTtot"
## [107] "EmpathyFStot" "EmpathyECtot"
## [109] "EmpathyPDtot" "fobstot"
## [111] "attachmentavoidance" "attachmentanxiety"
## [113] "stateguilttot" "stateempathytot"
## [115] "excitementtot" "compatibilitytot"
## [117] "very_otherfocused" "less_otherfocused"
## [119] "gender" "genderXcondition"
## [121] "REQUIRED_VARIABLES_START_BELOW" "condition"
## [123] "exchangeinfo" "otherfocused_motives"
## [125] "selffocused_motives"Only 10 of the 61 participants in the hypothetical condition chose to exchange contact information with the unattractive potential date (16%). In contrast, 26 of the 71 participants in the real condition chose to exchange contact information (37%).
# reproduce the above results here
d %>%
filter(is.na(exchangeinfo)==FALSE, is.na(condition)==FALSE) %>%
mutate(
exchangeinfo = as.numeric(as.character(factor(ifelse(exchangeinfo==1,1,0)))),
condition = factor(ifelse(condition == 0, 0, 1), levels = 0:1, labels = c("hypothetical", "real"))
) %>%
group_by(condition) %>%
summarise(proportion = mean(exchangeinfo))## # A tibble: 2 × 2
## condition proportion
## <fct> <dbl>
## 1 hypothetical 0.164
## 2 real 0.366Data reproduced showing 16% of participants in hypothetical exchanging contact infromation with unattractive poential date, and 37% of participants in real condition chose ot exchange contact information.
A chi-square test of independence indicated that participants were significantly less likely to reject the unattractive potential date in the real condition compared with the hypothetical condition, X^2(1, N = 132) = 6.77, p = .009.
# reproduce the above results here
d_new = d %>%
filter(is.na(exchangeinfo)==FALSE, is.na(condition)==FALSE) %>%
mutate(
exchangeinfo = as.numeric(as.character(factor(ifelse(exchangeinfo==1,1,0)))),
condition = factor(ifelse(condition == 0, 0, 1), levels = 0:1, labels = c("hypothetical", "real"))
)
chisq.test(table(d_new$exchangeinfo, d_new$condition))##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: table(d_new$exchangeinfo, d_new$condition)
## X-squared = 5.786, df = 1, p-value = 0.01615This failed to reproduce the results, getting an X^2 of 5.786 and p=0.016
Were you able to reproduce the results you attempted to reproduce? If not, what part(s) were you unable to reproduce?
I was able to reproduce the descriptive statistics however the inferential statistics did not reproduce.
How difficult was it to reproduce your results?
This was faily straight forward to interpret the data as it was well organized.
What aspects made it difficult? What aspects made it easy?
Difficult aspects was mainly in the labels/values they chose for the data. For instance condition for hypothetical was 0 and real was 1, which was not a problem, however, exchange info, they used 1 for yes, and 2 for no, requiring me to change to data to something more suitable, like True False (or their respective numerical values 1 and 0) which I needed in order to compute the statistics like mean/proportion and the X^2 statistic.