M2.1 Smells

10 Subject dataset

1 Quick ggwithinstats function

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,
                              ...) {  # ... 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
  }
  
  if(missing(title)) title <- ""
  if(missing(xlab)) xlab <- rlang::as_name(x)
  if(missing(ylab)) ylab <- rlang::as_name(y)
  
  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 = "np",
      bf.message = FALSE, 
      p.adjust.method = "none",
      point.path = point.path,
      ggtheme = ggprism::theme_prism(palette = "black_and_white"),
      # 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 = "black"),
      centrality.path.args = list(color = "black", size = 1, alpha = 1),
      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(family = "Sans", 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 = "tiff", 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)

# Fast tiff save
fast_tiffsave <- function(plot, path = NULL,
                          units = "in", res = 300, width = 5, height = 5, ...){ 
  plot_name <- deparse(substitute(plot))
  tiff(filename = file.path(path, paste0(plot_name, ".", "tiff")),
       units = units, res = res,
       width = width, height = height,
       ...
  )
  plot(plot)
  dev.off()
}  # use: fast_tiffsave(jrad_ox_p, path = savefolder)

# Errors with ggplot2  --- can use this to save:
# Cairo::Cairo(
#   width = 5, 
#   height = 5, 
#   file = file.path(savefolder, paste0("jrad_ox_p", ".", "tiff")),
#   type = "png", 
#   bg =  "white",    # "transparent" 
#   dpi = 300,
#   units = "in"
# )
# plot(jrad_ox_p) 
# dev.off()

2 Read data

folder <- "C:/Users/Mihai/Desktop/R Notebooks/notebooks/M2-report"
file <- "Date M2.1mirosuri.xlsx"

# savefolder <- "C:/Users/Mihai/Desktop/R Notebooks/notebooks/o1b-report-behavior/Art"

data <- rio::import(file.path(folder, file), which = 1)

data <- 
  data %>%
  dplyr::mutate(timp = factor(timp, levels = c("Pre", "Post"))) %>%
  dplyr::mutate(ID = as.factor(ID))

3 Data

data %>%
  DT::datatable(                                  # excel downloadable  DT table
    extensions = 'Buttons',
    options = list(pageLength = 6,
                   scrollX = '500px', 
                   dom = 'Bfrtip', 
                   buttons = c('excel', "csv"))
  )

Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

4 Descriptives and Plots

# Descriptives
var_names <- colnames(data)[-c(1:2)]

data %>%
  dplyr::group_by(timp) %>%
  dplyr::select(-ID) %>%
  rstatix::get_summary_stats(type = "common") %>%
  dplyr::arrange(match(variable, var_names)) %>%
  print(n = Inf)

# Plots
# data %>%
#   group_by(ID) %>%
#   my_ggwithinstats2(
#     x = timp,
#     y = val_cafea,
#     outlier.label = ID, 
#     centrality.label.args = FALSE,
#     breaks = seq(from = 1, to = 7, by = 1),
#     limits = c(4, 7)
#   ) # %>%fast_tiffsave(., path = savefolder)


# Run in loop
var_names <- colnames(data)[-c(1:2)]
graph_list <- list()

for (var in var_names) {
  graph_list[[var]] <-
    data %>%
      group_by(ID) %>%
      my_ggwithinstats2(
        x = timp,
        y = !! rlang::sym(var),
        outlier.label = ID,
        centrality.label.args = FALSE,
        breaks = seq(from = 1, to = 7, by = 1),
        limits = c(4, 7)
  )
}

library(gridExtra)
do.call("grid.arrange", c(graph_list[1:3], ncol = 1))

do.call("grid.arrange", c(graph_list[4:6], ncol = 1))

do.call("grid.arrange", c(graph_list[7:9], ncol = 1))

do.call("grid.arrange", c(graph_list[10:12], ncol = 1))

do.call("grid.arrange", c(graph_list[13:15], ncol = 1))

do.call("grid.arrange", c(graph_list[16:18], ncol = 1))

do.call("grid.arrange", c(graph_list[19:21], ncol = 1))

do.call("grid.arrange", c(graph_list[22:24], ncol = 1))

5 Permutation test of symmetry

library(coin) # https://rcompanion.org/handbook/K_01.html

# coin::symmetry_test(val_cafea ~ timp | ID, data = data)

# Run in loop
var_names <- colnames(data)[-c(1:2, 22:24)]

for (var in var_names) {
  # data_perm <-
  #   data %>%
  #   dplyr::group_by(ID) %>%
  #   dplyr::select(ID, timp, dplyr::any_of(var)) %>%
  #   tidyr::drop_na(dplyr::any_of(var)) %>%
  #   dplyr::filter(n() == 2)
  
  formula <- as.formula(paste0(var, " ~ timp | ID"))
  tryCatch({
    coin::symmetry_test(formula, data = data) %>% print()
  }, error=function(e){}) 
}

    Asymptotic General Symmetry Test

data:  val_cafea by timp (Pre, Post) 
     stratified by ID
Z = -1.4142, p-value = 0.1573
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  viv_cafea by timp (Pre, Post) 
     stratified by ID
Z = -1.3868, p-value = 0.1655
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  rel_cafea by timp (Pre, Post) 
     stratified by ID
Z = -2.1974, p-value = 0.02799
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  val_vanilie by timp (Pre, Post) 
     stratified by ID
Z = NaN, p-value = NA
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  viv_vanilie by timp (Pre, Post) 
     stratified by ID
Z = -0.65465, p-value = 0.5127
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  rel_vanilie by timp (Pre, Post) 
     stratified by ID
Z = -1.4142, p-value = 0.1573
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  val_vin by timp (Pre, Post) 
     stratified by ID
Z = -1.4142, p-value = 0.1573
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  viv_vin by timp (Pre, Post) 
     stratified by ID
Z = -1.4, p-value = 0.1615
alternative hypothesis: two.sided


    Asymptotic General Symmetry Test

data:  rel_vin by timp (Pre, Post) 
     stratified by ID
Z = -2.2678, p-value = 0.02334
alternative hypothesis: two.sided

6 Session Info

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com