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')
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"# Select only columns that we need
filtered_d = d |>
select(c("ID", "condition", "exchangeinfo", "otherattractive", "selfattractive"))
filtered_d## # A tibble: 132 × 5
## ID condition exchangeinfo otherattractive selfattractive
## <dbl> <dbl+lbl> <dbl+lbl> <dbl> <dbl>
## 1 53 1 [real] 1 [yes] 6 5
## 2 93 1 [real] 2 [no] 5 8
## 3 83 1 [real] 2 [no] 4 4
## 4 27 0 [hypothetical] 2 [no] NA NA
## 5 6 0 [hypothetical] 1 [yes] NA NA
## 6 116 0 [hypothetical] 1 [yes] 5 7
## 7 24 0 [hypothetical] 2 [no] NA NA
## 8 127 0 [hypothetical] 2 [no] 1 9
## 9 32 1 [real] 1 [yes] 6 3
## 10 73 1 [real] 2 [no] 8 6
## # ℹ 122 more rowsOnly 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
desc_stats = filtered_d |>
group_by(condition) |>
count(exchangeinfo)
#condition: 0 is hypothetical, 1 is real
#exchangeinfo: 1 is choosing to exchange, 2 is not exchanging contact information
desc_stats |> group_by(condition) |>
summarise(exchangeinfo1 = first(n), exchangeinfo2 = last(n))## # A tibble: 2 × 3
## condition exchangeinfo1 exchangeinfo2
## <dbl+lbl> <int> <int>
## 1 0 [hypothetical] 10 51
## 2 1 [real] 26 45A 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.
Hint: if you are using the function chisq.test(), make sure to set the continuity correction to false (“correct = FALSE”) since sample size is greater than 20.
# reproduce the above results here
# transform results into a 2x2 data frame for chi-squared test
chisquaretable <- data.frame(
hypothetical = desc_stats$n[1:2],
real = desc_stats$n[3:4]
)
chisq.test(chisquaretable,correct=FALSE)##
## Pearson's Chi-squared test
##
## data: chisquaretable
## X-squared = 6.7674, df = 1, p-value = 0.009284Were 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 all of the results except for the degrees of freedom in the X^2 test.
How difficult was it to reproduce your results?
There was a fair bit of trial and error as I had to continuously visualize my dataframes to familiarize myself with what the different commands did. There were many columns unrelated to the analysis of interest, and I had to infer the coding from the count as I did not know how to use the “labelled” package. I included the attractiveness ratings as I was not sure if I had to use it at any point in the analysis, but on hindsight I could have left them out too.
What aspects made it difficult? What aspects made it easy?
Difficulties with the reproduction are detailed in the previous question. Having the original results as a reference point made it much easier to confirm that what I was doing was correct. All the functions required were built into the packages, which meant that I just had to provide the correct inputs to get the same results.