A10

Report

1 Define functions

## Define function that recodes to numeric, but watches out to coercion to not introduce NAs
colstonumeric <- function(df){
  tryCatch({
    df_num <- as.data.frame(
      lapply(df,
             function(x) { as.numeric(as.character(x))})) 
  },warning = function(stop_on_warning) {
    message("Stoped the execution of numeric conversion: ", conditionMessage(stop_on_warning))
  }) 
}
##
## Define function that reverse codes items
ReverseCode <- function(df, tonumeric = FALSE, min = NULL, max = NULL) {
  if(tonumeric) df <- colstonumeric(df)
  df <- (max + min) - df
}
##
## Define function that scores only rows with less than 10% NAs (returns NA if all or above threshold percentage of rows are NA); can reverse code if vector of column indexes and min, max are provided.
ScoreLikert <- function(df, napercent = .1, tonumeric = FALSE, reversecols = NULL, min = NULL, max = NULL) {
  reverse_list <- list(reversecols = reversecols, min = min, max = max)
  reverse_check <- !sapply(reverse_list, is.null)
  
  # Recode to numeric, but watch out to coercion to not introduce NAs
  colstonumeric <- function(df){
    tryCatch({
      df_num <- as.data.frame(
        lapply(df,
               function(x) { as.numeric(as.character(x))})) 
    },warning = function(stop_on_warning) {
      message("Stoped the execution of numeric conversion: ", conditionMessage(stop_on_warning))
    }) 
  }
  
  if(tonumeric) df <- colstonumeric(df)
  
  if(all(reverse_check)){
    df[ ,reversecols] <- (max + min) - df[ ,reversecols]
  }else if(any(reverse_check)){
    stop("Insuficient info for reversing. Please provide: ", paste(names(reverse_list)[!reverse_check], collapse = ", "))
  }
  
  ifelse(rowSums(is.na(df)) > ncol(df) * napercent,
         NA,
         rowSums(df, na.rm = TRUE) * NA ^ (rowSums(!is.na(df)) == 0)
  )
}
##

my_ggwithinstats <- function(data, title, x, y, outlier.label, xlab, ylab) {
  x <- rlang::enquo(x)
  y <- rlang::enquo(y)
  outlier.label <- rlang::enquo(outlier.label)
  
  data %>%
    ggstatsplot::ggwithinstats(
      x = !!x,
      y = !!y,
      title = title,
      xlab = xlab,
      ylab = ylab,
      outlier.tagging = TRUE,            # whether outliers need to be tagged
      outlier.label = !!outlier.label,   # variable to be used for tagging outliers
      outlier.coef = 2,
      pairwise.comparisons = TRUE,
      pairwise.display = "significant",
      results.subtitle = TRUE,
      type = "parametric",
      bf.message = FALSE, 
      p.adjust.method = "none",
      point.path = TRUE,
      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.point.args = list(size = 5, color = "darkred"),
      centrality.label.args = list(size = 3, nudge_x = 0.2, segment.linetype = 5, fill = "#FFF8E7"), 
      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
}

# For publication
my_ggwithinstats2 <- function(data, title, x, y, 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(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 = !!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
    scale_y_continuous(...)
}

# Fast ggsave - saves plot with filename of R plot object
fast_ggsave <- function(plot, device = "png", path = NULL,
                        units = "in", dpi = 300, width = 5, height = 5, ...){ 
  plot_name <- deparse(substitute(plot))
  ggplot2::ggsave(filename = paste0(plot_name, ".", device), plot = plot,
                  device = device, path = path,
                  units = units, dpi = dpi,
                  width = width, height = height,
                  ...
  )
  
} # use: fast_ggsave(jrad_ox_p, path = savefolder)

2 Read, Clean, Recode

id_df <- rio::import(file.path(folder, file),
                               skip = -1, which = "Iduri")

2.1 Score APS

2.2 APS

data %>%
  dplyr::filter(Cond == "experimental") %>%
  dplyr::filter(PrePost %in% c("Pre", "Post")) %>%
  my_ggwithinstats2(x = PrePost, y = APS_Total, outlier.label = id, type = "np",  
                    xlab = "", ylab = "APS",
                    title = "Experimental")

Scale for 'colour' is already present. Adding another scale for 'colour', which will replace the existing scale.

data %>%
  dplyr::filter(Cond == "ctrl") %>%
  dplyr::filter(PrePost %in% c("Pre", "Post")) %>%
  my_ggwithinstats2(x = PrePost, y = APS_Total, outlier.label = id, type = "np",
                    xlab = "", ylab = "APS",
                    title = "Control")

Scale for 'colour' is already present. Adding another scale for 'colour', which will replace the existing scale.

data %>%
  dplyr::filter(Cond == "experimental") %>%
  group_by(id) %>%
  dplyr::filter(!n() < 3) %>%                     # filter out those without F_up
  my_ggwithinstats2(x = PrePost, y = APS_Total, outlier.label = id, type = "np",  
                    xlab = "", ylab = "APS",
                    title = "Experimental")

Scale for 'colour' is already present. Adding another scale for 'colour', which will replace the existing scale.

data %>%
  dplyr::filter(Cond == "ctrl") %>%
  group_by(id) %>%
  dplyr::filter(!n() < 3) %>%                     # filter out those without F_up
  my_ggwithinstats2(x = PrePost, y = APS_Total, outlier.label = id, type = "np",
                    xlab = "", ylab = "APS",
                    title = "Control")

Scale for 'colour' is already present. Adding another scale for 'colour', which will replace the existing scale.

3 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] ggstatsplot_0.8.0 rio_0.5.27        scales_1.1.1      ggpubr_0.4.0      rstatix_0.7.0     broom_0.7.9       forcats_0.5.1     stringr_1.4.0    
 [9] purrr_0.3.4       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 pacman_0.5.1     
[17] dplyr_1.0.7      

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] knitr_1.33                multcomp_1.4-17           data.table_1.14.0         rpart_4.1-15              hardhat_0.1.6            
 [11] generics_0.1.0            GPfit_1.0-8               TH.data_1.0-10            future_1.22.1             correlation_0.7.0        
 [16] tzdb_0.1.2                xml2_1.3.2                lubridate_1.7.10          assertthat_0.2.1          gower_0.2.2              
 [21] WRS2_1.1-3                xfun_0.25                 hms_1.1.0                 jquerylib_0.1.4           evaluate_0.14            
 [26] fansi_0.5.0               dbplyr_2.1.1              readxl_1.3.1              igraph_1.2.6              DBI_1.1.1                
 [31] tmvnsim_1.0-2             Rsolnp_1.16               htmlwidgets_1.5.3         reshape_0.8.8             kSamples_1.2-9           
 [36] stats4_4.1.0              Rmpfr_0.8-4               paletteer_1.4.0           ellipsis_0.3.2            backports_1.2.1          
 [41] pbivnorm_0.6.0            insight_0.14.4            RcppParallel_5.1.4        pwr_1.3-0                 vctrs_0.3.8              
 [46] abind_1.4-5               cachem_1.0.6              withr_2.4.2               checkmate_2.0.0           emmeans_1.6.3            
 [51] fdrtool_1.2.16            parsnip_0.1.7             mnormt_2.0.2              cluster_2.1.2             mi_1.0                   
 [56] crayon_1.4.1              labeling_0.4.2            recipes_0.1.16            pkgconfig_2.0.3           SuppDists_1.1-9.5        
 [61] nlme_3.1-152              statsExpressions_1.1.0    nnet_7.3-16               rlang_0.4.11              globals_0.14.0           
 [66] lifecycle_1.0.1           MatrixModels_0.5-0        sandwich_3.0-1            kutils_1.70               modelr_0.1.8             
 [71] cellranger_1.1.0          datawizard_0.2.0.1        Matrix_1.3-4              yardstick_0.0.8           regsem_1.8.0             
 [76] mc2d_0.1-21               carData_3.0-4             boot_1.3-28               zoo_1.8-9                 reprex_2.0.1             
 [81] base64enc_0.1-3           png_0.1-7                 PMCMRplus_1.9.0           parameters_0.14.0         pROC_1.18.0              
 [86] afex_1.0-1                tune_0.1.6                workflows_0.2.3           multcompView_0.1-8        arm_1.11-2               
 [91] parallelly_1.27.0         jpeg_0.1-9                rockchalk_1.8.144         ggsignif_0.6.2            memoise_2.0.0            
 [96] magrittr_2.0.1            plyr_1.8.6                compiler_4.1.0            RColorBrewer_1.1-2        lme4_1.1-27.1            
[101] snakecase_0.11.0          cli_3.0.1                 lmerTest_3.1-3            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               fs_1.5.0                  XML_3.99-0.7              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                lattice_0.20-44          
[176] bslib_0.3.0               dials_0.0.9               numDeriv_2016.8-1.1       curl_4.3.2                gtools_3.9.2             
[181] zip_2.2.0                 openxlsx_4.2.4            survival_3.2-13           rmarkdown_2.10            qgraph_1.6.9             
[186] munsell_0.5.0             semPlot_1.1.2             rsample_0.1.0             iterators_1.0.13          haven_2.4.3              
[191] reshape2_1.4.4            gtable_0.3.0              bayestestR_0.11.0        

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com