O1A Report

Final Report

1 Load data

# Read
file = "DATE O1A Complete.xlsx"
Date <- readxl::read_xlsx(file, sheet = "Date zilnice", skip = 5, col_names = FALSE)
Date_sop <- readRDS("O1a_Processed_SOP.RDS")

1.1 Processing data

# Clean
varnames <- c("Nr_crt", "ID", "Nume_Prenume", "Zi", "Vas_stres_pre", "Vas_bine_pre",
             sprintf("Stais_pre_%01d", seq(1,20)),
             "SOP",
             "IOS_mama", "IOS_tata", "IOS_iubit", "IOS_prieten", "IOS_personalitate",
             "Vas_rel_global", "Vas_rel_arousal",
             "CRQ_1", "CRQ_2", "CRQ_3", "CRQ_4", "CRQ_5", "CRQ_6",
             "Vas_stres_post", "Vas_bine_post",
             sprintf("Stais_post_%01d", seq(1,20))
)
names(Date) <- varnames   # nume noi
Date <- Date[-c(1:2),]    # scoatem randurile cu numele precedente
Date$Nr_crt <- 1:nrow(Date)   # era gol, asa ca numerotam randurile ca sa avem acesta variabila 
# Process NAs
Date <- Date %>% 
    na_if("na") %>%  
    mutate(NA_per_row = rowSums(is.na(.)))     # count NAs by row
Date <- Date %>% 
    filter(NA_per_row < 20)         # arbitrary cutoff for NAs on columns ... it is normal to have 4 NAs for all columns
# Convert to numeric
varsnumeric <- c("Zi", "Vas_stres_pre", "Vas_bine_pre",
                 sprintf("Stais_pre_%01d", seq(1,20)),
                 "IOS_mama", "IOS_tata", "IOS_iubit", "IOS_prieten", "IOS_personalitate",
                 "Vas_rel_global", "Vas_rel_arousal",
                 "CRQ_1", "CRQ_2", "CRQ_3", "CRQ_4", "CRQ_5", "CRQ_6",
                 "Vas_stres_post", "Vas_bine_post",
                  sprintf("Stais_post_%01d", seq(1,20)))
Date <- Date %>% 
  mutate_at(varsnumeric, as.numeric)
# which(Date$Stais_post_11 == 47)    # typo Stais_post_11 value of 47 -> corrected to 4
Date$Stais_post_11[Date$Stais_post_11 == 47] <- 4

1.2 Compute new variables

# Compute new variables 
Conditie <- Date %>% 
    select(Nr_crt, ID, IOS_mama, IOS_tata, IOS_iubit, IOS_prieten, IOS_personalitate) %>% 
    gather(type, value, -c(Nr_crt, ID)) %>% 
    mutate(Conditie = ifelse(!is.na(value), type, NA) ) %>%
    mutate(Conditie = str_replace(Conditie, "IOS_", "")) %>%
    arrange(Nr_crt) %>%
    select(Conditie) %>% na.omit() 
Date$Conditie <- Conditie$Conditie     # tidyverse returns tibble, must do this
IOS <- Date %>% 
  mutate(IOS = coalesce(IOS_mama, IOS_tata, IOS_iubit, IOS_prieten, IOS_personalitate)) %>%
  select(IOS)
Date$IOS <- IOS$IOS   # tidyverse returns tibble, must do this
rm(Conditie, IOS)    # remove 2 tibbles
# Scoring Stai   (convert numeric - VAS)
itemiVAS <- c(5, 6, 41, 42)
itemiStaiS_pre <- 7:26
itemiStaiS_post <- 43:62
ReversedItems <- c(1,2,5,8,10,11,15,16,19,20)
Date <- Date %>%                 
  replace(Date == "na", NA) %>%        # scimbam codarea cu na a Doinei
  mutate_at(vars(itemiStaiS_pre), funs(as.numeric)) %>%        # facem coloanele numerice pt STAI
  mutate_at(vars(itemiStaiS_post), funs(as.numeric)) %>% 
  mutate_at(vars(itemiVAS), funs(as.numeric))
Date[ ,itemiStaiS_pre[ReversedItems]] = 5 - Date[ ,itemiStaiS_pre[ReversedItems]]
Date[ ,itemiStaiS_post[ReversedItems]] = 5 - Date[ ,itemiStaiS_post[ReversedItems]]
Date$StaiS_pre = rowSums(Date[ ,itemiStaiS_pre], na.rm=T ) * NA ^ (rowSums(!is.na(Date[ ,itemiStaiS_pre])) == 0)
Date$StaiS_post = rowSums(Date[ ,itemiStaiS_post], na.rm=T ) * NA ^ (rowSums(!is.na(Date[ ,itemiStaiS_post])) == 0)

1.3 Merge with SOP

# warning + FALSE for joining character vector and factor, coercing into character vector automatically
Date_formerge <-
  Date %>%
  mutate(ID = word(ID, 1))
Date_sop_formerge <-
  Date_sop %>%
  select(FileNames, ID, Conditie, PrePost, 
         Ones:rThrees45) %>%
  gather(variable, value, Ones:rThrees45) %>%
  unite(VarCond, variable, PrePost) %>%
  spread(VarCond, value) %>%
  group_by(ID, Conditie) %>%
  summarise_all(funs(first(.[!is.na(.)])))             # this collapses the rows with NA
  
Date_merged <- left_join(Date_formerge, Date_sop_formerge, by = c("ID", "Conditie"))

1.4 Table of derived variables and SOP

varnottable <- c("Nume_Prenume", "NA_per_row",
                 "IOS_mama", "IOS_tata", "IOS_iubit", "IOS_prieten", "IOS_personalitate",
                 sprintf("Stais_pre_%01d", seq(1,20)), 
                 sprintf("Stais_post_%01d", seq(1,20)))
Date_merged %>%                              
  select(-varnottable) %>%
    DT::datatable(                                  # excel downloadable  DT table
      extensions = 'Buttons',
      options = list(pageLength = 20,
                     scrollX='500px', 
                     dom = 'Bfrtip', 
                     buttons = c('excel', "csv")))

2 SOP

# ## Independent Comparisons (eg for Ones) 
# # Plot indendent 
# ggplot(Date_sop, aes(x = PrePost, y = Ones)) +
#   geom_boxplot() +
#   facet_wrap(~Conditie) +
#   ggpubr::stat_compare_means(method = "t.test", paired = FALSE, comparisons = list(c("Pre","Post")))
# 
# # t test independent
# Date_sop %>% 
#   group_by(Conditie) %>% 
#   do(broom::tidy(t.test(.$Ones ~ .$PrePost, 
#                         mu = 0, 
#                         alt = "two.sided", 
#                         paired = FALSE, 
#                         conf.level = 0.95)))
## Paired Comparisons 
# Filter data for Paired Comparisons 
Date_Paired <- 
  Date_sop %>%
  mutate(PrePost = forcats::fct_relevel(PrePost, 'Pre', 'Post')) %>%               # change level order for plot
  group_by(ID, Conditie) %>%
  filter(n() != 1) %>%                                                             # exclude cases that dont have both Pre and Post data
  ungroup()
## Function for paired comparison plot
sop_paired_plot <- function(data, var, cond){
  var <- rlang::enquo(var)
  cond <- rlang::enquo(cond)
  ggplot(data, aes(x = !!cond, y = !!var)) +
    geom_boxplot() +
    stat_summary(fun.data = mean_se,  colour = "darkred") +
    xlab("") +
    facet_wrap(~Conditie) +
    ggpubr::stat_compare_means(method = "t.test", 
                               paired = TRUE, 
                               comparisons = list(c("Pre", "Post")))              # didn't include comparison list in func args
}
# Function t test paired
sop_paired_t <- function(data, var, cond){
  var <- deparse(substitute(var))
  cond <- deparse(substitute(cond))
  formula <- reformulate(cond, response = var)
  data %>%
    group_by(Conditie) %>%
    do(broom::tidy(t.test(data = ., formula,                                      # careful, this is a formula: var ~ PrePost
                          mu = 0,
                          alt = "two.sided",
                          paired = TRUE,
                          conf.level = 0.95)))
}

2.1 Plots with p values and t test

# Plots and t tests
sop_paired_plot(data = Date_Paired, var = Ones, cond = PrePost)                   # plot Ones 

sop_paired_t(data = Date_Paired, var = Ones, cond = PrePost) %>%                  # t test Ones
  knitr::kable(caption = "Ones", digits = 2, format = 'pandoc')                   # need pandoc to print kable caption

Ones

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	-63.24	-0.62	0.54	28	-271.52	145.04	Paired t-test	two.sided
mama	48.97	0.57	0.57	34	-125.80	223.74	Paired t-test	two.sided
personalitate	47.95	1.13	0.27	37	-38.15	134.04	Paired t-test	two.sided
prieten	-20.22	-0.21	0.84	35	-217.86	177.42	Paired t-test	two.sided
tata	-28.03	-0.23	0.82	35	-271.37	215.31	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = Twos, cond = PrePost)

sop_paired_t(data = Date_Paired, var = Twos, cond = PrePost) %>%
  knitr::kable(caption = "Twos", digits = 2, format = 'pandoc')                   

Twos

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	54.86	1.86	0.07	28	-5.47	115.20	Paired t-test	two.sided
mama	36.46	2.29	0.03	34	4.06	68.85	Paired t-test	two.sided
personalitate	27.45	1.84	0.07	37	-2.81	57.70	Paired t-test	two.sided
prieten	4.06	0.29	0.78	35	-24.62	32.73	Paired t-test	two.sided
tata	15.25	1.02	0.32	35	-15.21	45.71	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = Threes, cond = PrePost)

sop_paired_t(data = Date_Paired, var = Threes, cond = PrePost) %>%
  knitr::kable(caption = "Threes", digits = 2, format = 'pandoc')

Threes

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	-116.90	-1.20	0.24	28	-317.24	83.45	Paired t-test	two.sided
mama	-188.89	-2.98	0.01	34	-317.67	-60.10	Paired t-test	two.sided
personalitate	-141.29	-2.62	0.01	37	-250.54	-32.04	Paired t-test	two.sided
prieten	-151.56	-1.76	0.09	35	-326.85	23.74	Paired t-test	two.sided
tata	-128.28	-1.18	0.25	35	-348.92	92.37	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = Ones45, cond = PrePost)                 # plot Ones before 45s

sop_paired_t(data = Date_Paired, var = Ones45, cond = PrePost) %>%                # t test Ones before 45s
  knitr::kable(caption = "Ones45", digits = 2, format = 'pandoc')

Ones45

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	7.66	0.38	0.71	28	-33.70	49.01	Paired t-test	two.sided
mama	5.14	0.40	0.69	34	-21.15	31.43	Paired t-test	two.sided
personalitate	7.61	0.48	0.63	37	-24.43	39.64	Paired t-test	two.sided
prieten	-12.25	-0.88	0.38	35	-40.50	16.00	Paired t-test	two.sided
tata	-44.17	-2.46	0.02	35	-80.60	-7.73	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = Twos45, cond = PrePost)

sop_paired_t(data = Date_Paired, var = Twos45, cond = PrePost) %>%
  knitr::kable(caption = "Twos45", digits = 2, format = 'pandoc')

Twos45

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	1.17	0.27	0.79	28	-7.64	9.99	Paired t-test	two.sided
mama	2.63	0.86	0.40	34	-3.61	8.87	Paired t-test	two.sided
personalitate	1.95	0.61	0.54	37	-4.48	8.37	Paired t-test	two.sided
prieten	0.11	0.04	0.97	35	-5.76	5.98	Paired t-test	two.sided
tata	3.86	1.83	0.08	35	-0.42	8.14	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = Threes45, cond = PrePost)

sop_paired_t(data = Date_Paired, var = Threes45, cond = PrePost) %>%
  knitr::kable(caption = "Threes45", digits = 2, format = 'pandoc')

Threes45

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	-20.03	-1.06	0.30	28	-58.67	18.60	Paired t-test	two.sided
mama	-12.89	-0.94	0.35	34	-40.60	14.83	Paired t-test	two.sided
personalitate	-11.89	-0.71	0.48	37	-45.74	21.95	Paired t-test	two.sided
prieten	-1.94	-0.14	0.89	35	-29.47	25.58	Paired t-test	two.sided
tata	16.92	1.10	0.28	35	-14.34	48.17	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = rOnes, cond = PrePost)                  # plot ratio Ones to total presses

sop_paired_t(data = Date_Paired, var = rOnes, cond = PrePost) %>%                 # t test ratio Ones to total presses
  knitr::kable(caption = "rOnes", digits = 2, format = 'pandoc')

rOnes

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	0.00	0.08	0.94	28	-0.07	0.07	Paired t-test	two.sided
mama	0.04	1.19	0.24	34	-0.03	0.12	Paired t-test	two.sided
personalitate	0.03	1.98	0.05	37	0.00	0.07	Paired t-test	two.sided
prieten	0.04	1.18	0.25	35	-0.03	0.10	Paired t-test	two.sided
tata	0.03	0.84	0.40	35	-0.05	0.11	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = rTwos, cond = PrePost)

sop_paired_t(data = Date_Paired, var = rTwos, cond = PrePost) %>%
  knitr::kable(caption = "rTwos", digits = 2, format = 'pandoc')

rTwos

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	0.02	1.74	0.09	28	0	0.05	Paired t-test	two.sided
mama	0.01	2.49	0.02	34	0	0.03	Paired t-test	two.sided
personalitate	0.01	2.15	0.04	37	0	0.02	Paired t-test	two.sided
prieten	0.01	1.58	0.12	35	0	0.02	Paired t-test	two.sided
tata	0.01	1.49	0.15	35	0	0.02	Paired t-test	two.sided

sop_paired_plot(data = Date_Paired, var = rThrees, cond = PrePost)

sop_paired_t(data = Date_Paired, var = rThrees, cond = PrePost) %>%
  knitr::kable(caption = "rThrees", digits = 2, format = 'pandoc')

rThrees

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	-0.02	-0.65	0.52	28	-0.10	0.05	Paired t-test	two.sided
mama	-0.06	-1.57	0.13	34	-0.13	0.02	Paired t-test	two.sided
personalitate	-0.05	-2.36	0.02	37	-0.08	-0.01	Paired t-test	two.sided
prieten	-0.05	-1.37	0.18	35	-0.11	0.02	Paired t-test	two.sided
tata	-0.04	-1.05	0.30	35	-0.12	0.04	Paired t-test	two.sided

3 Session Info

R version 3.5.2 (2018-12-20)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)

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    

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

other attached packages:
 [1] bindrcpp_0.2.2     gridExtra_2.3      plotly_4.8.0       summarytools_0.8.8 DT_0.5             ggpubr_0.2         magrittr_1.5      
 [8] broom_0.5.1        papaja_0.1.0.9842  psych_1.8.10       forcats_0.3.0      stringr_1.3.1      dplyr_0.7.8        purrr_0.2.5       
[15] readr_1.3.0        tidyr_0.8.2        tibble_1.4.2       ggplot2_3.1.0      tidyverse_1.2.1    pacman_0.5.0      

loaded via a namespace (and not attached):
 [1] httr_1.4.0         jsonlite_1.6       viridisLite_0.3.0  modelr_0.1.2       shiny_1.2.0        assertthat_0.2.0   highr_0.7         
 [8] pander_0.6.3       cellranger_1.1.0   yaml_2.2.0         pillar_1.3.1       backports_1.1.3    lattice_0.20-38    glue_1.3.0        
[15] digest_0.6.18      promises_1.0.1     pryr_0.1.4         ggsignif_0.4.0     rvest_0.3.2        colorspace_1.3-2   htmltools_0.3.6   
[22] httpuv_1.4.5       plyr_1.8.4         pkgconfig_2.0.2    haven_2.1.0        xtable_1.8-3       scales_1.0.0       later_0.7.5       
[29] generics_0.0.2     withr_2.1.2        lazyeval_0.2.1     cli_1.0.1          mnormt_1.5-5       crayon_1.3.4       readxl_1.1.0      
[36] mime_0.6           evaluate_0.12      nlme_3.1-137       xml2_1.2.0         foreign_0.8-71     rapportools_1.0    tools_3.5.2       
[43] data.table_1.11.8  hms_0.4.2          matrixStats_0.54.0 munsell_0.5.0      compiler_3.5.2     rlang_0.3.1        RCurl_1.95-4.11   
[50] rstudioapi_0.8     htmlwidgets_1.3    crosstalk_1.0.0    rmarkdown_1.11     bitops_1.0-6       labeling_0.3       gtable_0.2.0      
[57] codetools_0.2-15   R6_2.3.0           lubridate_1.7.4    knitr_1.21         bindr_0.1.1        stringi_1.2.4      parallel_3.5.2    
[64] Rcpp_1.0.0         tidyselect_0.2.5   xfun_0.4          

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com