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)

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 Table of derived variables

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

2 Conditions

## Number of subjects per Condition
Date %>% 
  count(Conditie) %>%
  knitr::kable(caption = "Number of subjects per Condition")

Conditie	n
iubit	32
mama	42
personalitate	43
prieten	40
tata	42

## Means for all variables by Condition
# Date %>% 
#   select(ID, 
#          Vas_rel_global, Vas_rel_arousal, 
#          CRQ_1, CRQ_2, CRQ_3, CRQ_4, CRQ_5, CRQ_6, 
#          Conditie, IOS) %>%
#   group_by(Conditie) %>%
#   summarise_if(.predicate = function(x) is.numeric(x),
#              .funs = funs(mean="mean"))
## Plot CRQ items
my_comparisons <- 
  gtools::combinations(n = length(unique(Date$Conditie)), r = 2, v = Date$Conditie, repeats.allowed = FALSE) %>%
  as.data.frame() %>% 
  mutate_if(is.factor, as.character) %>%
  purrr::pmap(list) %>% 
  lapply(unlist)
  
Date %>% 
  select(ID, Conditie, 
         CRQ_1, CRQ_2, CRQ_3, CRQ_4, CRQ_5, CRQ_6) %>%
  gather(variable, value, CRQ_1:CRQ_6) %>%
  mutate(Conditie = factor(Conditie, levels = sort(unique(Conditie)))) %>%   # relevel just to match combination pattern for comparison
    ggboxplot(x = "Conditie", y = "value", facet.by = "variable" ) + 
    stat_compare_means(comparisons = my_comparisons,            # can't do paired t test because not all arguments have the same length  
                       label = "p.signif", paired = FALSE, method = "t.test",  na.rm = TRUE) +
    scale_x_discrete(labels = abbreviate)

## Plot VAS Rel and IOS
func_boxcomp_cond <- function(var){
    Date %>% 
      select(Conditie, var) %>%
      mutate(Conditie = factor(Conditie, levels = sort(unique(Conditie)))) %>%   # relevel just to match combination pattern for comparison
        ggboxplot(x = "Conditie", y = var, title = var) +
        stat_compare_means(comparisons = my_comparisons,            # can't do paired t test because not all arguments have the same length  
                           label = "p.signif", paired = FALSE, method = "t.test",  na.rm = TRUE)
}
plot_vasglob <- func_boxcomp_cond("Vas_rel_global")
plot_vasarou <- func_boxcomp_cond("Vas_rel_arousal")
plot_ios <- func_boxcomp_cond("IOS")
ggarrange(plot_vasglob, 
          plot_ios, 
          plot_vasarou, 
          ncol = 2, nrow = 2)

3 STAI-Y

3.1 Plots with p values

## STAI plot 
Staimelt <- Date[, c("ID", "Conditie", "StaiS_pre","StaiS_post")] %>% 
  gather("StaiS_pre", "StaiS_post", key = "Stai_cond", value = "value") %>% 
  mutate_at(vars(c(1, 2, 3)), funs(as.factor)) %>% 
  mutate(Stai_cond = factor(Stai_cond, levels = c("StaiS_pre","StaiS_post"))) # %>%    # change factor order for plot pre, post
ggplot(Staimelt, aes(x = Stai_cond, y = value)) +
  geom_boxplot() +
  facet_wrap(~Conditie) +
  ggpubr::stat_compare_means(method = "t.test", paired = TRUE, comparisons = list(c("StaiS_pre","StaiS_post")))

3.2 t tests

## STAI tables
Date %>% 
  group_by(Conditie) %>% 
  do(broom::tidy(t.test(.$StaiS_pre, 
                        .$StaiS_post, 
                        mu = 0, 
                        alt = "two.sided", 
                        paired = TRUE, 
                        conf.level = 0.95))) %>%
  knitr::kable(digits = 2)

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	0.97	0.74	0.47	31	-1.70	3.64	Paired t-test	two.sided
mama	-0.40	-0.44	0.66	41	-2.28	1.47	Paired t-test	two.sided
personalitate	1.30	1.26	0.21	42	-0.78	3.38	Paired t-test	two.sided
prieten	3.12	4.05	0.00	39	1.56	4.69	Paired t-test	two.sided
tata	-0.88	-0.92	0.36	41	-2.82	1.06	Paired t-test	two.sided

4 VAS Stres

4.1 Plots with p values

## Vas Stres plot 
Vasstresmelt <- Date[, c("ID", "Conditie", "Vas_stres_pre","Vas_stres_post")] %>% 
  gather("Vas_stres_pre","Vas_stres_post", key = "Vas_stres_cond", value = "value") %>% 
  mutate_at(vars(c(1,2,3)), funs(as.factor)) %>% 
  mutate_at(vars(c(4)), funs(as.numeric)) %>% 
  mutate(Vas_stres_cond = factor(Vas_stres_cond, levels = c("Vas_stres_pre","Vas_stres_post"))) # change factor order for plot pre, post
ggplot(Vasstresmelt, aes(x = Vas_stres_cond, y = value)) +
  geom_boxplot() +
  facet_wrap(~Conditie) +
  ggpubr::stat_compare_means(method = "t.test", paired = TRUE, comparisons = list(c("Vas_stres_pre","Vas_stres_post")))

4.2 t tests

## Vas Stres tables
Date %>% 
  group_by(Conditie) %>% 
  do(broom::tidy(t.test(.$Vas_stres_pre, 
                        .$Vas_stres_post, 
                        mu = 0, 
                        alt = "two.sided", 
                        paired = TRUE, 
                        conf.level = 0.95))) %>%
  knitr::kable(digits = 2)

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	2.09	0.76	0.45	31	-3.53	7.72	Paired t-test	two.sided
mama	-2.38	-1.07	0.29	41	-6.86	2.09	Paired t-test	two.sided
personalitate	1.65	1.02	0.31	42	-1.62	4.92	Paired t-test	two.sided
prieten	3.08	1.59	0.12	39	-0.85	7.00	Paired t-test	two.sided
tata	-3.69	-1.96	0.06	41	-7.50	0.12	Paired t-test	two.sided

5 VAS Wellbeing

5.1 Plots with p values

## Vas Stres plot 
Vasbinemelt <- Date[, c("ID", "Conditie", "Vas_bine_pre","Vas_bine_post")] %>% 
  gather("Vas_bine_pre","Vas_bine_post", key = "Vas_stres_cond", value = "value") %>% 
  mutate_at(vars(c(1,2,3)), funs(as.factor)) %>% 
  mutate_at(vars(c(4)), funs(as.numeric)) %>% 
  mutate(Vas_stres_cond = factor(Vas_stres_cond, levels = c("Vas_bine_pre","Vas_bine_post"))) # change factor order for plot pre, post
ggplot(Vasbinemelt, aes(x = Vas_stres_cond, y = value)) +
  geom_boxplot() +
  facet_wrap(~Conditie) +
  ggpubr::stat_compare_means(method = "t.test", paired = TRUE, comparisons = list(c("Vas_bine_pre","Vas_bine_post")))

5.2 t tests

## Vas Stres tables
Date %>% 
  group_by(Conditie) %>% 
  do(broom::tidy(t.test(.$Vas_bine_pre, 
                        .$Vas_bine_post, 
                        mu = 0, 
                        alt = "two.sided", 
                        paired = TRUE, 
                        conf.level = 0.95))) %>%
  knitr::kable(digits = 2)

Conditie	estimate	statistic	p.value	parameter	conf.low	conf.high	method	alternative
iubit	-2.00	-0.75	0.46	31	-7.45	3.45	Paired t-test	two.sided
mama	-0.10	-0.04	0.96	41	-4.45	4.26	Paired t-test	two.sided
personalitate	-3.05	-1.37	0.18	42	-7.52	1.43	Paired t-test	two.sided
prieten	-4.90	-2.76	0.01	39	-8.50	-1.30	Paired t-test	two.sided
tata	-0.19	-0.06	0.95	41	-6.94	6.56	Paired t-test	two.sided

6 Conditioning on VAS global

Click on IDs to show in plot

# will throw warning because color palette is too small
plotly_data <- 
  Date %>%
    mutate(ID = word(ID, 1)) %>%
    select(ID, Conditie, Vas_rel_global) %>%
    gather(variable, value, Vas_rel_global) %>%
    arrange(Conditie) 
# %>%                                  # just a test
#     ggplot(aes(x = Conditie, y = value, group = ID, colour = ID)) + 
#     geom_point() + 
#     geom_line() +
#     ylab("Vas_rel_global")
plotly::plot_ly(plotly_data,  x= ~Conditie, y= ~value, color = ~ID, 
                type = 'scatter', mode = 'lines+markers', visible = 'legendonly',
                hoverinfo = 'text',
                text = ~paste('ID: ', ID, '</br> ', 
                      '</br> Vas value: ', value,
                      '</br> Condition: ', Conditie)) %>%
        layout(yaxis = list(range = c(0, 10), title = "Vas_rel_global"))

6.1 STAI-Y

## STAY
lm_stai <- lm(StaiS_post ~ StaiS_pre + Vas_rel_global, data = Date)
apa_lm_stai <- apa_print(lm_stai)
# apa_table(apa_lm_stai$table,
#   caption = "Table",
#   escape = FALSE,
#   format = "markdown")               # doesnt render the caption and it cant be removed
knitr::kable(apa_lm_stai$table)

predictor	estimate	ci	statistic	p.value
Intercept	15.94	[11.35, 20.54]	6.84	< .001
StaiS pre	0.74	[0.65, 0.82]	16.89	< .001
Vas rel global	-1.18	[ - 1.64, -0.72]	-5.07	< .001

# apa_lm_stai$full_result$modelfit$r2
par(mfrow = c(1, 2)); termplot(lm_stai, partial.resid = TRUE, se = TRUE)

Is there an interaction Condition x Vas rel global?

lm_stai_inter <- lm(StaiS_post ~ StaiS_pre + Conditie * Vas_rel_global, data = Date)
knitr::kable(apa_print(lm_stai_inter)$table)

predictor	estimate	ci	statistic	p.value
Intercept	22.85	[13.81, 31.90]	4.98	< .001
StaiS pre	0.74	[0.65, 0.83]	16.67	< .001
Conditiemama	-2.93	[ - 14.32, 8.47]	-0.51	.613
Conditiepersonalitate	-10.46	[ - 21.63, 0.71]	-1.85	.066
Conditieprieten	-11.63	[ - 28.07, 4.82]	-1.39	.165
Conditietata	-9.26	[ - 19.31, 0.78]	-1.82	.071
Vas rel global	-2.11	[ - 3.19, -1.02]	-3.84	< .001
Conditiemama × Vas rel global	0.55	[ - 0.93, 2.04]	0.74	.462
Conditiepersonalitate × Vas rel global	1.26	[ - 0.27, 2.80]	1.62	.106
Conditieprieten × Vas rel global	1.37	[ - 0.72, 3.46]	1.29	.198
Conditietata × Vas rel global	1.40	[0.06, 2.74]	2.06	.041

plot(visreg::visreg(lm_stai_inter, xvar = "Vas_rel_global", by = "Conditie", plot = FALSE),
            overlay = TRUE, partial = FALSE, rug = FALSE,
            xlab = "Vas_rel_global", ylab = "Predicted STAI",
            line = list(
            lty = c(1:4, 6),     # 5 is long dash and doesnt look nice   
            col = c("black", "grey90", "grey70", "grey50", "grey30")),
            band = FALSE)

Conditoning: Vas_rel_global >= 7

## STAI plot Cond
Staimelt_cond <- 
  Date %>%
  filter(Vas_rel_global >= 7) %>%
  select(ID, Conditie, StaiS_pre, StaiS_post) %>%
  gather("StaiS_pre", "StaiS_post", key = "Stai_cond", value = "value") %>% 
  mutate_at(vars(c(1, 2, 3)), funs(as.factor)) %>% 
  mutate(Stai_cond = factor(Stai_cond, levels = c("StaiS_pre","StaiS_post"))) # %>%    # change factor order for plot pre, post
ggplot(Staimelt_cond, aes(x = Stai_cond, y = value)) +
  geom_boxplot() +
  facet_wrap(~Conditie) +
  ggpubr::stat_compare_means(method = "t.test", paired = TRUE, comparisons = list(c("StaiS_pre","StaiS_post")))

STAI Post - Pre diff by Vas_rel_global

Date %>%
  mutate(StaiS_diff = StaiS_post - StaiS_pre) %>%
  ggplot(aes(x = Vas_rel_global, y = StaiS_diff, color = Conditie, group = Conditie)) + 
  geom_point() + 
  geom_hline(yintercept = 0, linetype = "dashed", color = "darkgrey") +
  geom_smooth(method = "lm", size = 1, se = FALSE) +
  xlim(0, 10)

6.2 VAS Stres

## STAY
lm_vasS <- lm(Vas_stres_post ~ Vas_stres_pre + Vas_rel_global, data = Date)
apa_lm_vasS <- apa_print(lm_vasS)
knitr::kable(apa_lm_vasS$table)

predictor	estimate	ci	statistic	p.value
Intercept	17.19	[9.27, 25.11]	4.28	< .001
Vas stres pre	0.81	[0.71, 0.91]	15.91	< .001
Vas rel global	-1.89	[ - 2.90, -0.88]	-3.69	< .001

par(mfrow=c(1,2)); termplot(lm_vasS, partial.resid = TRUE, se = TRUE)

Is there an interaction Condition x Vas rel global?

lm_vasS_inter <- lm(Vas_stres_post ~ Vas_stres_pre + Conditie * Vas_rel_global, data = Date)
knitr::kable(apa_print(lm_vasS_inter)$table)

predictor	estimate	ci	statistic	p.value
Intercept	13.35	[ - 5.68, 32.38]	1.38	.168
Vas stres pre	0.82	[0.72, 0.93]	15.65	< .001
Conditiemama	19.55	[ - 5.84, 44.94]	1.52	.130
Conditiepersonalitate	2.55	[ - 22.28, 27.37]	0.20	.840
Conditieprieten	-10.10	[ - 46.26, 26.06]	-0.55	.582
Conditietata	1.48	[ - 20.98, 23.93]	0.13	.897
Vas rel global	-1.61	[ - 4.04, 0.82]	-1.31	.192
Conditiemama × Vas rel global	-2.09	[ - 5.39, 1.21]	-1.25	.213
Conditiepersonalitate × Vas rel global	-0.53	[ - 3.94, 2.89]	-0.30	.761
Conditieprieten × Vas rel global	1.35	[ - 3.27, 5.96]	0.58	.565
Conditietata × Vas rel global	0.44	[ - 2.55, 3.44]	0.29	.771

plot(visreg::visreg(lm_vasS_inter, xvar = "Vas_rel_global", by = "Conditie", plot = FALSE),
            overlay = TRUE, partial = FALSE, rug = FALSE,
            xlab = "Vas_rel_global", ylab = "Predicted VAS Stress",
            line = list(
            lty = c(1:4, 6),     # 5 is long dash and doesnt look nice   
            col = c("black", "grey90", "grey70", "grey50", "grey30")),
            band = FALSE)

Conditoning: Vas_rel_global >= 7

## Vas Stres plot 
Vasstresmelt_cond <- 
  Date %>%
  filter(Vas_rel_global >= 7) %>%
  select(ID, Conditie, Vas_stres_pre, Vas_stres_post) %>%
  gather("Vas_stres_pre","Vas_stres_post", key = "Vas_stres_cond", value = "value") %>% 
  mutate_at(vars(c(1,2,3)), funs(as.factor)) %>% 
  mutate_at(vars(c(4)), funs(as.numeric)) %>% 
  mutate(Vas_stres_cond = factor(Vas_stres_cond, levels = c("Vas_stres_pre","Vas_stres_post"))) # change factor order for plot pre, post
ggplot(Vasstresmelt_cond, aes(x = Vas_stres_cond, y = value)) +
  geom_boxplot() +
  facet_wrap(~Conditie) +
  ggpubr::stat_compare_means(method = "t.test", paired = TRUE, comparisons = list(c("Vas_stres_pre","Vas_stres_post")))

VAS Stres Post - Pre diff by Vas_rel_global

Date %>%
  mutate(Vas_stres_diff = Vas_stres_post - Vas_stres_pre) %>%
  ggplot(aes(x = Vas_rel_global, y = Vas_stres_diff, color = Conditie, group = Conditie)) + 
  geom_point() +
  geom_smooth(method = "lm", size = 1, se = FALSE) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "darkgrey") +
  xlim(0, 10)

6.3 VAS Wellbeing

## STAY
lm_vasB <- lm(Vas_bine_post ~ Vas_bine_pre + Vas_rel_global, data = Date)
apa_lm_vasB <- apa_print(lm_vasB)
knitr::kable(apa_lm_vasB$table)

predictor	estimate	ci	statistic	p.value
Intercept	-1.52	[ - 11.46, 8.42]	-0.30	.763
Vas bine pre	0.69	[0.59, 0.79]	13.90	< .001
Vas rel global	3.60	[2.48, 4.72]	6.35	< .001

par(mfrow=c(1,2)); termplot(lm_vasB, partial.resid = TRUE, se = TRUE)

Is there an interaction Condition x Vas rel global?

lm_vasB_inter <- lm(Vas_bine_post ~ Vas_bine_pre + Conditie * Vas_rel_global, data = Date)
knitr::kable(apa_print(lm_vasB_inter)$table)

predictor	estimate	ci	statistic	p.value
Intercept	-7.44	[ - 28.26, 13.38]	-0.70	.482
Vas bine pre	0.70	[0.60, 0.80]	13.55	< .001
Conditiemama	0.39	[ - 27.59, 28.36]	0.03	.978
Conditiepersonalitate	11.91	[ - 15.51, 39.34]	0.86	.393
Conditieprieten	24.71	[ - 15.45, 64.87]	1.21	.226
Conditietata	0.55	[ - 24.13, 25.23]	0.04	.965
Vas rel global	4.25	[1.58, 6.92]	3.14	.002
Conditiemama × Vas rel global	-0.24	[ - 3.88, 3.40]	-0.13	.896
Conditiepersonalitate × Vas rel global	-1.21	[ - 4.99, 2.56]	-0.63	.527
Conditieprieten × Vas rel global	-3.18	[ - 8.30, 1.94]	-1.23	.222
Conditietata × Vas rel global	-0.07	[ - 3.37, 3.24]	-0.04	.968

plot(visreg::visreg(lm_vasB_inter, xvar = "Vas_rel_global", by = "Conditie", plot = FALSE),
            overlay = TRUE, partial = FALSE, rug = FALSE,
            xlab = "Vas_rel_global", ylab = "Predicted VAS Wellbeing",
            line = list(
            lty = c(1:4, 6),     # 5 is long dash and doesnt look nice   
            col = c("black", "grey90", "grey70", "grey50", "grey30")),
            band = FALSE)

Conditoning: Vas_rel_global >= 7

## Vas Stres plot 
Vasbinemelt_cond <- 
  Date %>%
  filter(Vas_rel_global >= 7) %>%
  select(ID, Conditie, Vas_bine_pre, Vas_bine_post) %>%
  gather("Vas_bine_pre","Vas_bine_post", key = "Vas_bine_cond", value = "value") %>% 
  mutate_at(vars(c(1,2,3)), funs(as.factor)) %>% 
  mutate_at(vars(c(4)), funs(as.numeric)) %>% 
  mutate(Vas_bine_cond = factor(Vas_bine_cond, levels = c("Vas_bine_pre","Vas_bine_post"))) # change factor order for plot pre, post
ggplot(Vasbinemelt_cond, aes(x = Vas_bine_cond, y = value)) +
  geom_boxplot() +
  facet_wrap(~Conditie) +
  ggpubr::stat_compare_means(method = "t.test", paired = TRUE, comparisons = list(c("Vas_bine_pre","Vas_bine_post")))

VAS Bine Post - Pre diff by Vas_rel_global

Date %>%
  mutate(Vas_bine_diff = Vas_bine_post - Vas_bine_pre) %>%
  ggplot(aes(x = Vas_rel_global, y = Vas_bine_diff, color = Conditie, group = Conditie)) + 
  geom_point() +
  geom_smooth(method = "lm", size = 1, se = FALSE) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "darkgrey") +
  xlim(0, 10)

7 Melt dataframe for future analyses

# Data from Long to Wide
meltDate <- 
  Date %>% 
    select(ID, Conditie, 
           Vas_stres_pre, Vas_stres_post,
           Vas_bine_pre, Vas_bine_post,
           StaiS_pre, StaiS_post) %>%
      gather(variable, value, Vas_stres_pre:StaiS_post) %>%
      unite(VarCond, variable, Conditie) %>% 
      spread(VarCond, value)
# Some rownames are typos (ID 1 and 26)
func_collapseduplicate <- function(x) {           # collapses duplicate rows, but if all are NA returns NA
  sum(x, na.rm=T ) * NA ^ (sum(!is.na(x)) == 0)
}
meltDate <-
  meltDate %>%
    mutate(ID = word(ID, 1)) %>%
    group_by(ID) %>% 
    summarise_all(func_collapseduplicate)
  
# Test if all results are the same -- all seems good
# t.test(meltDate$Vas_bine_pre_prieten, meltDate$Vas_bine_post_prieten, 
#                         mu = 0, 
#                         alt = "two.sided", 
#                         paired = TRUE, 
#                         conf.level = 0.95)
meltDate %>%
      DT::datatable(                                  # excel downloadable  DT table
      extensions = 'Buttons',
      options = list(pageLength = 20,
                     scrollX='500px', 
                     dom = 'Bfrtip', 
                     buttons = c('excel', "csv")))

8 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] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] bindrcpp_0.2.2     plotly_4.8.0       summarytools_0.8.8 DT_0.5             ggpubr_0.2         magrittr_1.5       broom_0.5.1       
 [8] 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        readr_1.3.0       
[15] 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  gtools_3.8.1       modelr_0.1.2       visreg_2.5-0       shiny_1.2.0       
 [8] assertthat_0.2.0   highr_0.7          pander_0.6.3       cellranger_1.1.0   yaml_2.2.0         pillar_1.3.1       backports_1.1.3   
[15] lattice_0.20-38    glue_1.3.0         digest_0.6.18      RColorBrewer_1.1-2 ggsignif_0.4.0     promises_1.0.1     pryr_0.1.4        
[22] rvest_0.3.2        colorspace_1.3-2   cowplot_0.9.3      htmltools_0.3.6    httpuv_1.4.5       plyr_1.8.4         pkgconfig_2.0.2   
[29] haven_2.1.0        xtable_1.8-3       scales_1.0.0       later_0.7.5        generics_0.0.2     withr_2.1.2        lazyeval_0.2.1    
[36] cli_1.0.1          mnormt_1.5-5       crayon_1.3.4       readxl_1.1.0       mime_0.6           evaluate_0.12      nlme_3.1-137      
[43] xml2_1.2.0         foreign_0.8-71     rapportools_1.0    MBESS_4.4.3        tools_3.5.2        data.table_1.11.8  hms_0.4.2         
[50] matrixStats_0.54.0 munsell_0.5.0      compiler_3.5.2     rlang_0.3.1        grid_3.5.2         RCurl_1.95-4.11    rstudioapi_0.8    
[57] htmlwidgets_1.3    crosstalk_1.0.0    labeling_0.3       bitops_1.0-6       rmarkdown_1.11     gtable_0.2.0       codetools_0.2-15  
[64] R6_2.3.0           lubridate_1.7.4    knitr_1.21         bindr_0.1.1        stringi_1.2.4      parallel_3.5.2     Rcpp_1.0.0        
[71] tidyselect_0.2.5   xfun_0.4          

 

---

A work by Claudiu Papasteri

claudiu.papasteri@gmail.com