Uni-Impresa ‘You Drink You Lose’ - Analisi dei dati Pre vs. Post & Pre vs. Post vs. Follow-up
Enrico Rubaltelli
DPSS - Università di PadovaMarta Caserotti
DPSS - Università di PadovaBeatrice Conte
DPSS - Università di PadovaLorella Lotto
DPSS - Università di Padova2025-03-17
1 INTRODUZIONE E SUMMARY RISULTATI PRINCIPALI
2 STATISTICHE DESCRITTIVE
library(tidyverse)
library(sandwich)
library(gtsummary)
library(flextable)
library(tables)
# library(openxlsx)
# Change directory to folder where folder with files is located
# library(readbulk) dsSIM <- read_bulk(directory = 'csv_guide', extension =
# '.csv')
# write.table(dsSIM, file = 'dsSIM.csv', sep = ',', na = ' ', dec = '.',
# row.names = FALSE, col.names = FALSE)
## Upload of dataset from PRE-TEST
dsPRE <- rio::import(file = "UDUL_Questionario+PRE_January+22,+2024_18.38.xlsx",
which = 1L, skip = 1L)
## I prepare the dataset from the PRE-TEST for the analyses Delete incomplete
## responses
dsPRE_ok <- subset(dsPRE, Finished1 == 1)
## Delete participants with multiple complete responses
dsPRE_ok <- subset(dsPRE_ok, Code3 != "en710os")
dsPRE_ok <- subset(dsPRE_ok, Code3 != "gr383ot")
dsPRE_ok <- subset(dsPRE_ok, Code3 != "go020be")
dsPRE_ok <- subset(dsPRE_ok, Code3 != "jo399io")
dsPRE_ok <- subset(dsPRE_ok, Code3 != "va203on")
dsPRE_ok <- subset(dsPRE_ok, Code3 != "en877zo")
dsPRE_ok <- subset(dsPRE_ok, Code3 != "pa753an")
dsPRE_ok1 <- dsPRE_ok %>%
select(!c(Code1, Code21))
## Upload of dataset from POST-TEST
dsPOST <- rio::import(file = "UDUL_Questionario+POST_January+22,+2024_19.38.xlsx",
which = 1L, skip = 1L)
## I prepare the dataset from the PRE-TEST for the analyses Delete incomplete
## responses
dsPOST_ok <- subset(dsPOST, Finished2 == 1)
dsPOST_ok <- subset(dsPOST_ok, Code3 != "va203on")
dsPOST_ok1 <- dsPOST_ok %>%
select(!c(Code2, Code22))
## Upload of dataset with driving conditions (under the influence vs. control)
dsSIM <- read.table(file = "dsSIM.csv", sep = ",", dec = ".", header = TRUE)
## Select only Code and Test dsSIM1 <- dsSIM %>% select(Code3,Test)
## Create full datset
dsPRE_POST <- left_join(dsPRE_ok1, dsPOST_ok1, by = "Code3")
dsPRE_POST_ok <- left_join(dsPRE_POST, dsSIM, by = "Code3")
## Delete training sessions
dsPRE_POST_ok <- subset(dsPRE_POST_ok, Test != "Training")library(tidyr)
library(ggplot2)
library(ggthemes)
## Tranform Gender into a factor with labels
dsPRE_POST_ok$Genere <- factor(dsPRE_POST_ok$Genere1, levels = c(1, 2, 3, 4), labels = c("Uomo",
"Donna", "Altro", "Preferisco non risponder"))
## Check that Age is 18 to 24 years summary(dsPRE_POST_ok$Età1) Delete
## participants above 24 years
dsPRE_POST_ok <- subset(dsPRE_POST_ok, Età1 <= 24)
dsPRE_POST_ok$Età <- dsPRE_POST_ok$Età1
## Transform Education into a factor with labels
dsPRE_POST_ok$Istruzione <- factor(dsPRE_POST_ok$Istr1, levels = c(1, 2, 3, 4), labels = c("Scuola media",
"Scuola superiore", "Laurea triennale", "Laurea magistrale"))
## Transform Work into a factor with labels
dsPRE_POST_ok$Lavoro <- factor(dsPRE_POST_ok$Profes1, levels = c(1, 2, 3, 4), labels = c("Studente",
"Occupato", "Disoccupato", "In cerca di occupazione"))
## Transform Residence into a factor with labels
dsPRE_POST_ok$Residenza <- factor(dsPRE_POST_ok$Resid1, levels = c(1, 2), labels = c("Comune PD",
"Provincia PD"))
## Clean answers to the question about the place where they live
dsPRE_POST_ok$Comune <- dsPRE_POST_ok$Resid2
## Transform Driving licence into a factor with labels CHECK WHETHER THE LABELS
## ARE CODED CORRECTLY It looks strange that there are so many 4!
dsPRE_POST_ok$Patente <- factor(dsPRE_POST_ok$Patente1, levels = c(1, 2, 3, 4, 5),
labels = c("No patente", "A", "B1", "B", "Altro"))
## Transform the first question on Fines into a factor with labels
dsPRE_POST_ok$Sanzioni_alcool <- factor(dsPRE_POST_ok$sanz11, levels = c(1, 2, 3,
4), labels = c("0,00 g/l", "0,2 g/l", "0,5 g/l", "0,8 g/l"))
## Transform the second question on Fines into a factor with labels
dsPRE_POST_ok$Sanzioni_neo_patentati <- factor(dsPRE_POST_ok$sanz21, levels = c(1,
2, 3), labels = c("Multa €164-664 + 10 punti", "Multa €708-2883.34 + 20 punti",
"Nessuna sanzione"))
## Recode to have the correct answer vs. the incorrect ones
dsPRE_POST_ok$Sanzioni_neo_patentati2 <- car::recode(dsPRE_POST_ok$sanz21, "1=1;2:3=0")
## Compute average score for Risk Perception in the before the driving test
dsPRE_POST_ok$Percezione_rischio <- rowMeans(dsPRE_POST_ok[, c("RP_scale_11", "RP_scale_21",
"RP_scale_31", "RP_scale_41", "RP_scale_51")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFArisk <- cronbach(cbind(dsPRE_POST_ok[, c("RP_scale_11", "RP_scale_21", "RP_scale_31",
"RP_scale_41", "RP_scale_51")]))
ALFArisk$sample.size
[1] 345
$number.of.items
[1] 5
$alpha
[1] 0.81679967## Compute average score for Vankov scale in the before the driving test
dsPRE_POST_ok$Vankov <- rowMeans(dsPRE_POST_ok[, c("DUI_int1", "Inst_att1", "Per_cont1",
"Self_eff1", "Des_norm1", "Sub_norm1", "Aff_att1")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAvankov <- cronbach(cbind(dsPRE_POST_ok[, c("DUI_int1", "Inst_att1", "Per_cont1",
"Self_eff1", "Des_norm1", "Sub_norm1", "Aff_att1")]))
ALFAvankov$sample.size
[1] 345
$number.of.items
[1] 7
$alpha
[1] 0.3365807## Compute average score for Dejoy scale (involvement) in the before the
## driving test
dsPRE_POST_ok$Dejoy_coinvolgimento <- rowMeans(dsPRE_POST_ok[, c("involv_DJ_11",
"involv_DJ_21", "involv_DJ_31", "involv_DJ_41", "involv_DJ_51", "involv_DJ_61",
"involv_DJ_71", "involv_DJ_81", "involv_DJ_91", "involv_DJ_101")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyC <- cronbach(cbind(dsPRE_POST_ok[, c("involv_DJ_11", "involv_DJ_21", "involv_DJ_31",
"involv_DJ_41", "involv_DJ_51", "involv_DJ_61", "involv_DJ_71", "involv_DJ_81",
"involv_DJ_91", "involv_DJ_101")]))
ALFAdejoyC$sample.size
[1] 345
$number.of.items
[1] 10
$alpha
[1] 0.89208947## Compute average score for Dejoy scale (gravity) in the before the driving
## test
dsPRE_POST_ok$Dejoy_gravità <- rowMeans(dsPRE_POST_ok[, c("grav_DJ_11", "grav_DJ_21",
"grav_DJ_31", "grav_DJ_41", "grav_DJ_51", "grav_DJ_61", "grav_DJ_71", "grav_DJ_81",
"grav_DJ_91", "grav_DJ_101")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyG <- cronbach(cbind(dsPRE_POST_ok[, c("grav_DJ_11", "grav_DJ_21", "grav_DJ_31",
"grav_DJ_41", "grav_DJ_51", "grav_DJ_61", "grav_DJ_71", "grav_DJ_81", "grav_DJ_91",
"grav_DJ_101")]))
ALFAdejoyG$sample.size
[1] 345
$number.of.items
[1] 10
$alpha
[1] 0.80781793## Compute average score for Dejoy scale (control) in the before the driving
## test
dsPRE_POST_ok$Dejoy_controllo <- rowMeans(dsPRE_POST_ok[, c("contol_DJ_11", "contol_DJ_21",
"contol_DJ_31", "contol_DJ_41", "contol_DJ_51", "contol_DJ_61", "contol_DJ_71",
"contol_DJ_81", "contol_DJ_91", "contol_DJ_101")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyCon <- cronbach(cbind(dsPRE_POST_ok[, c("contol_DJ_11", "contol_DJ_21",
"contol_DJ_31", "contol_DJ_41", "contol_DJ_51", "contol_DJ_61", "contol_DJ_71",
"contol_DJ_81", "contol_DJ_91", "contol_DJ_101")]))
ALFAdejoyCon$sample.size
[1] 345
$number.of.items
[1] 10
$alpha
[1] 0.6351326## Compute average score for Risk Perception in after the driving test
dsPRE_POST_ok$Percezione_rischio2 <- rowMeans(dsPRE_POST_ok[, c("RP_scale_12", "RP_scale_22",
"RP_scale_32", "RP_scale_42", "RP_scale_52")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFArisk2 <- cronbach(cbind(dsPRE_POST_ok[, c("RP_scale_12", "RP_scale_22", "RP_scale_32",
"RP_scale_42", "RP_scale_52")]))
ALFArisk2$sample.size
[1] 223
$number.of.items
[1] 5
$alpha
[1] 0.89850369## Compute average score for Vankov scale in after the driving test
dsPRE_POST_ok$Vankov2 <- rowMeans(dsPRE_POST_ok[, c("DUI_int2", "Inst_att2", "Per_cont2",
"Self_eff2", "Des_norm2", "Sub_norm2", "Aff_att2")], na.rm = TRUE)## Cronbach's alfa
library(psy)
ALFAvankov2 <- cronbach(cbind(dsPRE_POST_ok[, c("DUI_int2", "Inst_att2", "Per_cont2",
"Self_eff2", "Des_norm2", "Sub_norm2", "Aff_att2")]))
ALFAvankov2$sample.size
[1] 223
$number.of.items
[1] 7
$alpha
[1] 0.48037544## Compute average score for Dejoy scale (involvement) in after the driving
## test
dsPRE_POST_ok$Dejoy_coinvolgimento2 <- rowMeans(dsPRE_POST_ok[, c("involv_DJ_12",
"involv_DJ_22", "involv_DJ_32", "involv_DJ_42", "involv_DJ_52", "involv_DJ_62",
"involv_DJ_72", "involv_DJ_82", "involv_DJ_92", "involv_DJ_102")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyC2 <- cronbach(cbind(dsPRE_POST_ok[, c("involv_DJ_12", "involv_DJ_22", "involv_DJ_32",
"involv_DJ_42", "involv_DJ_52", "involv_DJ_62", "involv_DJ_72", "involv_DJ_82",
"involv_DJ_92", "involv_DJ_102")]))
ALFAdejoyC2$sample.size
[1] 223
$number.of.items
[1] 10
$alpha
[1] 0.88494521## Compute average score for Dejoy scale (gravity) in the before the driving
## test
dsPRE_POST_ok$Dejoy_gravità2 <- rowMeans(dsPRE_POST_ok[, c("grav_DJ_12", "grav_DJ_22",
"grav_DJ_32", "grav_DJ_42", "grav_DJ_52", "grav_DJ_62", "grav_DJ_72", "grav_DJ_82",
"grav_DJ_92", "grav_DJ_102")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyG2 <- cronbach(cbind(dsPRE_POST_ok[, c("grav_DJ_12", "grav_DJ_22", "grav_DJ_32",
"grav_DJ_42", "grav_DJ_52", "grav_DJ_62", "grav_DJ_72", "grav_DJ_82", "grav_DJ_92",
"grav_DJ_102")]))
ALFAdejoyG2$sample.size
[1] 223
$number.of.items
[1] 10
$alpha
[1] 0.77687051## Compute average score for Dejoy scale (control) in the before the driving
## test
dsPRE_POST_ok$Dejoy_controllo2 <- rowMeans(dsPRE_POST_ok[, c("contol_DJ_12", "contol_DJ_22",
"contol_DJ_32", "contol_DJ_42", "contol_DJ_52", "contol_DJ_62", "contol_DJ_72",
"contol_DJ_82", "contol_DJ_92", "contol_DJ_102")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyCon2 <- cronbach(cbind(dsPRE_POST_ok[, c("contol_DJ_12", "contol_DJ_22",
"contol_DJ_32", "contol_DJ_42", "contol_DJ_52", "contol_DJ_62", "contol_DJ_72",
"contol_DJ_82", "contol_DJ_92", "contol_DJ_102")]))
ALFAdejoyCon2$sample.size
[1] 223
$number.of.items
[1] 10
$alpha
[1] 0.64802932.1 Campione
dsPRE_POST_ok2 <- subset(dsPRE_POST_ok, Vankov2 != "NaN")
dsPRE_POST_ok2$Test <- factor(dsPRE_POST_ok2$Test)
library(table1)
T1 <- table1(~Genere + Età + Istruzione + Lavoro + Residenza + Patente + Sanzioni_alcool +
Sanzioni_neo_patentati + game1 + Fr_alcol1 + M_drink1 + Fam_guida1 | Test, data = dsPRE_POST_ok2)
T1| Guida da sobrio (N=92) |
Guida da ubriaco (N=131) |
Overall (N=223) |
|
|---|---|---|---|
| Genere | |||
| Uomo | 45 (48.9%) | 83 (63.4%) | 128 (57.4%) |
| Donna | 47 (51.1%) | 48 (36.6%) | 95 (42.6%) |
| Altro | 0 (0%) | 0 (0%) | 0 (0%) |
| Preferisco non risponder | 0 (0%) | 0 (0%) | 0 (0%) |
| Età | |||
| Mean (SD) | 18.6 (1.20) | 18.9 (1.47) | 18.8 (1.37) |
| Median [Min, Max] | 18.0 [18.0, 24.0] | 18.0 [18.0, 24.0] | 18.0 [18.0, 24.0] |
| Istruzione | |||
| Scuola media | 54 (58.7%) | 77 (58.8%) | 131 (58.7%) |
| Scuola superiore | 35 (38.0%) | 52 (39.7%) | 87 (39.0%) |
| Laurea triennale | 3 (3.3%) | 2 (1.5%) | 5 (2.2%) |
| Laurea magistrale | 0 (0%) | 0 (0%) | 0 (0%) |
| Lavoro | |||
| Studente | 79 (85.9%) | 99 (75.6%) | 178 (79.8%) |
| Occupato | 10 (10.9%) | 22 (16.8%) | 32 (14.3%) |
| Disoccupato | 0 (0%) | 5 (3.8%) | 5 (2.2%) |
| In cerca di occupazione | 3 (3.3%) | 5 (3.8%) | 8 (3.6%) |
| Residenza | |||
| Comune PD | 25 (27.2%) | 30 (22.9%) | 55 (24.7%) |
| Provincia PD | 67 (72.8%) | 101 (77.1%) | 168 (75.3%) |
| Patente | |||
| No patente | 0 (0%) | 1 (0.8%) | 1 (0.4%) |
| A | 0 (0%) | 1 (0.8%) | 1 (0.4%) |
| B1 | 5 (5.4%) | 7 (5.3%) | 12 (5.4%) |
| B | 86 (93.5%) | 119 (90.8%) | 205 (91.9%) |
| Altro | 1 (1.1%) | 3 (2.3%) | 4 (1.8%) |
| Sanzioni_alcool | |||
| 0,00 g/l | 85 (92.4%) | 125 (95.4%) | 210 (94.2%) |
| 0,2 g/l | 4 (4.3%) | 4 (3.1%) | 8 (3.6%) |
| 0,5 g/l | 3 (3.3%) | 2 (1.5%) | 5 (2.2%) |
| 0,8 g/l | 0 (0%) | 0 (0%) | 0 (0%) |
| Sanzioni_neo_patentati | |||
| Multa €164-664 + 10 punti | 61 (66.3%) | 82 (62.6%) | 143 (64.1%) |
| Multa €708-2883.34 + 20 punti | 30 (32.6%) | 48 (36.6%) | 78 (35.0%) |
| Nessuna sanzione | 1 (1.1%) | 1 (0.8%) | 2 (0.9%) |
| game1 | |||
| Mean (SD) | 2.07 (1.18) | 2.50 (1.33) | 2.32 (1.29) |
| Median [Min, Max] | 2.00 [1.00, 5.00] | 2.00 [1.00, 5.00] | 2.00 [1.00, 5.00] |
| Fr_alcol1 | |||
| Mean (SD) | 2.30 (0.899) | 2.36 (0.895) | 2.34 (0.895) |
| Median [Min, Max] | 2.00 [1.00, 4.00] | 2.00 [1.00, 5.00] | 2.00 [1.00, 5.00] |
| M_drink1 | |||
| Mean (SD) | 2.04 (0.851) | 2.03 (0.632) | 2.04 (0.728) |
| Median [Min, Max] | 2.00 [1.00, 5.00] | 2.00 [1.00, 4.00] | 2.00 [1.00, 5.00] |
| Fam_guida1 | |||
| Mean (SD) | 1.38 (0.510) | 1.41 (0.567) | 1.40 (0.543) |
| Median [Min, Max] | 1.00 [1.00, 3.00] | 1.00 [1.00, 3.00] | 1.00 [1.00, 3.00] |
2.2 Misure di percezione del rischio
levels(dsPRE_POST_ok2$Test)[match("Guida da ubriaco", levels(dsPRE_POST_ok2$Test))] <- "Driving under the influence"
levels(dsPRE_POST_ok2$Test)[match("Guida da sobrio", levels(dsPRE_POST_ok2$Test))] <- "Driving sober"
T2 <- table1(~Percezione_rischio + Percezione_rischio2 + Vankov + Vankov2 + Dejoy_coinvolgimento +
Dejoy_coinvolgimento2 + Dejoy_gravità + Dejoy_gravità2 + Dejoy_controllo +
Dejoy_controllo2 | Test, data = dsPRE_POST_ok2, overall = F)
T2| Driving sober (N=92) |
Driving under the influence (N=131) |
|
|---|---|---|
| Percezione_rischio | ||
| Mean (SD) | 9.44 (0.888) | 9.27 (0.905) |
| Median [Min, Max] | 10.0 [5.00, 10.0] | 9.60 [6.00, 10.0] |
| Percezione_rischio2 | ||
| Mean (SD) | 9.04 (1.46) | 9.19 (1.40) |
| Median [Min, Max] | 9.80 [3.00, 10.0] | 9.80 [2.60, 10.0] |
| Vankov | ||
| Mean (SD) | 3.64 (0.755) | 3.57 (0.813) |
| Median [Min, Max] | 3.57 [1.14, 5.43] | 3.43 [1.00, 5.86] |
| Vankov2 | ||
| Mean (SD) | 3.58 (1.07) | 3.68 (0.979) |
| Median [Min, Max] | 3.43 [1.00, 9.00] | 3.71 [1.00, 8.43] |
| Dejoy_coinvolgimento | ||
| Mean (SD) | 2.43 (0.880) | 2.40 (0.921) |
| Median [Min, Max] | 2.40 [1.00, 5.00] | 2.20 [1.00, 5.00] |
| Dejoy_coinvolgimento2 | ||
| Mean (SD) | 2.85 (0.877) | 2.70 (0.813) |
| Median [Min, Max] | 2.90 [1.00, 5.00] | 2.70 [1.00, 5.00] |
| Dejoy_gravità | ||
| Mean (SD) | 3.82 (0.548) | 3.77 (0.569) |
| Median [Min, Max] | 3.80 [1.60, 5.00] | 3.80 [1.30, 5.00] |
| Dejoy_gravità2 | ||
| Mean (SD) | 3.83 (0.598) | 3.78 (0.504) |
| Median [Min, Max] | 3.80 [2.40, 5.00] | 3.80 [2.40, 5.00] |
| Dejoy_controllo | ||
| Mean (SD) | 3.26 (0.559) | 3.27 (0.569) |
| Median [Min, Max] | 3.20 [1.50, 5.00] | 3.20 [2.00, 5.00] |
| Dejoy_controllo2 | ||
| Mean (SD) | 3.24 (0.558) | 3.26 (0.584) |
| Median [Min, Max] | 3.10 [2.00, 5.00] | 3.30 [1.00, 4.60] |
2.3 Illusione del controllo e bias ottimistico
dsPRE_POST_ok2$IllusionC1 <- rowMeans(dsPRE_POST_ok2[, c("ill_co11", "ill_co12")],
na.rm = TRUE)
dsPRE_POST_ok2$IllusionC2 <- rowMeans(dsPRE_POST_ok2[, c("ill_co21", "ill_co22")],
na.rm = TRUE)
dsPRE_POST_ok2$OptimismB1 <- rowMeans(dsPRE_POST_ok2[, c("Ob11", "Ob21")], na.rm = TRUE)
dsPRE_POST_ok2$OptimismB2 <- rowMeans(dsPRE_POST_ok2[, c("Ob21", "Ob22")], na.rm = TRUE)
dsPRE_POST_ok2$game_cat <- factor(dsPRE_POST_ok2$game1, levels = c(1, 2, 3, 4, 5),
labels = c("Never", "Very rarely", "Only 1/2 times a week", "3/4 times a week",
"Very often/every day"))
dsPRE_POST_ok2$FrAlcohol_cat <- factor(dsPRE_POST_ok2$Fr_alcol1, levels = c(1, 2,
3, 4, 5, 6), labels = c("Never", "Once", "2/4 times", "2/3 times a week", "5/6 times a week",
"6 or more times a week"))
dsPRE_POST_ok2$NDrink_cat <- factor(dsPRE_POST_ok2$M_drink1, levels = c(1, 2, 3,
4, 5, 6), labels = c("None", "1/2 drinks", "3/4 drinks", "5/6 drinks", "7/9 drinks",
"10 or more drinks"))
dsPRE_POST_ok2$FamGuida_cat <- factor(dsPRE_POST_ok2$Fam_guida1, levels = c(1, 2,
3, 4), labels = c("Never", "Sometimes", "Often", "Very often"))
dsPRE_POST_ok2$Passed <- factor(dsPRE_POST_ok2$Passed, levels = c(0, 1), labels = c("not passed",
"passed"))
library(lubridate)
dsPRE_POST_ok2$Duration2 <- ms(dsPRE_POST_ok2$Duration)
dsPRE_POST_ok2$Duration3 <- as.numeric(dsPRE_POST_ok2$Duration2)
dsPRE_POST_ok2$Durata <- dsPRE_POST_ok2$Duration3/60
T3 <- table1(~Percezione_rischio + Percezione_rischio2 + Dejoy_coinvolgimento + Dejoy_coinvolgimento2 +
Dejoy_gravità + Dejoy_gravità2 + IllusionC1 + IllusionC2 + OptimismB1 + OptimismB2 +
Ob31 + Ob32 + game_cat + FrAlcohol_cat + NDrink_cat + FamGuida_cat | Test, data = dsPRE_POST_ok2,
overall = F)
T3| Driving sober (N=92) |
Driving under the influence (N=131) |
|
|---|---|---|
| Percezione_rischio | ||
| Mean (SD) | 9.44 (0.888) | 9.27 (0.905) |
| Median [Min, Max] | 10.0 [5.00, 10.0] | 9.60 [6.00, 10.0] |
| Percezione_rischio2 | ||
| Mean (SD) | 9.04 (1.46) | 9.19 (1.40) |
| Median [Min, Max] | 9.80 [3.00, 10.0] | 9.80 [2.60, 10.0] |
| Dejoy_coinvolgimento | ||
| Mean (SD) | 2.43 (0.880) | 2.40 (0.921) |
| Median [Min, Max] | 2.40 [1.00, 5.00] | 2.20 [1.00, 5.00] |
| Dejoy_coinvolgimento2 | ||
| Mean (SD) | 2.85 (0.877) | 2.70 (0.813) |
| Median [Min, Max] | 2.90 [1.00, 5.00] | 2.70 [1.00, 5.00] |
| Dejoy_gravità | ||
| Mean (SD) | 3.82 (0.548) | 3.77 (0.569) |
| Median [Min, Max] | 3.80 [1.60, 5.00] | 3.80 [1.30, 5.00] |
| Dejoy_gravità2 | ||
| Mean (SD) | 3.83 (0.598) | 3.78 (0.504) |
| Median [Min, Max] | 3.80 [2.40, 5.00] | 3.80 [2.40, 5.00] |
| IllusionC1 | ||
| Mean (SD) | 1.89 (1.42) | 1.86 (1.47) |
| Median [Min, Max] | 1.00 [1.00, 7.00] | 1.00 [1.00, 8.50] |
| IllusionC2 | ||
| Mean (SD) | 1.67 (1.40) | 1.53 (1.07) |
| Median [Min, Max] | 1.00 [1.00, 7.50] | 1.00 [1.00, 6.00] |
| OptimismB1 | ||
| Mean (SD) | 3.41 (2.49) | 3.61 (2.87) |
| Median [Min, Max] | 3.00 [1.00, 10.0] | 2.50 [1.00, 10.0] |
| OptimismB2 | ||
| Mean (SD) | 3.66 (2.44) | 3.75 (2.65) |
| Median [Min, Max] | 3.00 [1.00, 10.0] | 3.00 [1.00, 10.0] |
| Ob31 | ||
| Mean (SD) | 7.28 (2.56) | 6.95 (2.80) |
| Median [Min, Max] | 8.00 [1.00, 10.0] | 7.00 [1.00, 10.0] |
| Ob32 | ||
| Mean (SD) | 7.18 (2.74) | 6.85 (2.95) |
| Median [Min, Max] | 8.00 [1.00, 10.0] | 7.00 [1.00, 10.0] |
| game_cat | ||
| Never | 38 (41.3%) | 35 (26.7%) |
| Very rarely | 26 (28.3%) | 42 (32.1%) |
| Only 1/2 times a week | 19 (20.7%) | 26 (19.8%) |
| 3/4 times a week | 2 (2.2%) | 10 (7.6%) |
| Very often/every day | 7 (7.6%) | 18 (13.7%) |
| FrAlcohol_cat | ||
| Never | 20 (21.7%) | 25 (19.1%) |
| Once | 31 (33.7%) | 43 (32.8%) |
| 2/4 times | 34 (37.0%) | 57 (43.5%) |
| 2/3 times a week | 7 (7.6%) | 3 (2.3%) |
| 5/6 times a week | 0 (0%) | 3 (2.3%) |
| 6 or more times a week | 0 (0%) | 0 (0%) |
| NDrink_cat | ||
| None | 21 (22.8%) | 22 (16.8%) |
| 1/2 drinks | 54 (58.7%) | 85 (64.9%) |
| 3/4 drinks | 11 (12.0%) | 22 (16.8%) |
| 5/6 drinks | 4 (4.3%) | 2 (1.5%) |
| 7/9 drinks | 2 (2.2%) | 0 (0%) |
| 10 or more drinks | 0 (0%) | 0 (0%) |
| FamGuida_cat | ||
| Never | 58 (63.0%) | 82 (62.6%) |
| Sometimes | 33 (35.9%) | 44 (33.6%) |
| Often | 1 (1.1%) | 5 (3.8%) |
| Very often | 0 (0%) | 0 (0%) |
3 CORRELAZIONI
3.1 Solo prima prova
library(psych)
pairs.panels(dsPRE_POST_ok2[, c("Percezione_rischio",
"Dejoy_coinvolgimento","Dejoy_gravità",
"IllusionC1","OptimismB1","Ob31")],
smooth = TRUE, # If TRUE, draws loess smooths
scale = FALSE, # If TRUE, scales the correlation text font
density = TRUE, # If TRUE, adds density plots and histograms
ellipses = FALSE, # If TRUE, draws ellipses
method = "pearson", # Correlation method (also "spearman" or "kendall")
pch = 21, # pch symbol
lm = FALSE, # If TRUE, plots linear fit rather than the LOESS (smoothed) fit
cor = TRUE, # If TRUE, reports correlations
jiggle = TRUE, # If TRUE, data points are jittered
factor = 2, # Jittering factor
hist.col = 4, # Histograms color
stars = TRUE, # If TRUE, adds significance level with stars
ci = TRUE) 
3.2 Solo seconda prova - guida da sobri
Sober <- subset(dsPRE_POST_ok2,
Test == "Driving sober")
library(psych)
pairs.panels(Sober[, c("Percezione_rischio2",
"Dejoy_coinvolgimento2","Dejoy_gravità2",
"IllusionC2","OptimismB2","Ob32",
"Durata","Wpt")],
smooth = TRUE, # If TRUE, draws loess smooths
scale = FALSE, # If TRUE, scales the correlation text font
density = TRUE, # If TRUE, adds density plots and histograms
ellipses = FALSE, # If TRUE, draws ellipses
method = "pearson", # Correlation method (also "spearman" or "kendall")
pch = 21, # pch symbol
lm = FALSE, # If TRUE, plots linear fit rather than the LOESS (smoothed) fit
cor = TRUE, # If TRUE, reports correlations
jiggle = TRUE, # If TRUE, data points are jittered
factor = 2, # Jittering factor
hist.col = 4, # Histograms color
stars = TRUE, # If TRUE, adds significance level with stars
ci = TRUE) 
3.3 Solo seconda prova - guida da ubriachi
DUI <- subset(dsPRE_POST_ok2,
Test == "Driving under the influence")
library(psych)
pairs.panels(DUI[, c("Percezione_rischio2",
"Dejoy_coinvolgimento2","Dejoy_gravità2",
"IllusionC2","OptimismB2","Ob32",
"Durata","Wpt")],
smooth = TRUE, # If TRUE, draws loess smooths
scale = FALSE, # If TRUE, scales the correlation text font
density = TRUE, # If TRUE, adds density plots and histograms
ellipses = FALSE, # If TRUE, draws ellipses
method = "pearson", # Correlation method (also "spearman" or "kendall")
pch = 21, # pch symbol
lm = FALSE, # If TRUE, plots linear fit rather than the LOESS (smoothed) fit
cor = TRUE, # If TRUE, reports correlations
jiggle = TRUE, # If TRUE, data points are jittered
factor = 2, # Jittering factor
hist.col = 4, # Histograms color
stars = TRUE, # If TRUE, adds significance level with stars
ci = TRUE) 
4 REGRESSIONI
4.1 Percezione del rischio
library(tidyr)
dsPRE_POST_ok2$Code <- factor(dsPRE_POST_ok2$Code3)
ds_long <- reshape(dsPRE_POST_ok2, varying = list(c("Percezione_rischio", "Percezione_rischio2"),
c("Dejoy_coinvolgimento", "Dejoy_coinvolgimento2"), c("Dejoy_gravità", "Dejoy_gravità2"),
c("IllusionC1", "IllusionC2"), c("Ob11", "Ob21"), c("Ob31", "Ob32")), v.names = c("Percezione_rischio",
"Dejoy_coinvolgimento", "Dejoy_gravità", "IllusionC", "OptimismB", "PoliceStop"),
direction = "long", idvar = "Code3")
ds_long$Time <- factor(ds_long$time, levels = c(1, 2), labels = c("BASELINE", "POST"))4.1.1 Modello 1
library(lme4)
library(lmerTest)
library(car)
M1 <- lmer(Percezione_rischio ~ Test * Time + Durata + Genere + (1 | Code), data = ds_long,
REML = F)
Anova(M1, type = 3)summary(M1)Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
method [lmerModLmerTest]
Formula: Percezione_rischio ~ Test * Time + Durata + Genere + (1 | Code)
Data: ds_long
AIC BIC logLik deviance df.resid
1374.3 1407.1 -679.2 1358.3 438
Scaled residuals:
Min 1Q Median 3Q Max
-4.99823 -0.21691 0.20630 0.46607 1.96328
Random effects:
Groups Name Variance Std.Dev.
Code (Intercept) 0.52344 0.72349
Residual 0.81412 0.90228
Number of obs: 446, groups: Code, 223
Fixed effects:
Estimate Std. Error df
(Intercept) 9.024946 0.164297 307.200405
TestDriving under the influence -0.062303 0.159858 381.674870
TimePOST -0.402174 0.133035 223.000000
Durata 0.045126 0.024895 223.000000
GenereDonna 0.527508 0.133197 223.000000
TestDriving under the influence:TimePOST 0.328891 0.173573 223.000000
t value Pr(>|t|)
(Intercept) 54.9307 < 0.00000000000000022 ***
TestDriving under the influence -0.3897 0.6969473
TimePOST -3.0231 0.0027950 **
Durata 1.8126 0.0712359 .
GenereDonna 3.9603 0.0001007 ***
TestDriving under the influence:TimePOST 1.8948 0.0594079 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) TsDuti TmPOST Durata GnrDnn
TstDrvnguti -0.674
TimePOST -0.405 0.416
Durata -0.541 0.132 0.000
GenereDonna -0.479 0.136 0.000 0.134
TDuti:TPOST 0.310 -0.543 -0.766 0.000 0.0004.1.1.1 Confidence intervals
confint(M1, level = 0.95) 2.5 % 97.5 %
.sig01 0.5901721386 0.855294223
.sigma 0.8246072164 0.992968249
(Intercept) 8.7019192672 9.347973538
TestDriving under the influence -0.3764102346 0.251804446
TimePOST -0.6640436839 -0.140304142
Durata -0.0038791521 0.094130431
GenereDonna 0.2653176447 0.789697983
TestDriving under the influence:TimePOST -0.0127748354 0.6705577764.1.1.2 Standardized coefficients
stdCoef.merMod <- function(object) {
sdy <- sd(getME(object, "y"))
sdx <- apply(getME(object, "X"), 2, sd)
sc <- fixef(object) * sdx/sdy
se.fixef <- coef(summary(object))[, "Std. Error"]
se <- se.fixef * sdx/sdy
return(data.frame(stdcoef = sc, stdse = se))
}
stdCoef.merMod(M1)library(interactions)
library(jtools)
FY <- cat_plot(M1, pred = Test, modx = Time, interval = TRUE, plot.points = TRUE,
point.size = 1, jitter = 0.5, y.label = "Risk perception\n", x.label = "\nCondition",
colors = c("red", "blue"), legend.main = "Session", line.thickness = 0.5) + theme_apa(legend.pos = "bottomleft",
legend.use.title = TRUE, legend.font.size = 12, facet.title.size = 12) + theme(axis.text.x = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.text.y = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.title = element_text(face = "bold")) +
scale_y_continuous(limits = c(1, 11), breaks = seq(1, 10, 1))
FY
4.1.2 Modello 2: Gender interactions (3-way n.s.)
M2 <- lmer(Percezione_rischio ~ Test * Time + Test * Genere + Durata + Time * Genere +
(1 | Code), data = ds_long, REML = F) # I checked the three-way and it is n.s.
Anova(M2, type = 3)summary(M2)Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
method [lmerModLmerTest]
Formula: Percezione_rischio ~ Test * Time + Test * Genere + Durata + Time *
Genere + (1 | Code)
Data: ds_long
AIC BIC logLik deviance df.resid
1374.5 1415.5 -677.3 1354.5 436
Scaled residuals:
Min 1Q Median 3Q Max
-4.97491 -0.20604 0.21631 0.40809 1.90280
Random effects:
Groups Name Variance Std.Dev.
Code (Intercept) 0.52493 0.72452
Residual 0.80361 0.89644
Number of obs: 446, groups: Code, 223
Fixed effects:
Estimate Std. Error df
(Intercept) 9.024432 0.187664 316.270660
TestDriving under the influence 0.030539 0.199880 322.172588
TimePOST -0.553515 0.159137 223.000000
GenereDonna 0.524139 0.219843 302.533131
Durata 0.045823 0.024856 223.000000
TestDriving under the influence:TimePOST 0.371686 0.174260 223.000000
TestDriving under the influence:GenereDonna -0.253298 0.266168 223.000000
TimePOST:GenereDonna 0.296242 0.173485 223.000000
t value Pr(>|t|)
(Intercept) 48.0882 < 0.00000000000000022 ***
TestDriving under the influence 0.1528 0.8786630
TimePOST -3.4782 0.0006068 ***
GenereDonna 2.3842 0.0177345 *
Durata 1.8436 0.0665748 .
TestDriving under the influence:TimePOST 2.1329 0.0340229 *
TestDriving under the influence:GenereDonna -0.9516 0.3423072
TimePOST:GenereDonna 1.7076 0.0891027 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) TsDuti TmPOST GnrDnn Durata TDuti:T TDuti:G
TstDrvnguti -0.740
TimePOST -0.424 0.310
GenereDonna -0.641 0.506 0.220
Durata -0.485 0.123 0.000 0.101
TDuti:TPOST 0.301 -0.436 -0.710 -0.057 0.000
TstDutin:GD 0.427 -0.601 0.000 -0.692 -0.029 0.000
TmPOST:GnrD 0.236 -0.063 -0.557 -0.395 0.000 0.144 0.000 4.1.2.1 Confidence intervals
confint(M2, level = 0.95) 2.5 % 97.5 %
.sig01 0.5923463648 0.855559120
.sigma 0.8192682113 0.986539216
(Intercept) 8.6554946244 9.393368459
TestDriving under the influence -0.3623916548 0.423469195
TimePOST -0.8667664933 -0.240263571
GenereDonna 0.0918817918 0.956396614
Durata -0.0031039534 0.094749754
TestDriving under the influence:TimePOST 0.0286657858 0.714705879
TestDriving under the influence:GenereDonna -0.7772329223 0.270637160
TimePOST:GenereDonna -0.0452511792 0.6377355604.1.2.2 Standardized coefficients
stdCoef.merMod <- function(object) {
sdy <- sd(getME(object, "y"))
sdx <- apply(getME(object, "X"), 2, sd)
sc <- fixef(object) * sdx/sdy
se.fixef <- coef(summary(object))[, "Std. Error"]
se <- se.fixef * sdx/sdy
return(data.frame(stdcoef = sc, stdse = se))
}
stdCoef.merMod(M2)4.1.2.3 Pairwise comparisons
library(emmeans)
library(qualitema)
# x <- emm_cohend( model = M2, formula = pairwise ~ Time | Test, adjust =
# 'bonferroni')library(interactions)
library(jtools)
FY <- cat_plot(M2, pred = Test, modx = Time, interval = TRUE, plot.points = TRUE,
point.size = 1, jitter = 0.5, y.label = "Risk perception\n", x.label = "\nCondition",
colors = c("red", "blue"), legend.main = "Session", line.thickness = 0.5) + theme_apa(legend.pos = "bottomleft",
legend.use.title = TRUE, legend.font.size = 12, facet.title.size = 12) + theme(axis.text.x = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.text.y = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.title = element_text(face = "bold")) +
scale_y_continuous(limits = c(1, 11), breaks = seq(1, 10, 1))
FY
4.1.3 Modello 2b: Illusion of control
M3 <- lmer(Percezione_rischio ~ Test * Time + Test * Genere + Time * Genere + IllusionC +
Durata + (1 | Code), data = ds_long, REML = F) # I checked the three-way and it is n.s.
Anova(M3, type = 3)summary(M3)Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
method [lmerModLmerTest]
Formula: Percezione_rischio ~ Test * Time + Test * Genere + Time * Genere +
IllusionC + Durata + (1 | Code)
Data: ds_long
AIC BIC logLik deviance df.resid
1349.4 1394.5 -663.7 1327.4 435
Scaled residuals:
Min 1Q Median 3Q Max
-5.08075 -0.23811 0.21070 0.44472 2.45212
Random effects:
Groups Name Variance Std.Dev.
Code (Intercept) 0.37256 0.61038
Residual 0.83462 0.91358
Number of obs: 446, groups: Code, 223
Fixed effects:
Estimate Std. Error df
(Intercept) 9.566083 0.202146 341.220412
TestDriving under the influence -0.036737 0.188720 337.474846
TimePOST -0.637787 0.162899 220.947868
GenereDonna 0.343962 0.208961 315.870522
IllusionC -0.232813 0.042260 375.176350
Durata 0.042927 0.022953 218.195699
TestDriving under the influence:TimePOST 0.357192 0.177611 218.198197
TestDriving under the influence:GenereDonna -0.167250 0.246226 218.644759
TimePOST:GenereDonna 0.359655 0.177175 219.473394
t value Pr(>|t|)
(Intercept) 47.3226 < 0.00000000000000022 ***
TestDriving under the influence -0.1947 0.8457730
TimePOST -3.9152 0.0001203 ***
GenereDonna 1.6461 0.1007462
IllusionC -5.5091 0.00000006711 ***
Durata 1.8702 0.0627938 .
TestDriving under the influence:TimePOST 2.0111 0.0455457 *
TestDriving under the influence:GenereDonna -0.6793 0.4976971
TimePOST:GenereDonna 2.0299 0.0435692 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) TsDuti TmPOST GnrDnn IllsnC Durata TDuti:T TDuti:G
TstDrvnguti -0.675
TimePOST -0.445 0.339
GenereDonna -0.627 0.496 0.249
IllusionC -0.486 0.065 0.094 0.157
Durata -0.427 0.121 0.002 0.102 0.023
TDuti:TPOST 0.278 -0.470 -0.705 -0.059 0.015 0.000
TstDutin:GD 0.396 -0.590 -0.006 -0.681 -0.063 -0.031 -0.001
TmPOST:GnrD 0.255 -0.072 -0.559 -0.432 -0.065 -0.001 0.143 0.004 4.1.3.1 Confidence intervals
confint(M3, level = 0.95) 2.5 % 97.5 %
.sig01 0.4612834891 0.746478038
.sigma 0.8340605531 1.006418223
(Intercept) 9.1651564619 9.964004956
TestDriving under the influence -0.4075237066 0.334430411
TimePOST -0.9589352107 -0.317475129
GenereDonna -0.0664945332 0.755572042
IllusionC -0.3171592049 -0.147425736
Durata -0.0022447538 0.088128599
TestDriving under the influence:TimePOST 0.0074695753 0.706769365
TestDriving under the influence:GenereDonna -0.6524502439 0.317081713
TimePOST:GenereDonna 0.0111579843 0.7087852594.1.3.2 Standardized coefficients
stdCoef.merMod <- function(object) {
sdy <- sd(getME(object, "y"))
sdx <- apply(getME(object, "X"), 2, sd)
sc <- fixef(object) * sdx/sdy
se.fixef <- coef(summary(object))[, "Std. Error"]
se <- se.fixef * sdx/sdy
return(data.frame(stdcoef = sc, stdse = se))
}
stdCoef.merMod(M3)4.1.4 Modello 2c: Illusion of control + optmism
M4 <- lmer(Percezione_rischio ~ Test * Time + Test * Genere + Time * Genere + IllusionC +
OptimismB + Durata + (1 | Code), data = ds_long, REML = F) # I checked the three-way and it is n.s.
Anova(M4, type = 3)summary(M4)Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
method [lmerModLmerTest]
Formula: Percezione_rischio ~ Test * Time + Test * Genere + Time * Genere +
IllusionC + OptimismB + Durata + (1 | Code)
Data: ds_long
AIC BIC logLik deviance df.resid
1345.6 1394.8 -660.8 1321.6 434
Scaled residuals:
Min 1Q Median 3Q Max
-5.09963 -0.26316 0.16826 0.47858 2.42714
Random effects:
Groups Name Variance Std.Dev.
Code (Intercept) 0.34367 0.58624
Residual 0.84085 0.91698
Number of obs: 446, groups: Code, 223
Fixed effects:
Estimate Std. Error df
(Intercept) 9.700355 0.206639 345.512519
TestDriving under the influence -0.050059 0.186541 341.053330
TimePOST -0.616543 0.163741 220.714629
GenereDonna 0.289797 0.207432 319.474006
IllusionC -0.221101 0.042221 376.576171
OptimismB -0.041228 0.017017 435.234828
Durata 0.043304 0.022576 217.365143
TestDriving under the influence:TimePOST 0.335174 0.178499 218.030306
TestDriving under the influence:GenereDonna -0.095417 0.243940 220.304431
TimePOST:GenereDonna 0.364407 0.177832 218.644478
t value Pr(>|t|)
(Intercept) 46.9436 < 0.00000000000000022 ***
TestDriving under the influence -0.2684 0.7885896
TimePOST -3.7654 0.0002133 ***
GenereDonna 1.3971 0.1633610
IllusionC -5.2368 0.0000002724 ***
OptimismB -2.4227 0.0158115 *
Durata 1.9181 0.0564037 .
TestDriving under the influence:TimePOST 1.8777 0.0617529 .
TestDriving under the influence:GenereDonna -0.3911 0.6960653
TimePOST:GenereDonna 2.0492 0.0416394 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) TsDuti TmPOST GnrDnn IllsnC OptmsB Durata TDuti:T TDuti:G
TstDrvnguti -0.659
TimePOST -0.421 0.342
GenereDonna -0.629 0.493 0.245
IllusionC -0.430 0.060 0.099 0.140
OptimismB -0.256 0.028 -0.056 0.104 -0.140
Durata -0.409 0.121 0.003 0.100 0.024 -0.007
TDuti:TPOST 0.259 -0.475 -0.706 -0.054 0.007 0.051 0.000
TstDutin:GD 0.409 -0.586 0.001 -0.682 -0.046 -0.120 -0.030 -0.007
TmPOST:GnrD 0.251 -0.073 -0.558 -0.438 -0.062 -0.009 -0.001 0.142 0.005 4.1.4.1 Confidence intervals
confint(M4, level = 0.95) 2.5 % 97.5 %
.sig01 0.4318228974 0.7239525939
.sigma 0.8370095461 1.0103440037
(Intercept) 9.2893566470 10.1077690773
TestDriving under the influence -0.4165380520 0.3168532684
TimePOST -0.9391535925 -0.2944512230
GenereDonna -0.1176386393 0.6986872502
IllusionC -0.3049880866 -0.1363258522
OptimismB -0.0748227690 -0.0075549747
Durata -0.0011294952 0.0877606421
TestDriving under the influence:TimePOST -0.0164377956 0.6863842647
TestDriving under the influence:GenereDonna -0.5766172509 0.3841205659
TimePOST:GenereDonna 0.0146168914 0.71484144864.1.4.2 Standardized coefficients
stdCoef.merMod <- function(object) {
sdy <- sd(getME(object, "y"))
sdx <- apply(getME(object, "X"), 2, sd)
sc <- fixef(object) * sdx/sdy
se.fixef <- coef(summary(object))[, "Std. Error"]
se <- se.fixef * sdx/sdy
return(data.frame(stdcoef = sc, stdse = se))
}
stdCoef.merMod(M4)4.1.5 Modello 3: DEJOY SERIOUSNESS SCALE
M3 <- lmer(Percezione_rischio ~ Test * Time + Time * Dejoy_gravità + Test * Dejoy_gravità +
Genere + Durata + (1 | Code), data = ds_long, REML = F)
Anova(M3, type = 3)summary(M3)Linear mixed model fit by maximum likelihood . t-tests use Satterthwaite's
method [lmerModLmerTest]
Formula: Percezione_rischio ~ Test * Time + Time * Dejoy_gravità + Test *
Dejoy_gravità + Genere + Durata + (1 | Code)
Data: ds_long
AIC BIC logLik deviance df.resid
1329.4 1374.5 -653.7 1307.4 435
Scaled residuals:
Min 1Q Median 3Q Max
-4.18815 -0.24787 0.12149 0.46809 2.39543
Random effects:
Groups Name Variance Std.Dev.
Code (Intercept) 0.43097 0.65648
Residual 0.74866 0.86525
Number of obs: 446, groups: Code, 223
Fixed effects:
Estimate Std. Error df
(Intercept) 7.765357 0.661128 444.924542
TestDriving under the influence -0.621841 0.747730 442.784855
TimePOST -2.171996 0.636139 298.621689
Dejoy_gravità 0.336321 0.169463 442.922033
GenereDonna 0.444643 0.124433 223.149724
Durata 0.050072 0.023291 223.667300
TestDriving under the influence:TimePOST 0.346687 0.166676 221.448085
TimePOST:Dejoy_gravità 0.462376 0.162937 302.235008
TestDriving under the influence:Dejoy_gravità 0.151589 0.193087 443.670597
t value Pr(>|t|)
(Intercept) 11.7456 < 0.00000000000000022 ***
TestDriving under the influence -0.8316 0.4060612
TimePOST -3.4143 0.0007278 ***
Dejoy_gravità 1.9846 0.0478024 *
GenereDonna 3.5734 0.0004318 ***
Durata 2.1498 0.0326447 *
TestDriving under the influence:TimePOST 2.0800 0.0386762 *
TimePOST:Dejoy_gravità 2.8378 0.0048504 **
TestDriving under the influence:Dejoy_gravità 0.7851 0.4328254
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects: (Intr) TsDuti TmPOST Djy_gr GnrDnn Durata TDuti:T TPOST:
TstDrvnguti -0.689
TimePOST -0.531 0.123
Dejoy_gravt -0.973 0.680 0.518
GenereDonna -0.089 0.045 0.028 -0.022
Durata -0.078 -0.073 0.005 -0.048 0.129
TDuti:TPOST 0.099 -0.110 -0.204 -0.026 -0.001 -0.001
TmPOST:Djy_ 0.522 -0.109 -0.980 -0.529 -0.028 -0.005 0.052
TstDutin:D_ 0.665 -0.980 -0.101 -0.688 -0.019 0.102 -0.002 0.104confint(M3) 2.5 % 97.5 %
.sig01 0.5253257310 0.783291053
.sigma 0.7904788498 0.952567461
(Intercept) 6.4584813052 9.071339484
TestDriving under the influence -2.0945088792 0.849700018
TimePOST -3.4217917903 -0.919403033
Dejoy_gravità 0.0015270336 0.671517649
GenereDonna 0.1998121321 0.689699464
Durata 0.0042363932 0.095930858
TestDriving under the influence:TimePOST 0.0185559257 0.674758774
TimePOST:Dejoy_gravità 0.1415507678 0.782481771
TestDriving under the influence:Dejoy_gravità -0.2284434289 0.531871032stdCoef.merMod(M3)# M3.3 <- lmer(Percezione_rischio ~ Test*Time*Dejoy_gravità + Genere + Durata +
# (1|Code), data = ds_long, REML = F) Anova(M3.3, type = 3) summary(M3.3)
# confint(M3.3) stdCoef.merMod(M3.3)library(interactions)
sim_slopes(M3, pred = Dejoy_gravità, modx = Time, confint = T)SIMPLE SLOPES ANALYSIS
Slope of Dejoy_gravità when Time = BASELINE:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
0.34 0.17 0.00 0.67 1.98 0.05
Slope of Dejoy_gravità when Time = POST:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
0.80 0.16 0.48 1.11 4.95 0.00FY2 <- interact_plot(M3, pred = Dejoy_gravità, modx = Time, interval = TRUE, plot.points = TRUE,
point.size = 1, jitter = 0.5, y.label = "Risk perception\n", x.label = "\nDejoy seriousness",
colors = c("red", "blue"), legend.main = "Session", line.thickness = 1) + theme_apa(legend.pos = "bottomleft",
legend.use.title = TRUE, legend.font.size = 12, facet.title.size = 12) + theme(axis.text.x = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.text.y = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.title = element_text(face = "bold")) +
scale_y_continuous(limits = c(1, 11), breaks = seq(1, 10, 1))
FY2
# write.table(dsPRE_POST_ok2, file = 'ds_pre_post.csv', sep = ',', na = ' ',
# dec = '.', row.names = FALSE, col.names = TRUE)5 FOLLOW UP
followup <- read.table(file = "followup.csv", sep = ",", dec = ".", header = TRUE)
followup$Code <- as.factor(followup$Cod_ID_min_b)
# left_join(dsPRE_POST_ok2, followup, by = 'Code')## Compute average score for Risk Perception in the followup
followup$Percezione_rischio_f <- rowMeans(followup[, c("RP_scale_1_b", "RP_scale_2_b",
"RP_scale_3_b", "RP_scale_4_b", "RP_scale_5_b")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAriskb <- cronbach(cbind(followup[, c("RP_scale_1_b", "RP_scale_2_b", "RP_scale_3_b",
"RP_scale_4_b", "RP_scale_5_b")]))
ALFAriskb$sample.size
[1] 140
$number.of.items
[1] 5
$alpha
[1] 0.87372334## Compute average score for Vankov scale in the followup
followup$Vankov_f <- rowMeans(followup[, c("DUI_int_b", "Inst_att_b", "Per_cont_b",
"Self_eff_b", "Des_norm_b", "Sub_norm_b", "Aff_att_b")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAvankovb <- cronbach(cbind(followup[, c("DUI_int_b", "Inst_att_b", "Per_cont_b",
"Self_eff_b", "Des_norm_b", "Sub_norm_b", "Aff_att_b")]))
ALFAvankovb$sample.size
[1] 140
$number.of.items
[1] 7
$alpha
[1] 0.12166871## Compute average score for Dejoy scale (involvement) in the followup
followup$Dejoy_coinvolgimento_f <- rowMeans(followup[, c("involv_DJ_1_b", "involv_DJ_2_b",
"involv_DJ_3_b", "involv_DJ_4_b", "involv_DJ_5_b", "involv_DJ_6_b", "involv_DJ_7_b",
"involv_DJ_8_b", "involv_DJ_9_b", "involv_DJ_10_b")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyCb <- cronbach(cbind(followup[, c("involv_DJ_1_b", "involv_DJ_2_b", "involv_DJ_3_b",
"involv_DJ_4_b", "involv_DJ_5_b", "involv_DJ_6_b", "involv_DJ_7_b", "involv_DJ_8_b",
"involv_DJ_9_b", "involv_DJ_10_b")]))
ALFAdejoyCb$sample.size
[1] 140
$number.of.items
[1] 10
$alpha
[1] 0.83871183## Compute average score for Dejoy scale (gravity) in the before the driving
## test
followup$Dejoy_gravità_f <- rowMeans(followup[, c("grav_DJ_1_b", "grav_DJ_2_b",
"grav_DJ_3_b", "grav_DJ_4_b", "grav_DJ_5_b", "grav_DJ_6_b", "grav_DJ_7_b", "grav_DJ_8_b",
"grav_DJ_9_b", "grav_DJ_10_b")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyGb <- cronbach(cbind(followup[, c("grav_DJ_1_b", "grav_DJ_2_b", "grav_DJ_3_b",
"grav_DJ_4_b", "grav_DJ_5_b", "grav_DJ_6_b", "grav_DJ_7_b", "grav_DJ_8_b", "grav_DJ_9_b",
"grav_DJ_10_b")]))
ALFAdejoyGb$sample.size
[1] 140
$number.of.items
[1] 10
$alpha
[1] 0.78724698## Compute average score for Dejoy scale (control) in the before the driving
## test
followup$Dejoy_controllo_f <- rowMeans(followup[, c("contol_DJ_1_b", "contol_DJ_2_b",
"contol_DJ_3_b", "contol_DJ_4_b", "contol_DJ_5_b", "contol_DJ_6_b", "contol_DJ_7_b",
"contol_DJ_8_b", "contol_DJ_9_b", "contol_DJ_10_b")], na.rm = TRUE)
## Cronbach's alfa
library(psy)
ALFAdejoyConb <- cronbach(cbind(followup[, c("contol_DJ_1_b", "contol_DJ_2_b", "contol_DJ_3_b",
"contol_DJ_4_b", "contol_DJ_5_b", "contol_DJ_6_b", "contol_DJ_7_b", "contol_DJ_8_b",
"contol_DJ_9_b", "contol_DJ_10_b")]))
ALFAdejoyConb$sample.size
[1] 140
$number.of.items
[1] 10
$alpha
[1] 0.62770199followup$Esperienza_sim <- rowMeans(followup[, c("esp_sim_1", "esp_sim_2", "esp_sim_3")],
na.rm = TRUE)
ALFAesp_sim <- cronbach(cbind(followup[, c("esp_sim_1", "esp_sim_2", "esp_sim_3")]))
ALFAesp_sim$sample.size
[1] 140
$number.of.items
[1] 3
$alpha
[1] 0.84301794followup$Self_efficacy <- rowMeans(followup[, c("DUI_int_b", "Inst_att_b", "Per_cont_b",
"Self_eff_b", "Des_norm_b", "Sub_norm_b", "Aff_att_b")], na.rm = TRUE)
ALFAself_eff <- cronbach(cbind(followup[, c("DUI_int_b", "Inst_att_b", "Sub_norm_b")]))
ALFAself_eff$sample.size
[1] 140
$number.of.items
[1] 3
$alpha
[1] 0.61684093followup$fr_drive <- car::recode(followup$fr_drive, "NA=0; 1=1; 5=2; 6=3; 7=4")6 STATISTICHE DESCRITTIVE
followup$Multe <- factor(followup$Multe, levels = c(1, 2), labels = c("Sì", "No"))
followup$Patente <- factor(followup$license, levels = c(1, 2), labels = c("Sì",
"No"))
followup$Incidenti <- factor(followup$inc, levels = c(1, 2), labels = c("Sì", "No"))
followup$DUI <- factor(followup$alc_drive, levels = c(1, 2), labels = c("Sì", "No"))
library(table1)
T1f <- table1(~fr_drive + Patente + Multe + Incidenti + DUI + Esperienza_sim, data = followup)
T1f| Overall (N=140) |
|
|---|---|
| fr_drive | |
| Mean (SD) | 2.42 (1.26) |
| Median [Min, Max] | 2.00 [0, 4.00] |
| Patente | |
| Sì | 126 (90.0%) |
| No | 14 (10.0%) |
| Multe | |
| Sì | 8 (5.7%) |
| No | 118 (84.3%) |
| Missing | 14 (10.0%) |
| Incidenti | |
| Sì | 3 (2.1%) |
| No | 123 (87.9%) |
| Missing | 14 (10.0%) |
| DUI | |
| Sì | 116 (82.9%) |
| No | 5 (3.6%) |
| Missing | 19 (13.6%) |
| Esperienza_sim | |
| Mean (SD) | 5.57 (2.21) |
| Median [Min, Max] | 5.33 [1.00, 10.0] |
followup$IllusionCf <- rowMeans(followup[, c("ill_co1_b", "ill_co2_b")], na.rm = TRUE)
followup$OptimismBf <- rowMeans(followup[, c("Ob1_b", "Ob2_b")], na.rm = TRUE)
ds_full2 <- left_join(followup, dsPRE_POST_ok2, by = "Code")
ds_full2 <- subset(ds_full2, Code != "va637ne")
ds_full2 <- subset(ds_full2, Test != "<NA>")ds_long_f <- reshape(ds_full2, varying = list(c("Percezione_rischio", "Percezione_rischio2",
"Percezione_rischio_f"), c("Dejoy_coinvolgimento", "Dejoy_coinvolgimento2", "Dejoy_coinvolgimento_f"),
c("Dejoy_gravità", "Dejoy_gravità2", "Dejoy_gravità_f"), c("IllusionC1", "IllusionC2",
"IllusionCf"), c("Ob11", "Ob21", "Ob1_b"), c("Ob31", "Ob32", "Ob3_b")), v.names = c("Percezione_rischio",
"Dejoy_coinvolgimento", "Dejoy_gravità", "IllusionC", "OptimismB", "PoliceStop"),
direction = "long", idvar = "Code")
ds_long_f$Time <- factor(ds_long_f$time, levels = c(1, 2, 3), labels = c("BASELINE",
"POST", "FOLLOW_UP"))
# dsfp <- subset(ds_long_f, Time == 'FOLLOW_UP')
T1p2 <- table1(~Percezione_rischio + Dejoy_coinvolgimento + Dejoy_gravità + Dejoy_controllo +
IllusionC + OptimismB + PoliceStop | Test + Time, data = ds_long_f)
T1p2Driving sober |
Driving under the influence |
Overall |
|||||||
|---|---|---|---|---|---|---|---|---|---|
| BASELINE (N=44) |
POST (N=44) |
FOLLOW_UP (N=44) |
BASELINE (N=58) |
POST (N=58) |
FOLLOW_UP (N=58) |
BASELINE (N=102) |
POST (N=102) |
FOLLOW_UP (N=102) |
|
| Percezione_rischio | |||||||||
| Mean (SD) | 9.43 (0.861) | 9.31 (1.01) | 9.03 (1.56) | 9.15 (0.901) | 9.32 (0.927) | 9.03 (1.14) | 9.27 (0.891) | 9.32 (0.957) | 9.03 (1.33) |
| Median [Min, Max] | 10.0 [7.20, 10.0] | 9.80 [5.60, 10.0] | 9.60 [1.00, 10.0] | 9.30 [6.60, 10.0] | 9.60 [5.80, 10.0] | 9.40 [5.40, 10.0] | 9.60 [6.60, 10.0] | 9.80 [5.60, 10.0] | 9.50 [1.00, 10.0] |
| Dejoy_coinvolgimento | |||||||||
| Mean (SD) | 2.25 (0.718) | 2.72 (0.770) | 2.42 (0.671) | 2.52 (0.971) | 2.66 (0.766) | 2.44 (0.733) | 2.40 (0.877) | 2.68 (0.765) | 2.44 (0.704) |
| Median [Min, Max] | 2.25 [1.00, 3.60] | 2.70 [1.00, 5.00] | 2.40 [1.00, 4.50] | 2.25 [1.00, 5.00] | 2.70 [1.10, 4.30] | 2.40 [1.00, 4.80] | 2.25 [1.00, 5.00] | 2.70 [1.00, 5.00] | 2.40 [1.00, 4.80] |
| Dejoy_gravità | |||||||||
| Mean (SD) | 3.72 (0.481) | 3.76 (0.501) | 3.66 (0.578) | 3.80 (0.463) | 3.83 (0.418) | 3.81 (0.488) | 3.77 (0.470) | 3.80 (0.454) | 3.75 (0.532) |
| Median [Min, Max] | 3.80 [1.60, 4.80] | 3.70 [2.40, 5.00] | 3.70 [1.00, 4.80] | 3.80 [2.10, 4.80] | 3.80 [2.60, 5.00] | 3.80 [1.90, 5.00] | 3.80 [1.60, 4.80] | 3.80 [2.40, 5.00] | 3.80 [1.00, 5.00] |
| Dejoy_controllo | |||||||||
| Mean (SD) | 3.30 (0.497) | 3.30 (0.497) | 3.30 (0.497) | 3.31 (0.499) | 3.31 (0.499) | 3.31 (0.499) | 3.31 (0.496) | 3.31 (0.496) | 3.31 (0.496) |
| Median [Min, Max] | 3.20 [2.50, 5.00] | 3.20 [2.50, 5.00] | 3.20 [2.50, 5.00] | 3.25 [2.10, 4.40] | 3.25 [2.10, 4.40] | 3.25 [2.10, 4.40] | 3.20 [2.10, 5.00] | 3.20 [2.10, 5.00] | 3.20 [2.10, 5.00] |
| IllusionC | |||||||||
| Mean (SD) | 1.84 (1.31) | 1.58 (1.30) | 1.74 (1.09) | 1.86 (1.64) | 1.41 (0.969) | 1.53 (0.858) | 1.85 (1.50) | 1.49 (1.12) | 1.62 (0.966) |
| Median [Min, Max] | 1.00 [1.00, 5.50] | 1.00 [1.00, 7.50] | 1.00 [1.00, 5.50] | 1.00 [1.00, 8.50] | 1.00 [1.00, 6.00] | 1.00 [1.00, 5.00] | 1.00 [1.00, 8.50] | 1.00 [1.00, 7.50] | 1.00 [1.00, 5.50] |
| OptimismB | |||||||||
| Mean (SD) | 3.09 (2.76) | 3.48 (2.97) | 3.18 (2.76) | 3.69 (3.50) | 3.62 (3.27) | 3.43 (3.07) | 3.43 (3.20) | 3.56 (3.13) | 3.32 (2.93) |
| Median [Min, Max] | 2.00 [1.00, 10.0] | 2.00 [1.00, 10.0] | 2.00 [1.00, 10.0] | 1.00 [1.00, 10.0] | 2.00 [1.00, 10.0] | 2.00 [1.00, 10.0] | 1.50 [1.00, 10.0] | 2.00 [1.00, 10.0] | 2.00 [1.00, 10.0] |
| PoliceStop | |||||||||
| Mean (SD) | 7.09 (2.48) | 7.25 (2.61) | 6.30 (2.75) | 6.69 (2.92) | 6.86 (2.86) | 7.02 (2.47) | 6.86 (2.73) | 7.03 (2.74) | 6.71 (2.61) |
| Median [Min, Max] | 8.00 [1.00, 10.0] | 8.00 [1.00, 10.0] | 6.00 [1.00, 10.0] | 7.00 [1.00, 10.0] | 7.50 [1.00, 10.0] | 7.00 [1.00, 10.0] | 7.00 [1.00, 10.0] | 8.00 [1.00, 10.0] | 6.50 [1.00, 10.0] |
ds_long_f$game1 <- factor(ds_long_f$game1, levels = c(1, 2, 3, 4, 5), labels = c("Never",
"Very rarely", "Only 1/2 times a week", "3/4 times a week", "Very often/every day"))
ds_long_f$Fr_alcol1 <- factor(ds_long_f$Fr_alcol1, levels = c(1, 2, 3, 4, 5, 6),
labels = c("Never", "Once", "2/4 times", "2/3 times a week", "5/6 times a week",
"6 or more times a week"))
ds_long_f$M_drink1 <- factor(ds_long_f$M_drink1, levels = c(1, 2, 3, 4, 5, 6), labels = c("None",
"1/2 drinks", "3/4 drinks", "5/6 drinks", "7/9 drinks", "10 or more drinks"))
ds_long_f$Fam_guida1 <- factor(ds_long_f$Fam_guida1, levels = c(1, 2, 3, 4), labels = c("Never",
"Sometimes", "Often", "Very often"))7 CORRELAZIONI
7.1 Solo seconda prova - guida da sobri
library(psych)
ds_long_f$Duration <- as.numeric(ds_long_f$Duration)
post <- subset(ds_long_f, Time == "POST")
sober <- subset(post, Test == "Driving sober")
corPlot(sober[, c("Percezione_rischio", "Dejoy_coinvolgimento", "Dejoy_gravità",
"IllusionC", "OptimismB", "PoliceStop", "Duration1", "Wpt")], stars = T, cex = 0.5,
scale = F, diag = F, upper = F, show.legend = F)
7.2 Solo seconda prova - guida da ubriachi
library(psych)
DUI <- subset(post, Test == "Driving under the influence")
corPlot(DUI[, c("Percezione_rischio", "Dejoy_coinvolgimento", "Dejoy_gravità", "IllusionC",
"OptimismB", "PoliceStop", "Duration1", "Wpt")], stars = T, cex = 0.5, scale = F,
diag = F, upper = F, show.legend = F)
7.3 Solo follow-up - guida da sobri
library(psych)
follow <- subset(ds_long_f, Time == "FOLLOW_UP")
f_sober <- subset(follow, Test == "Driving sober")
corPlot(f_sober[, c("Percezione_rischio", "Dejoy_coinvolgimento", "Dejoy_gravità",
"IllusionC", "OptimismB", "PoliceStop")], stars = T, cex = 0.5, scale = F, diag = F,
upper = F, show.legend = F)
7.4 Solo follow-up - guida da ubriachi
library(psych)
f_DUI <- subset(follow, Test == "Driving under the influence")
corPlot(f_DUI[, c("Percezione_rischio", "Dejoy_coinvolgimento", "Dejoy_gravità",
"IllusionC", "OptimismB", "PoliceStop")], stars = T, cex = 0.5, scale = F, diag = F,
upper = F, show.legend = F)
8 REGRESSIONI (TUTTE LE SESSIONI)
8.1 Modello 1
FUP <- c(-1, -1, 2)
PRE_POST <- c(-1, 1, 0)
contrasts(ds_long_f$Time) <- cbind(FUP, PRE_POST)
M1fl <- lmer(Percezione_rischio ~ Test * Time + Durata + Genere + (1 | Code), data = ds_long_f,
REML = F)
Anova(M1fl, type = 3)summ(M1fl)| Observations | 306 |
| Dependent variable | Percezione_rischio |
| Type | Mixed effects linear regression |
| AIC | 876.31 |
| BIC | 913.54 |
| Pseudo-R² (fixed effects) | 0.07 |
| Pseudo-R² (total) | 0.41 |
| Est. | S.E. | t val. | d.f. | p | |
|---|---|---|---|---|---|
| (Intercept) | 8.80 | 0.20 | 44.40 | 102.00 | 0.00 |
| TestDriving under the influence | 0.07 | 0.17 | 0.41 | 102.00 | 0.68 |
| TimeFUP | -0.11 | 0.05 | -2.23 | 204.00 | 0.03 |
| TimePRE_POST | -0.06 | 0.09 | -0.67 | 204.00 | 0.50 |
| Durata | 0.05 | 0.03 | 1.71 | 102.00 | 0.09 |
| GenereDonna | 0.44 | 0.16 | 2.70 | 102.00 | 0.01 |
| TestDriving under the influence:TimeFUP | 0.05 | 0.07 | 0.67 | 204.00 | 0.50 |
| TestDriving under the influence:TimePRE_POST | 0.15 | 0.12 | 1.26 | 204.00 | 0.21 |
| p values calculated using Satterthwaite d.f. |
| Group | Parameter | Std. Dev. |
|---|---|---|
| Code | (Intercept) | 0.63 |
| Residual | 0.83 |
| Group | # groups | ICC |
|---|---|---|
| Code | 102 | 0.37 |
8.1.1 Confidence intervals
confint(M1fl) 2.5 % 97.5 %
.sig01 0.4955677864 0.782354200
.sigma 0.7543116734 0.916052776
(Intercept) 8.4119200427 9.196604322
TestDriving under the influence -0.2637223638 0.400371746
TimeFUP -0.2140667736 -0.013205954
TimePRE_POST -0.2330414818 0.114859664
Durata -0.0082663687 0.115525560
GenereDonna 0.1168992781 0.758218303
TestDriving under the influence:TimeFUP -0.0879382172 0.178429335
TestDriving under the influence:TimePRE_POST -0.0836591237 0.3777030118.1.2 Standard coefficients
stdCoef.merMod <- function(object) {
sdy <- sd(getME(object, "y"))
sdx <- apply(getME(object, "X"), 2, sd)
sc <- fixef(object) * sdx/sdy
se.fixef <- coef(summary(object))[, "Std. Error"]
se <- se.fixef * sdx/sdy
return(data.frame(stdcoef = sc, stdse = se))
}
stdCoef.merMod(M1fl)8.2 Modello 2
M2fl <- lmer(Percezione_rischio ~ Test * Time + Test * Dejoy_gravità + Time * Dejoy_gravità +
Durata + Genere + (1 | Code), data = ds_long_f, REML = F) # I checked the three-way and it is n.s.
Anova(M2fl, type = 3)summ(M2fl)| Observations | 306 |
| Dependent variable | Percezione_rischio |
| Type | Mixed effects linear regression |
| AIC | 814.00 |
| BIC | 866.13 |
| Pseudo-R² (fixed effects) | 0.26 |
| Pseudo-R² (total) | 0.49 |
| Est. | S.E. | t val. | d.f. | p | |
|---|---|---|---|---|---|
| (Intercept) | 5.09 | 0.61 | 8.33 | 288.68 | 0.00 |
| TestDriving under the influence | 1.21 | 0.88 | 1.38 | 274.37 | 0.17 |
| TimeFUP | -0.96 | 0.24 | -3.96 | 232.03 | 0.00 |
| TimePRE_POST | -0.35 | 0.46 | -0.77 | 229.30 | 0.44 |
| Dejoy_gravità | 1.05 | 0.16 | 6.43 | 299.64 | 0.00 |
| Durata | 0.04 | 0.03 | 1.60 | 99.80 | 0.11 |
| GenereDonna | 0.21 | 0.14 | 1.45 | 104.37 | 0.15 |
| TestDriving under the influence:TimeFUP | -0.01 | 0.06 | -0.23 | 201.57 | 0.82 |
| TestDriving under the influence:TimePRE_POST | 0.15 | 0.11 | 1.42 | 200.80 | 0.16 |
| TestDriving under the influence:Dejoy_gravità | -0.35 | 0.23 | -1.50 | 280.01 | 0.14 |
| TimeFUP:Dejoy_gravità | 0.24 | 0.06 | 3.70 | 232.88 | 0.00 |
| TimePRE_POST:Dejoy_gravità | 0.07 | 0.12 | 0.61 | 230.22 | 0.54 |
| p values calculated using Satterthwaite d.f. |
| Group | Parameter | Std. Dev. |
|---|---|---|
| Code | (Intercept) | 0.51 |
| Residual | 0.76 |
| Group | # groups | ICC |
|---|---|---|
| Code | 102 | 0.31 |
8.2.1 Confidence intervals
confint(M2fl) 2.5 % 97.5 %
.sig01 0.380714826 0.646491442
.sigma 0.688979828 0.838178979
(Intercept) 3.888838330 6.290978219
TestDriving under the influence -0.534737535 2.976629009
TimeFUP -1.442216777 -0.485392837
TimePRE_POST -1.265650798 0.557620157
Dejoy_gravità 0.729479685 1.371831321
Durata -0.010100262 0.095364894
GenereDonna -0.072961539 0.485327819
TestDriving under the influence:TimeFUP -0.137084873 0.108901649
TestDriving under the influence:TimePRE_POST -0.059350938 0.364099464
TestDriving under the influence:Dejoy_gravità -0.808912384 0.112998892
TimeFUP:Dejoy_gravità 0.111675815 0.365732951
TimePRE_POST:Dejoy_gravità -0.165443063 0.3141489058.2.2 Standardized coefficients
stdCoef.merMod <- function(object) {
sdy <- sd(getME(object, "y"))
sdx <- apply(getME(object, "X"), 2, sd)
sc <- fixef(object) * sdx/sdy
se.fixef <- coef(summary(object))[, "Std. Error"]
se <- se.fixef * sdx/sdy
return(data.frame(stdcoef = sc, stdse = se))
}
stdCoef.merMod(M2fl)8.3 Modello 3
M3fl <- lmer(Percezione_rischio ~ Test * Time * Dejoy_gravità + Durata + Genere +
(1 | Code), data = ds_long_f, REML = F) # I checked the three-way and it is n.s.
Anova(M3fl, type = 3)summ(M3fl)| Observations | 306 |
| Dependent variable | Percezione_rischio |
| Type | Mixed effects linear regression |
| AIC | 801.04 |
| BIC | 860.62 |
| Pseudo-R² (fixed effects) | 0.29 |
| Pseudo-R² (total) | 0.53 |
| Est. | S.E. | t val. | d.f. | p | |
|---|---|---|---|---|---|
| (Intercept) | 5.39 | 0.60 | 8.98 | 291.88 | 0.00 |
| TestDriving under the influence | 0.79 | 0.87 | 0.91 | 278.56 | 0.36 |
| TimeFUP | -1.94 | 0.33 | -5.86 | 235.68 | 0.00 |
| TimePRE_POST | -0.44 | 0.64 | -0.68 | 234.42 | 0.50 |
| Dejoy_gravità | 0.97 | 0.16 | 6.06 | 301.86 | 0.00 |
| Durata | 0.04 | 0.03 | 1.56 | 99.95 | 0.12 |
| GenereDonna | 0.23 | 0.14 | 1.67 | 104.79 | 0.10 |
| TestDriving under the influence:TimeFUP | 1.95 | 0.47 | 4.12 | 230.66 | 0.00 |
| TestDriving under the influence:TimePRE_POST | 0.10 | 0.90 | 0.11 | 230.70 | 0.91 |
| TestDriving under the influence:Dejoy_gravità | -0.24 | 0.23 | -1.04 | 284.00 | 0.30 |
| TimeFUP:Dejoy_gravità | 0.50 | 0.09 | 5.67 | 236.05 | 0.00 |
| TimePRE_POST:Dejoy_gravità | 0.10 | 0.17 | 0.57 | 234.96 | 0.57 |
| TestDriving under the influence:TimeFUP:Dejoy_gravità | -0.52 | 0.12 | -4.19 | 231.14 | 0.00 |
| TestDriving under the influence:TimePRE_POST:Dejoy_gravità | 0.01 | 0.24 | 0.04 | 231.19 | 0.97 |
| p values calculated using Satterthwaite d.f. |
| Group | Parameter | Std. Dev. |
|---|---|---|
| Code | (Intercept) | 0.51 |
| Residual | 0.73 |
| Group | # groups | ICC |
|---|---|---|
| Code | 102 | 0.33 |
8.3.1 Confidence intervals
confint(M3fl) 2.5 %
.sig01 0.391144161
.sigma 0.664123629
(Intercept) 4.206159981
TestDriving under the influence -0.929364763
TimeFUP -2.594107019
TimePRE_POST -1.703693575
Dejoy_gravità 0.656583049
Durata -0.011030314
GenereDonna -0.042613499
TestDriving under the influence:TimeFUP 1.019668678
TestDriving under the influence:TimePRE_POST -1.658107291
TestDriving under the influence:Dejoy_gravità -0.690035351
TimeFUP:Dejoy_gravità 0.328591096
TimePRE_POST:Dejoy_gravità -0.237460039
TestDriving under the influence:TimeFUP:Dejoy_gravità -0.769445233
TestDriving under the influence:TimePRE_POST:Dejoy_gravità -0.455693246
97.5 %
.sig01 0.647641394
.sigma 0.807920958
(Intercept) 6.566551839
TestDriving under the influence 2.520691435
TimeFUP -1.289821782
TimePRE_POST 0.829240698
Dejoy_gravità 1.286945012
Durata 0.093445094
GenereDonna 0.510430555
TestDriving under the influence:TimeFUP 2.881406106
TestDriving under the influence:TimePRE_POST 1.872446859
TestDriving under the influence:Dejoy_gravità 0.215207774
TimeFUP:Dejoy_gravità 0.678290971
TimePRE_POST:Dejoy_gravità 0.434373059
TestDriving under the influence:TimeFUP:Dejoy_gravità -0.277458832
TestDriving under the influence:TimePRE_POST:Dejoy_gravità 0.4728856738.3.2 Standardized coefficients
stdCoef.merMod <- function(object) {
sdy <- sd(getME(object, "y"))
sdx <- apply(getME(object, "X"), 2, sd)
sc <- fixef(object) * sdx/sdy
se.fixef <- coef(summary(object))[, "Std. Error"]
se <- se.fixef * sdx/sdy
return(data.frame(stdcoef = sc, stdse = se))
}
stdCoef.merMod(M3fl)8.3.3 Slope analysis: interaction Dejoy gravità x Session
Vedere ultimo modello…
8.4 Modello 4
M4fl <- lmer(Percezione_rischio ~ Test * Time * Dejoy_gravità + IllusionC + +PoliceStop +
OptimismBf + Durata + Genere + (1 | Code), data = ds_long_f, REML = F) # I checked the three-way and it is n.s.
Anova(M4fl, type = 3)summ(M4fl)| Observations | 306 |
| Dependent variable | Percezione_rischio |
| Type | Mixed effects linear regression |
| AIC | 768.38 |
| BIC | 839.13 |
| Pseudo-R² (fixed effects) | 0.40 |
| Pseudo-R² (total) | 0.56 |
| Est. | S.E. | t val. | d.f. | p | |
|---|---|---|---|---|---|
| (Intercept) | 5.63 | 0.59 | 9.60 | 285.60 | 0.00 |
| TestDriving under the influence | 0.45 | 0.81 | 0.56 | 266.51 | 0.58 |
| TimeFUP | -1.94 | 0.32 | -6.10 | 240.18 | 0.00 |
| TimePRE_POST | -0.24 | 0.62 | -0.39 | 238.49 | 0.69 |
| Dejoy_gravità | 0.82 | 0.15 | 5.42 | 299.16 | 0.00 |
| IllusionC | -0.14 | 0.04 | -3.28 | 286.30 | 0.00 |
| PoliceStop | 0.10 | 0.02 | 5.28 | 305.82 | 0.00 |
| OptimismBf | -0.01 | 0.02 | -0.50 | 98.93 | 0.62 |
| Durata | 0.03 | 0.02 | 1.07 | 100.26 | 0.29 |
| GenereDonna | 0.21 | 0.13 | 1.67 | 103.64 | 0.10 |
| TestDriving under the influence:TimeFUP | 2.06 | 0.45 | 4.53 | 234.77 | 0.00 |
| TestDriving under the influence:TimePRE_POST | -0.26 | 0.86 | -0.30 | 235.18 | 0.77 |
| TestDriving under the influence:Dejoy_gravità | -0.15 | 0.21 | -0.72 | 272.10 | 0.47 |
| TimeFUP:Dejoy_gravità | 0.51 | 0.09 | 5.98 | 240.48 | 0.00 |
| TimePRE_POST:Dejoy_gravità | 0.04 | 0.16 | 0.25 | 238.98 | 0.81 |
| TestDriving under the influence:TimeFUP:Dejoy_gravità | -0.56 | 0.12 | -4.68 | 235.60 | 0.00 |
| TestDriving under the influence:TimePRE_POST:Dejoy_gravità | 0.10 | 0.23 | 0.45 | 235.61 | 0.66 |
| p values calculated using Satterthwaite d.f. |
| Group | Parameter | Std. Dev. |
|---|---|---|
| Code | (Intercept) | 0.43 |
| Residual | 0.70 |
| Group | # groups | ICC |
|---|---|---|
| Code | 102 | 0.27 |
8.4.1 Confidence intervals
confint(M4fl) 2.5 %
.sig01 0.303592038
.sigma 0.640824409
(Intercept) 4.474592301
TestDriving under the influence -1.154343636
TimeFUP -2.568434737
TimePRE_POST -1.458467168
Dejoy_gravità 0.522766680
IllusionC -0.228252028
PoliceStop 0.060744407
OptimismBf -0.061367519
Durata -0.021372430
GenereDonna -0.038549076
TestDriving under the influence:TimeFUP 1.164039780
TestDriving under the influence:TimePRE_POST -1.957425250
TestDriving under the influence:Dejoy_gravità -0.577884690
TimeFUP:Dejoy_gravità 0.342230372
TimePRE_POST:Dejoy_gravità -0.281989823
TestDriving under the influence:TimeFUP:Dejoy_gravità -0.797760814
TestDriving under the influence:TimePRE_POST:Dejoy_gravità -0.346464721
97.5 %
.sig01 0.554581957
.sigma 0.780056585
(Intercept) 6.788043376
TestDriving under the influence 2.067749301
TimeFUP -1.315028573
TimePRE_POST 0.972333099
Dejoy_gravità 1.120377116
IllusionC -0.055998654
PoliceStop 0.133381453
OptimismBf 0.036578930
Durata 0.072277515
GenereDonna 0.459197018
TestDriving under the influence:TimeFUP 2.950732613
TestDriving under the influence:TimePRE_POST 1.444456028
TestDriving under the influence:Dejoy_gravità 0.269291369
TimeFUP:Dejoy_gravità 0.678115043
TimePRE_POST:Dejoy_gravità 0.362794570
TestDriving under the influence:TimeFUP:Dejoy_gravità -0.325404174
TestDriving under the influence:TimePRE_POST:Dejoy_gravità 0.5477269888.4.2 Standardized coefficients
stdCoef.merMod(M4fl)8.4.3 Slope analysis: interaction Dejoy gravità x Session
library(interactions)
sim_slopes(M4fl, pred = Dejoy_gravità, modx = Test, mod2 = Time, confint = T)█████████████████████ While Time (2nd moderator) = BASELINE ████████████████████
SIMPLE SLOPES ANALYSIS
Slope of Dejoy_gravità when Test = Driving sober:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------- ------- -------- ------
0.27 0.25 -0.22 0.76 1.08 0.28
Slope of Dejoy_gravità when Test = Driving under the influence:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
0.58 0.23 0.12 1.04 2.48 0.01
███████████████████████ While Time (2nd moderator) = POST ██████████████████████
SIMPLE SLOPES ANALYSIS
Slope of Dejoy_gravità when Test = Driving sober:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------- ------- -------- ------
0.35 0.24 -0.13 0.83 1.44 0.15
Slope of Dejoy_gravità when Test = Driving under the influence:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
0.86 0.25 0.37 1.36 3.43 0.00
████████████████████ While Time (2nd moderator) = FOLLOW_UP ████████████████████
SIMPLE SLOPES ANALYSIS
Slope of Dejoy_gravità when Test = Driving sober:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
1.84 0.21 1.43 2.25 8.82 0.00
Slope of Dejoy_gravità when Test = Driving under the influence:
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
0.57 0.22 0.14 0.99 2.59 0.018.4.4 Figure: interaction Condition x Session
interact_plot(M4fl, pred = Dejoy_gravità, modx = Test, mod2 = Time, interval = TRUE,
plot.points = F, point.size = 1, jitter = 0.5, y.label = "Risk perception\n",
x.label = "\nDejoy seriousness", mod2.labels = c("BASELINE", "POST-TEST", "FOLLOW-UP"),
colors = c("red", "blue", "darkgreen"), legend.main = "Session", line.thickness = 0.5) +
theme_apa(legend.pos = "bottomleft", legend.use.title = F, legend.font.size = 10,
facet.title.size = 10) + theme(axis.text.x = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.text.y = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.title = element_text(face = "bold")) +
scale_y_continuous(limits = c(1, 10), breaks = seq(1, 10, 1)) + scale_x_continuous(limits = c(1,
5), breaks = seq(1, 5, 1))
# REGRESSIONE FOLLOWUP
8.5 Modello 1
m1f <- lm(Percezione_rischio ~ Dejoy_gravità + Dejoy_coinvolgimento, follow)
library(jtools)
summ(m1f)| Observations | 102 |
| Dependent variable | Percezione_rischio |
| Type | OLS linear regression |
| F(2,99) | 26.78 |
| R² | 0.35 |
| Adj. R² | 0.34 |
| Est. | S.E. | t val. | p | |
|---|---|---|---|---|
| (Intercept) | 3.34 | 0.79 | 4.23 | 0.00 |
| Dejoy_gravità | 1.43 | 0.21 | 6.84 | 0.00 |
| Dejoy_coinvolgimento | 0.14 | 0.16 | 0.90 | 0.37 |
| Standard errors: OLS |
8.5.1 Confidence intervals
confint(m1f, level = 0.95) 2.5 % 97.5 %
(Intercept) 1.77623124 4.91349321
Dejoy_gravità 1.01179788 1.83951143
Dejoy_coinvolgimento -0.17136826 0.45382728# How do I compute standardized effects for lm models?8.5.2 Standard coefficients
m1fs <- lm(Percezione_rischio ~ scale(Dejoy_gravità) + scale(Dejoy_coinvolgimento),
follow)
library(jtools)
summ(m1fs)| Observations | 102 |
| Dependent variable | Percezione_rischio |
| Type | OLS linear regression |
| F(2,99) | 26.78 |
| R² | 0.35 |
| Adj. R² | 0.34 |
| Est. | S.E. | t val. | p | |
|---|---|---|---|---|
| (Intercept) | 9.03 | 0.11 | 84.32 | 0.00 |
| scale(Dejoy_gravità) | 0.76 | 0.11 | 6.84 | 0.00 |
| scale(Dejoy_coinvolgimento) | 0.10 | 0.11 | 0.90 | 0.37 |
| Standard errors: OLS |
8.6 Modello 2
m2f <- lm(Percezione_rischio ~ Dejoy_gravità * PoliceStop + esp_sim_1 + esp_sim_2 +
esp_sim_3 + fr_drive + Genere, follow)
summ(m2f)| Observations | 102 |
| Dependent variable | Percezione_rischio |
| Type | OLS linear regression |
| F(8,93) | 12.04 |
| R² | 0.51 |
| Adj. R² | 0.47 |
| Est. | S.E. | t val. | p | |
|---|---|---|---|---|
| (Intercept) | -0.91 | 1.34 | -0.68 | 0.50 |
| Dejoy_gravità | 2.26 | 0.36 | 6.28 | 0.00 |
| PoliceStop | 0.88 | 0.22 | 4.02 | 0.00 |
| esp_sim_1 | -0.04 | 0.07 | -0.56 | 0.58 |
| esp_sim_2 | 0.08 | 0.07 | 1.16 | 0.25 |
| esp_sim_3 | 0.01 | 0.05 | 0.11 | 0.91 |
| fr_drive | 0.07 | 0.08 | 0.93 | 0.36 |
| GenereDonna | 0.27 | 0.20 | 1.30 | 0.20 |
| Dejoy_gravità:PoliceStop | -0.20 | 0.06 | -3.42 | 0.00 |
| Standard errors: OLS |
8.6.1 Confidence intervals
confint(m2f) 2.5 % 97.5 %
(Intercept) -3.572337386 1.758711085
Dejoy_gravità 1.547585755 2.979081527
PoliceStop 0.445198449 1.314203168
esp_sim_1 -0.166122788 0.093097713
esp_sim_2 -0.056892321 0.218260525
esp_sim_3 -0.100535892 0.112270370
fr_drive -0.084470367 0.233034083
GenereDonna -0.139867199 0.670071229
Dejoy_gravità:PoliceStop -0.317176817 -0.0840690078.6.2 Standard coefficients
m2fs <- lm(Percezione_rischio ~ scale(Dejoy_gravità) * scale(PoliceStop) + scale(esp_sim_1) +
scale(esp_sim_2) + scale(esp_sim_3) + scale(fr_drive) + Genere, follow)
summ(m2fs)| Observations | 102 |
| Dependent variable | Percezione_rischio |
| Type | OLS linear regression |
| F(8,93) | 12.04 |
| R² | 0.51 |
| Adj. R² | 0.47 |
| Est. | S.E. | t val. | p | |
|---|---|---|---|---|
| (Intercept) | 8.96 | 0.14 | 65.72 | 0.00 |
| scale(Dejoy_gravità) | 0.49 | 0.12 | 3.92 | 0.00 |
| scale(PoliceStop) | 0.33 | 0.10 | 3.20 | 0.00 |
| scale(esp_sim_1) | -0.10 | 0.17 | -0.56 | 0.58 |
| scale(esp_sim_2) | 0.19 | 0.17 | 1.16 | 0.25 |
| scale(esp_sim_3) | 0.01 | 0.13 | 0.11 | 0.91 |
| scale(fr_drive) | 0.10 | 0.10 | 0.93 | 0.36 |
| GenereDonna | 0.27 | 0.20 | 1.30 | 0.20 |
| scale(Dejoy_gravità):scale(PoliceStop) | -0.28 | 0.08 | -3.42 | 0.00 |
| Standard errors: OLS |
8.6.3 Simple slopes: interaction Dejoy gravità x frequency of driving
library(interactions)
sim_slopes(m2f, pred = Dejoy_gravità, modx = PoliceStop, confint = T)JOHNSON-NEYMAN INTERVAL
When PoliceStop is OUTSIDE the interval [8.40, 20.59], the slope of
Dejoy_gravità is p < .05.
Note: The range of observed values of PoliceStop is [1.00, 10.00]
SIMPLE SLOPES ANALYSIS
Slope of Dejoy_gravità when PoliceStop = 4.0974868 (- 1 SD):
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
1.44 0.22 1.01 1.87 6.63 0.00
Slope of Dejoy_gravità when PoliceStop = 6.7058824 (Mean):
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------ ------- -------- ------
0.92 0.23 0.45 1.38 3.92 0.00
Slope of Dejoy_gravità when PoliceStop = 9.3142779 (+ 1 SD):
Est. S.E. 2.5% 97.5% t val. p
------ ------ ------- ------- -------- ------
0.39 0.33 -0.26 1.05 1.19 0.248.6.4 Figure: interaction Dejoy gravità x Effectiveness of simulator
library(interactions)
library(jtools)
FUP1 <- interact_plot(m2f, pred = Dejoy_gravità, modx = PoliceStop, interval = TRUE,
plot.points = F, point.size = 1, jitter = 0.5, y.label = "Risk perception\n",
x.label = "\nDejoy seriousness", colors = c("red", "blue", "red"), modx.labels = c("Low likelihood",
"Average likelihood", "High likelihood"), legend.main = "Perceived likelihood of being\nstopped by the police",
line.thickness = 1) + theme_apa(legend.pos = "bottomright", legend.use.title = TRUE,
legend.font.size = 9, facet.title.size = 8) + theme(axis.text.x = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.text.y = element_text(color = "#212121",
size = 10, face = "bold")) + theme(axis.title = element_text(face = "bold")) +
scale_y_continuous(limits = c(1, 10), breaks = seq(1, 10, 1))
FUP1
– THE END –