STAD - Demo and Imitation Metrics

Preliminary Analysis

1 Run demoimitMetrics_cleantable script

script_folder <- "C:/Users/Mihai/Desktop/R Notebooks/notebooks/STAD-demoimitMetrics/Scripts" 
script_name <- "demoimitMetrics_to_cleantable.R"
source(file.path(script_folder, script_name))

2 Data

2.1 Info:

• Demo scores

  • object response by navigator (individual score) (GameState 9 => newGameState 10)

• Imitation scores

  • 1st row for start (GameState 14 => newGameState 15)
  • 2nd row for flag (GameState 15 => newGameState 16)
  • 3rd row = first object response by navigator (individual score) (GameState 16 => newGameState 17)
  • 4th row = suggestion marker by observer (observer score) (GameState 17 => newGameState 18)
  • 5th row = 2nd object response by navigator (collaborative score) (GameState 18 => newGameState 19)

• Variables:

  • id categorical - unique identifier
  • condition categorical - “social” or “bot”
  • order categorical - 1 or 2 the order of conditions
  • who catergorical - 1 or 2 codes for who’s recording it is (data only for current id is when: who == playerType)
  • newGameState_clean categorical - codes for GameStates (5-11 are Demo, 12-20 are Imit)
  • demoimitState_clean categorical - “Demo” or “Imit” depending on state
  • playerType categorical - 1 or 2 depending on GameState (should be used together with var who)
  • markerType categorical - codes for the object (see documentation), but it actually follows the the above Info (dependes on GameState)
  • score continuous - follows the the above Info (depends on GameState)

full_data_output_clean %>%
  DT::datatable(                                  # excel downloadable  DT table
  extensions = 'Buttons',
  options = list(pageLength = 5,
                 scrollX = '500px', 
                 dom = 'Bfrtip', 
                 buttons = c('excel', "csv"))) %>%
  DT::formatStyle(names(full_data_output_clean),lineHeight = "60%")    # slimmer rows

3 Preliminary Analyses

3.0.1 Functions

plot_growth_state_id <- function(data, cond, gamestate, time_lim = 20) {
  data %>%
  dplyr::filter(condition == cond, newGameState_clean == gamestate) %>%
  group_by(id) %>%
  dplyr::mutate(time = dplyr::row_number()) %>%
  dplyr::filter(time < time_lim) %>%  
    ggplot(aes(x = time, y = score)) +
    geom_line() +
    facet_wrap(~id) +
    ylim(0, 100) +
    scale_x_continuous(breaks = 1:14) +
    ggtitle(paste0("Condition: ", cond, ", ", "Game state: ", gamestate))
}

# e.g.
# full_data_output_clean %>%
#   dplyr::filter(condition == "bot", newGameState_clean == "10") %>%
#   group_by(id) %>%
#   dplyr::mutate(time = dplyr::row_number()) %>%
#   ggplot(aes(x = time, y = score)) +
#   geom_line() +
#   facet_wrap(~id)

plot_growth_state_loess <- function(data, cond, gamestate, time_lim = 20) {
  data %>%
  dplyr::filter(condition == cond, newGameState_clean == gamestate) %>%
  group_by(id) %>%
  dplyr::mutate(time = dplyr::row_number()) %>%
  dplyr::filter(time < time_lim) %>%   
    ggplot(aes(x = time, y = score)) +
    geom_line(aes(color = as.factor(id)), alpha = .5) +
    geom_smooth(method = "loess", formula = "y ~ x", color = "red", fill = "red") +
    geom_smooth(method = "lm", formula = y ~ splines::bs(x, knots = seq(2 , 16, by = 2), degree = 1), 
                se = FALSE, color = "black", fill = "gray", alpha = 0.8) +
    ylim(0, 100) +
    scale_x_continuous(breaks = 1:14) +
    ggtitle(paste0("Condition: ", cond, ", ", "Game state: ", gamestate)) +
    labs(color = "id")  
}
  
# e.e.
# full_data_output_clean %>%
# dplyr::filter(condition == "bot", newGameState_clean == "10") %>%
# group_by(id) %>%
# dplyr::mutate(time = dplyr::row_number()) %>%
# ggplot(aes(x = time, y = score)) +
# geom_line(aes(color = as.factor(id)), alpha = .5) +
# geom_smooth(method = "loess", formula = "y ~ x")

plot_growth_state1017_id <- function(data, conds = c("social", "bot"), time_lim = 20) {
  data %>%
  dplyr::filter(condition %in% conds, newGameState_clean %in% c("10", "17")) %>%
  dplyr::mutate(newGameState_clean = as.factor(newGameState_clean)) %>%  
  dplyr::group_by(id, condition) %>%
  dplyr::mutate(time = dplyr::row_number()) %>%
  dplyr::filter(time < time_lim) %>% 
    ggplot(aes(x = time, y = score, color = condition)) +
    geom_line() +
    geom_point(aes(shape = newGameState_clean)) +
    facet_wrap(~id) +
    ylim(0, 100) +
    scale_x_continuous(breaks = 1:14) +
    ggtitle("Alternating GameState 10 and 17") + 
    theme(legend.position = "right")
}



my_ggwithinstats2 <- function(data, title = NULL, x, y, gamestate, time_lim = 20, outlier.label, xlab, ylab, 
                              outlier.tagging = FALSE, results.subtitle = TRUE, 
                              centrality.label.args = TRUE, point.path = TRUE,
                              type = "parametric", 
                              ...) {  # ... for limits and breaks
  x <- rlang::enquo(x)
  y <- rlang::enquo(y)
  outlier.label <- rlang::enquo(outlier.label)
  
  if(is.null(title)) {
    title <- paste0("Game state: ", gamestate)
  }
  
  data <-
    data %>%
    dplyr::select(!!outlier.label, !!x, !!y, newGameState_clean) %>%      # newGameState_clean is hardcoded here
    dplyr::filter(newGameState_clean == gamestate) %>%
    group_by(!!outlier.label, !!x) %>%
    dplyr::mutate(time = dplyr::row_number()) %>%
    dplyr::filter(time < time_lim) %>%   
    dplyr::summarise(mean_score = mean(!!y, na.rm = TRUE))
    
  if(centrality.label.args){
    centrality.label.args <- list(size = 3, nudge_x = 0.2, segment.linetype = 5, fill = "#FFF8E7")
  }else{
    centrality.label.args <- list(size = 0, nudge_x = 10, segment.linetype = 0, alpha = 0) # very hacky way of not showing label
  }
  
  data %>%
    ggstatsplot::ggwithinstats(
      x = !!x,
      y = mean_score,              # here we have the mean score for id, not !!y
      title = title,
      xlab = xlab,
      ylab = ylab,
      outlier.tagging = outlier.tagging,                    # whether outlines need to be tagged
      outlier.label = !!outlier.label,                      # variable to be used for tagging outliers
      outlier.coef = 2,
      pairwise.comparisons = TRUE,
      pairwise.display = "all",
      results.subtitle = results.subtitle,
      type = type,
      bf.message = FALSE, 
      p.adjust.method = "none",
      point.path = point.path,
      ggtheme = ggprism::theme_prism(),
      # package = "RColorBrewer",  # "ggsci",
      # palette = "Dark",         # "default_jco",
      violin.args = list(width = 0.9, alpha = 0.2, size = 1, color = "black"),
      centrality.plotting = TRUE,
      centrality.type = "parameteric",
      centrality.point.args = list(size = 5, color = "darkred"),
      centrality.label.args = centrality.label.args,
      ggplot.component = list(
        theme(
          plot.title = element_text(hjust = 0, size = 16),
          plot.subtitle = element_text(hjust = 0, size = 12), 
          plot.caption = element_text(hjust = 0, size = 12), 
          text = element_text(size = 14)
      ))
    ) + scale_colour_grey(start = 0.2, end = 0.2) +  # hacky way to change point color
    ylim(0, 100) +
    scale_y_continuous(...)
}

# e.g.
# my_ggwithinstats2(full_data_output_clean, x = condition, y = score, outlier.label = id, gamestate = 10,
#                   time_lim = 20, xlab = "Condition", ylab = "score")
                   

3.1 Check balance

3.1.1 All participants

counts_id_condord <-
  full_data_output_clean %>%
  dplyr::count(id, condition, order)

counts_id_condord %>%      # Participant 41 has 2 bot conditions: order = 1 and 1bis
  print(n = Inf)

counts_id_condord %>%
  dplyr::select(condition, order) %>%
  table() %>%
  knitr::kable(caption = "Order")

Order

	1.0	1bis	2.0
bot	15	1	21
social	28	0	8

3.1.2 Participants with both conditions

# Participant 41 has 2 bot conditions: order = 1 and 1bis
ids_full_subj <-
  full_data_output_clean %>%
  dplyr::filter(order != "1bis") %>%   # exclude subj 41
  group_by(id, condition) %>%
  summarise(count = n()) %>%
  dplyr::filter(n() > 1) %>%
  dplyr::pull(id) %>%
  unique()

full_data_output_clean %>%
  dplyr::filter(id %in% ids_full_subj) %>%
  dplyr::count(id, condition, order) %>%
  dplyr::select(condition, order) %>%
  table() %>%
  knitr::kable(caption = "Order")

Order

	1.0	2.0
bot	8	21
social	21	8

3.2 Individual growth (object not considered)

Notes:

1. Variability is the norm

2. Trend is not easily discernible

plot_growth_state_id(full_data_output_clean, "bot", "10")

plot_growth_state_id(full_data_output_clean, "social", "10")

plot_growth_state_id(full_data_output_clean, "bot", "15")

plot_growth_state_id(full_data_output_clean, "social", "15")

plot_growth_state_id(full_data_output_clean, "bot", "16")

plot_growth_state_id(full_data_output_clean, "social", "16")

plot_growth_state_id(full_data_output_clean, "bot", "17")

plot_growth_state_id(full_data_output_clean, "social", "17")

plot_growth_state_id(full_data_output_clean, "bot", "18")

plot_growth_state_id(full_data_output_clean, "social", "18")

plot_growth_state_id(full_data_output_clean, "bot", "19")

plot_growth_state_id(full_data_output_clean, "social", "19")

3.3 Individual growth (object not considered)

Red = Loess

Black = Spline regression (1st degree polynomial), knots = every second time point

Notes:

1. Some participants have more trials than others

2. There is a large dip in performance after a somewhat consistent number of trials

cowplot::plot_grid(
  plot_growth_state_loess(full_data_output_clean, "bot", "10") + theme(legend.position="none"),
  plot_growth_state_loess(full_data_output_clean, "social", "10") + theme(legend.position="none"),
  nrow = 2
)

cowplot::plot_grid(
  plot_growth_state_loess(full_data_output_clean, "bot", "15") + theme(legend.position="none"),
  plot_growth_state_loess(full_data_output_clean, "social", "15") + theme(legend.position="none"),  
  nrow = 2
)

cowplot::plot_grid(
  plot_growth_state_loess(full_data_output_clean, "bot", "16") + theme(legend.position="none"),
  plot_growth_state_loess(full_data_output_clean, "social", "16") + theme(legend.position="none"),  
  nrow = 2
)

cowplot::plot_grid(
  plot_growth_state_loess(full_data_output_clean, "bot", "17") + theme(legend.position="none"),
  plot_growth_state_loess(full_data_output_clean, "social", "17") + theme(legend.position="none"),  
  nrow = 2
)

cowplot::plot_grid(
  plot_growth_state_loess(full_data_output_clean, "bot", "18") + theme(legend.position="none"),
  plot_growth_state_loess(full_data_output_clean, "social", "18") + theme(legend.position="none"), 
  nrow = 2
)

  
cowplot::plot_grid(
  plot_growth_state_loess(full_data_output_clean, "bot", "19") + theme(legend.position="none"),
  plot_growth_state_loess(full_data_output_clean, "social", "19") + theme(legend.position="none"), 
  nrow = 2
)

3.4 Alternating GameStates 10 and 17 for each participant by condition

3.4.1 All participans

plot_growth_state1017_id(full_data_output_clean)

3.4.2 Partcipants with both conditions

full_data_output_clean %>%
  dplyr::filter(id %in% ids_full_subj) %>%
  plot_growth_state1017_id()

3.5 Individual average scores (mean)

Notes:

1. These are trial-limited (limit is set at 5 trials)

2. But: do not take condition order or markerType into consideration. Also, n refers to gamestate observations not ids.

my_ggwithinstats2(full_data_output_clean, x = condition, y = score, outlier.label = id, gamestate = 10,
                  time_lim = 5, xlab = "Condition", ylab = "score") %>%
  suppressMessages()

my_ggwithinstats2(full_data_output_clean, x = condition, y = score, outlier.label = id, gamestate = 15,
                  time_lim = 5, xlab = "Condition", ylab = "score") %>%
  suppressMessages()

my_ggwithinstats2(full_data_output_clean, x = condition, y = score, outlier.label = id, gamestate = 16,
                  time_lim = 5, xlab = "Condition", ylab = "score") %>%
  suppressMessages()

my_ggwithinstats2(full_data_output_clean, x = condition, y = score, outlier.label = id, gamestate = 17,
                  time_lim = 5, xlab = "Condition", ylab = "score") %>%
  suppressMessages()

my_ggwithinstats2(full_data_output_clean, x = condition, y = score, outlier.label = id, gamestate = 18,
                  time_lim = 5, xlab = "Condition", ylab = "score") %>%
  suppressMessages()

my_ggwithinstats2(full_data_output_clean, x = condition, y = score, outlier.label = id, gamestate = 19,
                  time_lim = 5, xlab = "Condition", ylab = "score") %>%
  suppressMessages()

3.5.1 GameState 19, only first object, individual level average

Order is not accounted for

plot_gs19_fisrt <- 
  full_data_output_clean %>%
  dplyr::select(id, condition, score, newGameState_clean, markerType) %>%      
  dplyr::filter(newGameState_clean == "19") %>%
  dplyr::group_by(id, condition) %>%  
  dplyr::mutate(first_marker = dplyr::if_else(markerType == dplyr::first(markerType), "yes", "no")) %>%  
  dplyr::filter(first_marker == "yes") %>%
  dplyr::mutate(time = dplyr::row_number()) %>%
    ggplot(aes(x = time, y = score)) +
    geom_line() +
    # facet_wrap(score ~ condition, strip.position = "top") +
    # facet_grid(condition ~ id) +    
    facet_grid(rows = vars(id), cols = vars(condition)) + 
    ylim(0, 100) +
    scale_x_continuous(breaks = 1:16) +
    ggtitle(paste0("Game state: ", "19")) +
    theme_bw() 

suppressMessages(print(plot_gs19_fisrt))

full_data_output_clean %>%
dplyr::select(id, condition, score, newGameState_clean, markerType) %>%      
dplyr::filter(newGameState_clean == "19") %>%
dplyr::group_by(id, condition) %>%  
dplyr::mutate(first_marker = dplyr::if_else(markerType == dplyr::first(markerType), "yes", "no")) %>%  
dplyr::filter(first_marker == "yes") %>%
dplyr::summarise(mean_score = mean(score, na.rm = TRUE)) %>%
  ggstatsplot::ggwithinstats(
    x = condition,
    y = mean_score,
    outlier.tagging = TRUE,                   
    outlier.label = id, 
    title = "GameState: 19"
  )

4 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
[4] LC_NUMERIC=C                      LC_TIME=Romanian_Romania.1250    
system code page: 1252

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

other attached packages:
 [1] rio_0.5.29         ggstatsplot_0.8.0  cowplot_1.1.1      scales_1.2.0       ggpubr_0.4.0       summarytools_1.0.0
 [7] rstatix_0.7.0      broom_0.7.11       psych_2.1.9        forcats_0.5.1      stringr_1.4.0      dplyr_1.0.9       
[13] purrr_0.3.4        readr_2.0.1        tidyr_1.1.3        tibble_3.1.7       ggplot2_3.3.5      tidyverse_1.3.1   
[19] papaja_0.1.0.9997  pacman_0.5.1      

loaded via a namespace (and not attached):
  [1] readxl_1.3.1              pairwiseComparisons_3.1.6 backports_1.2.1           plyr_1.8.6                gmp_0.6-2                
  [6] crosstalk_1.1.1           kSamples_1.2-9            ipmisc_6.0.2              TH.data_1.0-10            pryr_0.1.5               
 [11] digest_0.6.28             SuppDists_1.1-9.7         htmltools_0.5.2           magick_2.7.3              fansi_0.5.0              
 [16] magrittr_2.0.1            checkmate_2.0.0           memoise_2.0.0             paletteer_1.4.0           tzdb_0.1.2               
 [21] openxlsx_4.2.4            modelr_0.1.8              matrixStats_0.60.1        sandwich_3.0-1            colorspace_2.0-3         
 [26] rvest_1.0.2               ggrepel_0.9.1             haven_2.4.3               xfun_0.30                 prismatic_1.0.0          
 [31] tcltk_4.1.0               crayon_1.5.1              jsonlite_1.8.0            zeallot_0.1.0             survival_3.2-13          
 [36] zoo_1.8-9                 glue_1.6.2                gtable_0.3.0              emmeans_1.6.3             MatrixModels_0.5-0       
 [41] statsExpressions_1.1.0    car_3.0-11                Rmpfr_0.8-4               abind_1.4-5               rapportools_1.0          
 [46] mvtnorm_1.1-2             DBI_1.1.1                 PMCMRplus_1.9.0           Rcpp_1.0.7                xtable_1.8-4             
 [51] performance_0.7.3         tmvnsim_1.0-2             foreign_0.8-81            DT_0.19                   htmlwidgets_1.5.3        
 [56] datawizard_0.2.0.1        httr_1.4.3                ellipsis_0.3.2            farver_2.1.0              pkgconfig_2.0.3          
 [61] reshape_0.8.8             sass_0.4.1                multcompView_0.1-8        dbplyr_2.1.1              utf8_1.2.2               
 [66] labeling_0.4.2            effectsize_0.4.5          tidyselect_1.1.2          rlang_1.0.2               munsell_0.5.0            
 [71] cellranger_1.1.0          tools_4.1.0               cachem_1.0.6              ggprism_1.0.3             cli_3.0.1                
 [76] generics_0.1.2            evaluate_0.15             fastmap_1.1.0             yaml_2.3.5                BWStest_0.2.2            
 [81] rematch2_2.1.2            knitr_1.39                fs_1.5.2                  zip_2.2.0                 pander_0.6.5             
 [86] WRS2_1.1-3                pbapply_1.4-3             nlme_3.1-152              xml2_1.3.3                correlation_0.7.0        
 [91] compiler_4.1.0            rstudioapi_0.13           curl_4.3.2                ggsignif_0.6.2            reprex_2.0.1             
 [96] bslib_0.3.1               stringi_1.7.4             highr_0.9                 parameters_0.14.0         lattice_0.20-44          
[101] Matrix_1.3-4              vctrs_0.4.1               pillar_1.7.0              lifecycle_1.0.1           mc2d_0.1-21              
[106] jquerylib_0.1.4           estimability_1.3          data.table_1.14.0         insight_0.14.4            patchwork_1.1.1          
[111] R6_2.5.1                  BayesFactor_0.9.12-4.2    codetools_0.2-18          boot_1.3-28               MASS_7.3-54              
[116] gtools_3.9.2              assertthat_0.2.1          withr_2.5.0               mnormt_2.0.2              multcomp_1.4-17          
[121] mgcv_1.8-36               bayestestR_0.11.0         parallel_4.1.0            hms_1.1.1                 grid_4.1.0               
[126] coda_0.19-4               rmarkdown_2.14            carData_3.0-4             lubridate_1.7.10          base64enc_0.1-3          

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com