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')# viewing data
names(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"head(d)## # A tibble: 6 × 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
## # ℹ 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>, attachment26 <dbl>, …attributes(d$condition)## $label
## [1] "Independent variable - hypothetical vs. real condition"
##
## $format.spss
## [1] "F8.2"
##
## $class
## [1] "haven_labelled" "vctrs_vctr" "double"
##
## $labels
## hypothetical real
## 0 1attributes(d$exchangeinfo)## $label
## [1] "Key DV- whether or not participant agreed to exchange contact info"
##
## $format.spss
## [1] "F11.0"
##
## $display_width
## [1] 11
##
## $class
## [1] "haven_labelled" "vctrs_vctr" "double"
##
## $labels
## yes no
## 1 2# quicker labeling bc of haven
d_clean <- d %>%
dplyr:: select(ID, condition, exchangeinfo) %>%
filter(!is.na(condition), !is.na(exchangeinfo)) %>%
mutate(condition = haven::as_factor(condition), exchangeinfo = haven::as_factor(exchangeinfo))
head(d_clean)## # A tibble: 6 × 3
## ID condition exchangeinfo
## <dbl> <fct> <fct>
## 1 53 real yes
## 2 93 real no
## 3 83 real no
## 4 27 hypothetical no
## 5 6 hypothetical yes
## 6 116 hypothetical yesdplyr::count(d_clean, condition, exchangeinfo)## # A tibble: 4 × 3
## condition exchangeinfo n
## <fct> <fct> <int>
## 1 hypothetical yes 10
## 2 hypothetical no 51
## 3 real yes 26
## 4 real no 45Only 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
tab <- table(d_clean$condition, d_clean$exchangeinfo)
tab##
## yes no
## hypothetical 10 51
## real 26 45addmargins(tab)##
## yes no Sum
## hypothetical 10 51 61
## real 26 45 71
## Sum 36 96 132round(prop.table(tab, 1) * 100, 2)##
## yes no
## hypothetical 16.39 83.61
## real 36.62 63.38A 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
chisq_result <- chisq.test(tab, correct = FALSE)
chisq_result##
## Pearson's Chi-squared test
##
## data: tab
## 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?
Yes, I was able to reproduce the results.
How difficult was it to reproduce your results?
It was fairly simple to reproduce the results given that it was a simpler analysis/data cleaned well.
What aspects made it difficult? What aspects made it easy?
The difficult aspect was understanding how the original/raw data was set up (what each of the columns mean, etc.), but this was also made more simple since it was cleanly labelled/identified for us.