Ultimatum Game

Report

1 Read data

# Read in data ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
setwd("C:/Users/Mihai/Desktop/R Notebooks/notebooks/UG-met")
folder <- "C:/Users/Mihai/Desktop/R Notebooks/notebooks/UG-met"
pre <- readr::read_csv("PRE_answers_2022.csv")

Rows: 2057 Columns: 7
-- Column specification ------------------------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr  (2): Username, Accepted
dbl  (4): Alocator, Decident, Feedback, Round
dttm (1): Timestamp

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.

post <- readr::read_csv("POST_answers_2022.csv")

Rows: 1944 Columns: 7
-- Column specification ------------------------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr  (2): Username, Accepted
dbl  (4): Alocator, Decident, Feedback, Round
dttm (1): Timestamp

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



## ID df
id_df <- rio::import(file.path(folder, "Scale complete triate Sofi pa4.xlsx"),
                     skip = 0, colNames = FALSE, which = "incadrari")   

New names:
* `` -> ...1
* `` -> ...2
* `` -> ...3
* `` -> ...4
* `` -> ...5
* ...

id_df <- id_df[, 1:4]
colnames(id_df) <- c("Grup", "Cond", "id", "email")

id_df <- 
  id_df %>%
  janitor::remove_empty("rows") %>% 
  dplyr::mutate(id = stringr::str_remove(id, "^0+"),              # remove leading zeros
                id = stringr::str_remove_all(id, "[[:blank:]]"),  # remove any white space
                id =  toupper(id)) %>%
  dplyr::mutate(Cond = stringr::str_replace(Cond, "12CONTROL", "CONTROL"),   # fix typo
                Grup = stringr::str_replace(Grup, "burnout", "Burnout"),
                Grup = stringr::str_replace(Grup, "pop generala", "pop gen"),
                Grup = stringr::str_replace(Grup, "old", "pop gen")) %>%
  dplyr::mutate(Grup = dplyr::if_else(is.na(Grup), "pop gen", Grup))

id_df <- 
  id_df %>%
  tidyr::separate(id, 
           into = c("id_num", "Exp_type"), 
           sep = "(?<=[0-9])(?=[A-Za-z])",     # ?<= is "look behind"
           remove = FALSE
           ) %>%
  dplyr::select(-id_num) %>%
  dplyr::mutate(Exp_type = dplyr::if_else(Exp_type %in% c("A", "B", "C", "D", "E", "R", "X"), "online", Exp_type)) %>% 
  dplyr::mutate(email = tolower(email),
                email = stringr::str_remove_all(email, "[[:blank:]]"))

# Read in data ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
setwd("C:/Users/Mihai/Desktop/R Notebooks/notebooks/UG-met")
email_df <- rio::import("mail-grup.xlsx", skip = 3)


gsr_df <- email_df[1:42, 1:4]
names(gsr_df)[1:4] <- c("Group", "Cond", "ID", "email")

rmn_df <- email_df[181:197, 2:4]
names(rmn_df)[1:3] <- c("Nr_Crt", "ID", "email")
rmn_df$Cond <- rep("EXPERIMENTAL", nrow(rmn_df))
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

–>

1.1 Exclude known test-IDs

# Exclude known test-IDs ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
excluded_id <- c("bica.andreea21@gmail.com", "ioana.r.podina@gmail.com", "test@ro", "rozetadraghici@gmail.com", "ioana.podina@fpse.unibuc.ro",
                 "cociaioana@gmail.com")
varstnici_pattern <- "PA1"

pre <-
  pre %>%
  dplyr::filter(!Username %in% excluded_id) %>%
  dplyr::filter(!str_detect(Username, varstnici_pattern))

post <-
  post %>%
  dplyr::filter(!Username %in% excluded_id) %>%
  dplyr::filter(!str_detect(Username, varstnici_pattern))


# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Check & Exclude IDs ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
pre %>%
  count(Username) %>%
  print(n = Inf)   # "luciana.haloiu@invingemautismul.ro" has 24 trials instead of 12

post %>%
  count(Username) %>%
  print(n = Inf)  

pre <- 
  pre %>%
  dplyr::group_by(Username) %>%             # exclude last 12 trials of "luciana.haloiu@invingemautismul.ro"
  dplyr::filter(!(Username == "luciana.haloiu@invingemautismul.ro" & dplyr::row_number() %in% 13:24)) 
pre$Timestamp[pre$Username == "luciana.haloiu@invingemautismul.ro"]  # check: 12th trial is at "2020-11-23 16:40:59 UTC"

 [1] "2020-11-23 16:38:20 UTC" "2020-11-23 16:38:37 UTC" "2020-11-23 16:38:52 UTC" "2020-11-23 16:39:05 UTC" "2020-11-23 16:39:16 UTC"
 [6] "2020-11-23 16:39:30 UTC" "2020-11-23 16:39:40 UTC" "2020-11-23 16:39:58 UTC" "2020-11-23 16:40:13 UTC" "2020-11-23 16:40:26 UTC"
[11] "2020-11-23 16:40:39 UTC" "2020-11-23 16:40:59 UTC"

pre_ids <- data.frame(pre = unique(pre$Username))
post_ids <- data.frame(post = unique(post$Username))
list_ids <- dplyr::full_join(pre_ids, post_ids, by = c("pre" = "post"), keep = TRUE)
list_ids                   

complete_ids <-
  list_ids %>%
  tidyr::drop_na() %>%
  dplyr::mutate(pre = as.character(pre)) %>%
  dplyr::pull(pre)
  
# Keep only IDs that have both PRE and POST
pre <-
  pre %>%
  dplyr::filter(Username %in% complete_ids)

post <-
  post %>%
  dplyr::filter(Username %in% complete_ids)







### Radical exclusions (keep only the first 12 observations)
pre <-
  pre %>%
  group_by(Username) %>% 
  dplyr::filter(row_number() <= 12) 

post <-
  post %>%
  group_by(Username) %>% 
  dplyr::filter(row_number() <= 12)

2 Join with ID table

# some Usernames are emails, some are IDs in form of emails
pre <-
  pre %>%
  dplyr::mutate(id_user = Username) %>%
  dplyr::select(Username, id_user, everything()) %>%
  dplyr::mutate(id_user = stringr::str_remove(id_user, "@.*")) %>%
  dplyr::mutate(id_user = if_else(stringr::str_detect(id_user, "A10|GSR"), id_user, NA_character_)) %>%
  dplyr::mutate(id_user = stringr::str_remove(id_user, "^0+"),              # remove leading zeros
                id_user = stringr::str_remove_all(id_user, "[[:blank:]]"),  # remove any white space
                id_user =  toupper(id_user)) %>%
  dplyr::mutate(Username = tolower(Username),
                Username = stringr::str_remove_all(Username, "[[:blank:]]"))

post <-
  post %>%
  dplyr::mutate(id_user = Username) %>%
  dplyr::select(Username, id_user, everything()) %>%
  dplyr::mutate(id_user = stringr::str_remove(id_user, "@.*")) %>%
  dplyr::mutate(id_user = if_else(stringr::str_detect(id_user, "A10|GSR"), id_user, NA_character_)) %>%
  dplyr::mutate(id_user = stringr::str_remove(id_user, "^0+"),              # remove leading zeros
                id_user = stringr::str_remove_all(id_user, "[[:blank:]]"),  # remove any white space
                id_user =  toupper(id_user)) %>%
  dplyr::mutate(Username = tolower(Username),
                Username = stringr::str_remove_all(Username, "[[:blank:]]"))

# Exclude subjects from A10 (RMN sample)
pre <-
  pre %>%
  dplyr::filter(!str_detect(Username, "a10"))

post <-
  post %>%
  dplyr::filter(!str_detect(Username, "a10"))


# Merge
pre_united <- dplyr::left_join(pre, id_df, by = c("Username" = "email")) %>%
  dplyr::left_join(., id_df, by = c("id_user" = "id"), suffix = c("", ".x")) %>%
    dplyr::mutate(Grup = dplyr::coalesce(Grup, Grup.x),
                  Cond = dplyr::coalesce(Cond, Cond.x),
                  Exp_type = dplyr::coalesce(Exp_type, Exp_type.x),
                  email = dplyr::coalesce(email, email)) %>%
  dplyr::select(!contains(".x")) %>%
  dplyr::filter(!is.na(Grup), !is.na(Cond))
                
post_united <- dplyr::left_join(post, id_df, by = c("Username" = "email")) %>%
  dplyr::left_join(., id_df, by = c("id_user" = "id"), suffix = c("", ".x")) %>%
    dplyr::mutate(Grup = dplyr::coalesce(Grup, Grup.x),
                  Cond = dplyr::coalesce(Cond, Cond.x),
                  Exp_type = dplyr::coalesce(Exp_type, Exp_type.x),
                  email = dplyr::coalesce(email, email)) %>%
  dplyr::select(!contains(".x")) %>%
  dplyr::filter(!is.na(Grup), !is.na(Cond))

# To keep rest of code working
pre <- pre_united
post <- post_united

merged_united <- rbind(pre_united, post_united) %>%
  dplyr::select(Username, Grup, Cond)

3 Compute scores

# Compute scores ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# utilizam doar Decident: unfair = 17-24 (6 oferte diferite); fair = 49-54 (6 oferte diferite)

# Define Fair/Unfair
pre <-
  pre %>%
  dplyr::mutate(Type = cut(Decident, breaks = c(-Inf, 30, Inf), labels = c("Unfair", "Fair")))

post <-
  post %>%
  dplyr::mutate(Type = cut(Decident, breaks = c(-Inf, 30, Inf), labels = c("Unfair", "Fair")))

# Compute Percent scores
pre_scores <-
  pre %>%
  dplyr::add_count(Username, Type, name = "n_Type") %>%
  dplyr::count(Username, Type, Accepted, n_Type, name = "n_Accepted_Type", .drop = FALSE) %>%   # need .drop = FALSE for missing factor levels leading to 0% Percentages
  dplyr::mutate(Percent = 100 * n_Accepted_Type / n_Type) %>%  
  dplyr::ungroup() %>%
  tidyr::complete(Username, Type, Accepted, fill = list(n_Type = 0, n_Accepted_Type = 0, Percent = 0)) %>%  # for missing factor levels leading to 0% Percentages
  dplyr::filter(Accepted == "Y") %>%
  dplyr::mutate(PrePost = rep("Pre", n())) %>%
  dplyr::mutate(PrePost= factor(PrePost, levels = c("Pre", "Post"))) 

post_scores <-
  post %>%
  dplyr::add_count(Username, Type, name = "n_Type") %>%
  dplyr::count(Username, Type, Accepted, n_Type, name = "n_Accepted_Type", .drop = FALSE) %>%   # need .drop = FALSE for missing factor levels leading to 0% Percentages
  dplyr::mutate(Percent = 100 * n_Accepted_Type / n_Type) %>%  
  dplyr::ungroup() %>%
  tidyr::complete(Username, Type, Accepted, fill = list(n_Type = 0, n_Accepted_Type = 0, Percent = 0)) %>%  # for missing factor levels leading to 0% Percentages
  dplyr::filter(Accepted == "Y") %>%
  dplyr::mutate(PrePost = rep("Post", n())) %>%
  dplyr::mutate(PrePost = factor(PrePost, levels = c("Pre", "Post")))
  

merged_scores <- rbind(pre_scores, post_scores) %>%
  dplyr::left_join(., merged_united, by = "Username")

# # Merge  - OLD
# merged_scores <- rbind(pre_scores, post_scores)
# 
# merged_scores$Username <- tolower(merged_scores$Username)   # emails to lower letters to match on
# gsr_df$email <- tolower(gsr_df$email)
# rmn_df$email <- tolower(rmn_df$email)
# 
# merged_scores_gsr <- dplyr::left_join(merged_scores, gsr_df, by = c("Username" = "email"))     # Merge with emails/cond
# merged_scores_rmn <- dplyr::left_join(merged_scores, rmn_df, by = c("Username" = "email"))     # Merge with emails/cond
# 
# merged_scores_gsr_rmn <-
#   dplyr::left_join(merged_scores_gsr, merged_scores_rmn, by = c("Username", "Type", "Accepted", "n_Type", "n_Accepted_Type", "Percent", "PrePost")) %>%
#   dplyr::mutate(Cond = dplyr::coalesce(Cond.x, Cond.y)) %>%
#   dplyr::mutate(ID = dplyr::coalesce(ID.x, ID.y))

4 General pop

merged_scores %>%
  dplyr::filter(Grup == "pop gen", Cond == "EXPERIMENTAL") %>%
    ggstatsplot::grouped_ggwithinstats(
      data = .,
      x = PrePost,
      y = Percent,
      grouping.var = Type,
      type = "parametric",
      pairwise.comparisons = TRUE,
      pairwise.display = "all",
      annotation.args = list(title = "Populatie Genearala - TR"))

merged_scores %>%
  dplyr::filter(Grup == "pop gen", Cond == "CONTROL") %>%
    ggstatsplot::grouped_ggwithinstats(
      data = .,
      x = PrePost,
      y = Percent,
      grouping.var = Type,
      type = "parametric",
      pairwise.comparisons = TRUE,
      pairwise.display = "all",
      annotation.args = list(title = "Populatie Genearala - CTRL"))

5 PTSD

merged_scores %>%
  dplyr::filter(Grup == "PTSD", Cond == "EXPERIMENTAL") %>%
    ggstatsplot::grouped_ggwithinstats(
      data = .,
      x = PrePost,
      y = Percent,
      grouping.var = Type,
      type = "np",
      pairwise.comparisons = TRUE,
      pairwise.display = "all",
      annotation.args = list(title = "PTSD - TR"))

merged_scores %>%
  dplyr::filter(Grup == "PTSD", Cond == "CONTROL") %>%
    ggstatsplot::grouped_ggwithinstats(
      data = .,
      x = PrePost,
      y = Percent,
      grouping.var = Type,
      type = "np",
      pairwise.comparisons = TRUE,
      pairwise.display = "all",
      annotation.args = list(title = "PTSD - CTRL"))

6 Burnout

merged_scores %>%
  dplyr::filter(Grup == "Burnout", Cond == "EXPERIMENTAL") %>%
    ggstatsplot::grouped_ggwithinstats(
      data = .,
      x = PrePost,
      y = Percent,
      grouping.var = Type,
      type = "np",
      pairwise.comparisons = TRUE,
      pairwise.display = "all",
      annotation.args = list(title = "Burnout - TR"))

merged_scores %>%
  dplyr::filter(Grup == "Burnout", Cond == "CONTROL") %>%
    ggstatsplot::grouped_ggwithinstats(
      data = .,
      x = PrePost,
      y = Percent,
      grouping.var = Type,
      type = "np",
      pairwise.comparisons = TRUE,
      pairwise.display = "all",
      annotation.args = list(title = "Burnout - CTRL"))

7 Session Info

R version 4.1.0 (2021-05-18)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 8.1 x64 (build 9600)

Matrix products: default

locale:
[1] LC_COLLATE=Romanian_Romania.1250  LC_CTYPE=Romanian_Romania.1250    LC_MONETARY=Romanian_Romania.1250 LC_NUMERIC=C                     
[5] LC_TIME=Romanian_Romania.1250    
system code page: 1252

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] statsExpressions_1.1.0 ggstatsplot_0.8.0      rlang_0.4.11           broom_0.7.9            rstatix_0.7.0          rio_0.5.27            
 [7] scales_1.1.1           ggpubr_0.4.0           forcats_0.5.1          stringr_1.4.0          dplyr_1.0.7            purrr_0.3.4           
[13] readr_2.0.1            tidyr_1.1.3            tibble_3.1.4           ggplot2_3.3.5          tidyverse_1.3.1        papaja_0.1.0.9997     
[19] pacman_0.5.1          

loaded via a namespace (and not attached):
  [1] estimability_1.3          ggprism_1.0.3             GGally_2.1.2              lavaan_0.6-9              coda_0.19-4              
  [6] bit64_4.0.5               knitr_1.33                multcomp_1.4-17           data.table_1.14.0         rpart_4.1-15             
 [11] hardhat_0.1.6             generics_0.1.0            GPfit_1.0-8               TH.data_1.0-10            future_1.22.1            
 [16] correlation_0.7.0         bit_4.0.4                 tzdb_0.1.2                xml2_1.3.2                lubridate_1.7.10         
 [21] assertthat_0.2.1          gower_0.2.2               WRS2_1.1-3                xfun_0.25                 jquerylib_0.1.4          
 [26] hms_1.1.0                 evaluate_0.14             fansi_0.5.0               dbplyr_2.1.1              readxl_1.3.1             
 [31] igraph_1.2.6              DBI_1.1.1                 tmvnsim_1.0-2             Rsolnp_1.16               htmlwidgets_1.5.3        
 [36] reshape_0.8.8             kSamples_1.2-9            stats4_4.1.0              Rmpfr_0.8-4               paletteer_1.4.0          
 [41] ellipsis_0.3.2            backports_1.2.1           pbivnorm_0.6.0            insight_0.14.4            prismatic_1.0.0          
 [46] RcppParallel_5.1.4        vctrs_0.3.8               abind_1.4-5               cachem_1.0.6              withr_2.4.2              
 [51] vroom_1.5.4               checkmate_2.0.0           emmeans_1.6.3             archive_1.1.0             fdrtool_1.2.16           
 [56] parsnip_0.1.7             mnormt_2.0.2              cluster_2.1.2             mi_1.0                    crayon_1.4.1             
 [61] labeling_0.4.2            recipes_0.1.16            pkgconfig_2.0.3           SuppDists_1.1-9.5         nlme_3.1-152             
 [66] nnet_7.3-16               globals_0.14.0            lifecycle_1.0.1           MatrixModels_0.5-0        sandwich_3.0-1           
 [71] kutils_1.70               modelr_0.1.8              cellranger_1.1.0          datawizard_0.2.0.1        Matrix_1.3-4             
 [76] yardstick_0.0.8           regsem_1.8.0              mc2d_0.1-21               carData_3.0-4             boot_1.3-28              
 [81] zoo_1.8-9                 reprex_2.0.1              base64enc_0.1-3           png_0.1-7                 PMCMRplus_1.9.0          
 [86] parameters_0.14.0         pROC_1.18.0               tune_0.1.6                workflows_0.2.3           multcompView_0.1-8       
 [91] arm_1.11-2                parallelly_1.27.0         jpeg_0.1-9                rockchalk_1.8.144         ggsignif_0.6.2           
 [96] memoise_2.0.0             magrittr_2.0.1            plyr_1.8.6                compiler_4.1.0            RColorBrewer_1.1-2       
[101] lme4_1.1-27.1             snakecase_0.11.0          cli_3.0.1                 DiceDesign_1.9            listenv_0.8.0            
[106] patchwork_1.1.1           pbapply_1.4-3             htmlTable_2.2.1           Formula_1.2-4             MASS_7.3-54              
[111] tidyselect_1.1.1          stringi_1.7.4             lisrelToR_0.1.4           sem_3.1-11                yaml_2.2.1               
[116] OpenMx_2.19.6             latticeExtra_0.6-29       ggrepel_0.9.1             semTools_0.5-5            grid_4.1.0               
[121] sass_0.4.0                tools_4.1.0               future.apply_1.8.1        parallel_4.1.0            matrixcalc_1.0-5         
[126] rstudioapi_0.13           foreach_1.5.1             foreign_0.8-81            janitor_2.1.0             gridExtra_2.3            
[131] ipmisc_6.0.2              prodlim_2019.11.13        pairwiseComparisons_3.1.6 farver_2.1.0              digest_0.6.28            
[136] lava_1.6.10               BWStest_0.2.2             Rcpp_1.0.7                car_3.0-11                BayesFactor_0.9.12-4.2   
[141] performance_0.7.3         httr_1.4.2                psych_2.1.6               effectsize_0.4.5          poLCA_1.4.1              
[146] colorspace_2.0-2          rvest_1.0.1               XML_3.99-0.7              fs_1.5.0                  truncnorm_1.0-8          
[151] splines_4.1.0             rematch2_2.1.2            xtable_1.8-4              gmp_0.6-2                 jsonlite_1.7.2           
[156] nloptr_1.2.2.2            corpcor_1.6.9             timeDate_3043.102         glasso_1.11               zeallot_0.1.0            
[161] ipred_0.9-11              R6_2.5.1                  Hmisc_4.5-0               lhs_1.1.1                 pillar_1.6.3             
[166] htmltools_0.5.2           glue_1.4.2                fastmap_1.1.0             minqa_1.2.4               class_7.3-19             
[171] codetools_0.2-18          mvtnorm_1.1-2             furrr_0.2.3               utf8_1.2.2                bslib_0.3.0              
[176] lattice_0.20-44           dials_0.0.9               curl_4.3.2                gtools_3.9.2              zip_2.2.0                
[181] openxlsx_4.2.4            survival_3.2-13           rmarkdown_2.10            qgraph_1.6.9              munsell_0.5.0            
[186] semPlot_1.1.2             rsample_0.1.0             iterators_1.0.13          haven_2.4.3               reshape2_1.4.4           
[191] gtable_0.3.0              bayestestR_0.11.0        

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com