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.

Methods summary:

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.


Target outcomes:

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.


Step 1: Load packages

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 

Step 2: Load data

# Just Study 1
d <- read_sav('data/Empathy Gap Study 1 data.sav')

Step 3: Tidy data

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 variables that we care about
# note for 'exchangeinfo': value 1 corresponds to "yes" and 2 to "no"
# 'selfattractive': How physical attractive do you consider yourself to be? [9-point scale]
# 'otherattractive': How physically attractive do you consider your potential date to be? [9-point scale]
filtered_d <- d %>% 
  select(c("ID", "exchangeinfo", "condition", "selfattractive", "otherattractive", "selffocused_motives", "otherfocused_motives")) 

filtered_d
## # A tibble: 132 × 7
##       ID exchangeinfo        condition selfattractive otherattractive selffocused_mot…
##    <dbl>    <dbl+lbl>        <dbl+lbl>          <dbl>           <dbl>            <dbl>
##  1    53      1 [yes] 1 [real]                      5               6             3.38
##  2    93      2 [no]  1 [real]                      8               5             2.4 
##  3    83      2 [no]  1 [real]                      4               4             2.75
##  4    27      2 [no]  0 [hypothetical]             NA              NA             1.75
##  5     6      1 [yes] 0 [hypothetical]             NA              NA             3.5 
##  6   116      1 [yes] 0 [hypothetical]              7               5             2.75
##  7    24      2 [no]  0 [hypothetical]             NA              NA             2.62
##  8   127      2 [no]  0 [hypothetical]              9               1             2   
##  9    32      1 [yes] 1 [real]                      3               6             2.38
## 10    73      2 [no]  1 [real]                      6               8             1.12
## # … with 122 more rows, and 1 more variable: otherfocused_motives <dbl>

Step 4: Run analysis

Descriptive statistics

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
filtered_d %>% 
  group_by(condition, exchangeinfo) %>% 
  summarise(count = n())
## # A tibble: 4 × 3
## # Groups:   condition [2]
##          condition exchangeinfo count
##          <dbl+lbl>    <dbl+lbl> <int>
## 1 0 [hypothetical]      1 [yes]    10
## 2 0 [hypothetical]      2 [no]     51
## 3 1 [real]              1 [yes]    26
## 4 1 [real]              2 [no]     45

Inferential statistics

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
chisq.test(rbind(c(10,61), c(26, 71)))
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  rbind(c(10, 61), c(26, 71))
## X-squared = 3.22, df = 1, p-value = 0.07274

Step 5: Reflection

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 table but not the inferential statistics. The chi-squared test statistic and the p values are different.

How difficult was it to reproduce your results? What aspects made it difficult? What aspects made it easy?

   Reproducing the results was quite difficult, primarily due to the difficulty understanding the data generating process. I spent some time trying to map constructs listed in the paper (pdf) to variables in the actual data. Once I figured outu what the variables represented, running the descriptives was relatively easy.