STAD - Demo and Imitation Metrics

Test Two Elderly

1 Run demoimitMetrics_cleantable script

folder <- "C:/Users/Mihai/Desktop/R Notebooks/notebooks/STAD-demoimitMetrics"
setwd(folder)


########################################################

# Read clean table
sessions_clean_data <- readRDS("sessions_clean2batrani.RDS")

# Define function
list_to_nested <- function(list, group_var){
  list %>%
    do.call(dplyr::bind_rows, .) %>%
    dplyr::group_by( {{ group_var }} ) %>%
    tidyr::nest()
}

# Lists of recordings to nested data frames
sessions_clean_data_df <- list_to_nested(sessions_clean_data, file)

sessions_clean_data_df <-
  sessions_clean_data_df %>%
  dplyr::ungroup() %>%       # careful, the df is already grouped
  dplyr::mutate(id = dplyr::row_number())

full_data_output <- sessions_clean_data_df %>%
  dplyr::relocate(id) %>%
  tidyr::unnest(data)


# Some additional tidying
vars_exclude <- c(
  # General    
  "InputY", "InputX", "xPos", "yPos", "zPos", "xRot", "yRot", "zRot", "wRot", "markerX", "markerY", "markerZ",
  # Demo
  "demoMetrics_playerPosition_x", "demoMetrics_playerPosition_y", "demoMetrics_playerPosition_z", "demoMetrics_markerPosition_x",  
  "demoMetrics_markerPosition_y", "demoMetrics_markerPosition_z", "demoMetrics_distanceFromMarker", 
  # Imit
  "imitMetrics_playerPosition_x", "imitMetrics_playerPosition_y", "imitMetrics_playerPosition_z", "imitMetrics_markerPosition_x", 
  "imitMetrics_markerPosition_y", "imitMetrics_markerPosition_z", "imitMetrics_distanceFromMarker", 
  # syncKey
  "syncKey"
)

full_data_output_clean <- 
  full_data_output %>%
  dplyr::select(-any_of(vars_exclude))


full_data_output_clean <- 
  full_data_output_clean %>%
  dplyr::mutate(demoimitState = dplyr::case_when(newGameState_f %in% 5:11 ~ "Demo",
                                                 newGameState_f %in% 12:20 ~ "Imit",
                                                 TRUE ~ NA_character_)) %>%
  dplyr::mutate(timeStamp_demoimit = dplyr::coalesce(timeStamp_demo, timeStamp_imit), 
                playerType = dplyr::coalesce(demoMetrics_playerType, imitMetrics_playerType),
                markerType = dplyr::coalesce(demoMetrics_markerType, imitMetrics_markerType),
                score = dplyr::coalesce(demoMetrics_score, imitMetrics_score)) %>% 
  dplyr::mutate(who = dplyr::case_when(stringr::str_detect(file, "PLAYER_1") ~ 1L,     # changes output_file_clean to file
                                       stringr::str_detect(file, "PLAYER_2") ~ 2L,   
                                       TRUE ~ NA_integer_)) %>%
  dplyr::select(-c(demoMetrics_playerType, imitMetrics_playerType, demoMetrics_markerType, imitMetrics_markerType, demoMetrics_score, imitMetrics_score,
                   timeStamp_demo, timeStamp_imit))


# Keep only data from the actual player (where playerType == who)
full_data_output_clean <-
  full_data_output_clean %>%
  dplyr::filter(playerType == who)


# Exclude multiple timpeStamp_demoimit per timeStamp match (only adjusting tolerance will lose data as matches are not exact)
full_data_output_clean <-
  full_data_output_clean %>%
  dplyr::mutate(timeStamp_diff = abs(timeStamp - timeStamp_demoimit)) %>%
  dplyr::group_by(id, timeStamp_demoimit) %>%
  dplyr::slice_min(timeStamp_diff) %>%
  dplyr::ungroup() %>%
  dplyr::group_by(id, timeStamp) %>%
  dplyr::slice_min(timeStamp_diff) %>%
  dplyr::ungroup()

# Make newGameState_clean --- a bit hacky 
full_data_output_clean <-
  full_data_output_clean %>%
  dplyr::mutate(
    newGameState_clean = 
      dplyr::case_when(newGameState_f == "9" ~ 10L,             # is 9 or 14 when it should be 10 or 15
                       newGameState_f == "14" ~ 15L,
                       newGameState_f %in% as.character(c(10, 15:19)) ~ as.integer(newGameState_f),
                       TRUE ~ NA_integer_
      ),
    newGameState_clean =                                 # some matched the previous frame so GameStates repeat
      dplyr::if_else(newGameState_clean == dplyr::lag(newGameState_clean) & !is.na(dplyr::lag(newGameState_clean)), 
                     newGameState_clean + 1L, 
                     newGameState_clean
     ),
    newGameState_clean =                                 # GameState 10 following another 10 now became 11
      dplyr::if_else(newGameState_clean == 11L, 10L, newGameState_clean)
  ) %>%                                          # !CAREFUL columns computed based on newGameState_f like demoimitState now may be wrong
  dplyr::mutate(demoimitState_clean = dplyr::case_when(newGameState_clean %in% 5:11 ~ "Demo",
                                                       newGameState_clean %in% 12:20 ~ "Imit",
                                                       TRUE ~ NA_character_))

# Check GameStates
check_df <-
  full_data_output_clean %>%
  dplyr::group_by(id) %>%
  dplyr::mutate(grp = as.integer(gl(n(), 6, n()))) %>%    # group every 6 rows
  dplyr::group_by(id, grp) %>%
  dplyr::summarise(pattern = paste0(newGameState_f, collapse = " "),
                   pattern_clean = paste0(newGameState_clean, collapse = " "))

1.1 Check GamesStates

check_df

2 Data

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, gamestate, time_lim = 20) {
  data %>%
  dplyr::filter(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("Game state: ", gamestate))
}


plot_growth_state_loess <- function(data, gamestate, time_lim = 20) {
  data %>%
  dplyr::filter(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 = NA) +
    # 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) +
    # tidyquant::geom_ma(ma_fun = SMA, n = 1, color = "black") +
    stat_summary(fun = mean, geom = "line", colour = "black", lty = "dashed") +
    ylim(0, 100) +
    scale_x_continuous(breaks = 1:14) +
    ggtitle(paste0("Game state: ", gamestate)) +
    labs(color = "id")  
}

3.1 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, "10")

plot_growth_state_id(full_data_output_clean, "15")

plot_growth_state_id(full_data_output_clean, "16")

plot_growth_state_id(full_data_output_clean, "17")

plot_growth_state_id(full_data_output_clean, "18")

plot_growth_state_id(full_data_output_clean, "19")

3.2 Individual growth (object not considered)

Red = Loess Black dashed = Simple Mean

plot_growth_state_loess(full_data_output_clean, "10") + theme(legend.position = "none")

plot_growth_state_loess(full_data_output_clean, "15") + theme(legend.position = "none")

plot_growth_state_loess(full_data_output_clean, "16") + theme(legend.position = "none")

plot_growth_state_loess(full_data_output_clean, "17") + theme(legend.position = "none")

plot_growth_state_loess(full_data_output_clean, "18") + theme(legend.position = "none")

plot_growth_state_loess(full_data_output_clean, "19") + theme(legend.position = "none")

3.3 Alternating GameStates 10 and 17 for each participant by condition

full_data_output_clean %>%
  dplyr::filter(newGameState_clean %in% c("10", "17")) %>%
  dplyr::mutate(newGameState_clean = as.factor(newGameState_clean)) %>%  
  dplyr::group_by(id) %>%
  dplyr::mutate(time = dplyr::row_number()) %>%
    ggplot(aes(x = time, y = score)) +
    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")

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 LC_NUMERIC=C                     
[5] 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 rstatix_0.7.0     
 [8] broom_0.7.11       psych_2.1.9        forcats_0.5.1      stringr_1.4.0      dplyr_1.0.9        purrr_0.3.4        readr_2.0.1       
[15] tidyr_1.1.3        tibble_3.1.7       ggplot2_3.3.5      tidyverse_1.3.1    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                 tcltk_4.1.0              
 [31] crayon_1.5.1              jsonlite_1.8.0            zeallot_0.1.0             survival_3.2-13           zoo_1.8-9                
 [36] glue_1.6.2                gtable_0.3.0              emmeans_1.6.3             MatrixModels_0.5-0        statsExpressions_1.1.0   
 [41] car_3.0-11                Rmpfr_0.8-4               abind_1.4-5               rapportools_1.0           mvtnorm_1.1-2            
 [46] DBI_1.1.1                 PMCMRplus_1.9.0           Rcpp_1.0.7                xtable_1.8-4              performance_0.7.3        
 [51] tmvnsim_1.0-2             foreign_0.8-81            DT_0.19                   htmlwidgets_1.5.3         datawizard_0.2.0.1       
 [56] httr_1.4.3                ellipsis_0.3.2            farver_2.1.0              pkgconfig_2.0.3           reshape_0.8.8            
 [61] sass_0.4.1                multcompView_0.1-8        dbplyr_2.1.1              utf8_1.2.2                labeling_0.4.2           
 [66] effectsize_0.4.5          tidyselect_1.1.2          rlang_1.0.2               munsell_0.5.0             cellranger_1.1.0         
 [71] tools_4.1.0               cachem_1.0.6              cli_3.0.1                 generics_0.1.2            fastmap_1.1.0            
 [76] yaml_2.3.5                BWStest_0.2.2             rematch2_2.1.2            knitr_1.39                fs_1.5.2                 
 [81] zip_2.2.0                 pander_0.6.5              WRS2_1.1-3                pbapply_1.4-3             nlme_3.1-152             
 [86] xml2_1.3.3                correlation_0.7.0         compiler_4.1.0            rstudioapi_0.13           curl_4.3.2               
 [91] ggsignif_0.6.2            reprex_2.0.1              bslib_0.3.1               stringi_1.7.4             parameters_0.14.0        
 [96] lattice_0.20-44           Matrix_1.3-4              vctrs_0.4.1               pillar_1.7.0              lifecycle_1.0.1          
[101] mc2d_0.1-21               jquerylib_0.1.4           estimability_1.3          data.table_1.14.0         insight_0.14.4           
[106] patchwork_1.1.1           R6_2.5.1                  BayesFactor_0.9.12-4.2    codetools_0.2-18          MASS_7.3-54              
[111] gtools_3.9.2              assertthat_0.2.1          withr_2.5.0               mnormt_2.0.2              multcomp_1.4-17          
[116] mgcv_1.8-36               bayestestR_0.11.0         parallel_4.1.0            hms_1.1.1                 grid_4.1.0               
[121] coda_0.19-4               carData_3.0-4             lubridate_1.7.10          base64enc_0.1-3          

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com