── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.1.4 ✔ readr 2.1.5
✔ forcats 1.0.0 ✔ stringr 1.5.1
✔ ggplot2 3.5.1 ✔ tibble 3.2.1
✔ lubridate 1.9.3 ✔ tidyr 1.3.1
✔ purrr 1.0.2
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(haven)library(ggstatsplot)
You can cite this package as:
Patil, I. (2021). Visualizations with statistical details: The 'ggstatsplot' approach.
Journal of Open Source Software, 6(61), 3167, doi:10.21105/joss.03167
library(lme4)
Loading required package: Matrix
Attaching package: 'Matrix'
The following objects are masked from 'package:tidyr':
expand, pack, unpack
dfRaw <-read_sav("TRIAGE_REDUCIDO.sav") %>%# convertir la columna grupo en factor, con los niveles 0 y 1 convertidos en "Sin checklist", "Con checklist"mutate(Grupo =factor(as.factor(GRUPO), levels =c(0, 1), labels =c("Sin checklist", "Con checklist")))
Hay variables que se usarán posteriormente y las aparto ahora:
Hay varios actores que han sido evaluados por los sujetos de GRUPO=1. Cambiamos la estructura de los datos para adecuarla a formato tidy y poder hacer análisis de los datos posteriormente:
Los aciertos y errores de los sujetos se han recogido en variables que empiezan por TRI_ y que tienen un valor de 1 si el sujeto ha asignado el triaje correspondiente al actor y un 0 si no lo ha hecho. Vamos a cambiar la estructura de los datos para poder hacer análisis de los datos posteriormente:
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
No esperaba que hubiese valores fuera de rango: 4. Casi todos además han ocurrido en el GRUPO==1. Aparentemente el valor “4” se ha asignado cunado un sujeto no sabía qué decir y parecen haber ocurrido casi todos en el GRUPO 1. Parece que eso se merece su propia variable:
#unir gráficos p1 y p2 en uno sologridExtra::grid.arrange(p1,p2, nrow=1)
Para el resto no influye en la tasa de acierto el que esté presente o que no.
Análisis de triajes
Análisis actor a actor
En primer lugar comenzamos separando las respuestas por actores, ya que cada uno reflejaba aspectos diferentes y deberían objetivamente tener un valor de triaje diferente.
Realmente estos actores tienen una puntuación objetiva que los sujetos deberían haber asignado:
# A tibble: 7 × 2
ACTOR TRIAJEOBJ
<chr> <dbl>
1 ARTURO 2
2 MARIO 2
3 LAURA 1
4 JAVIER 1
5 MARIA 3
6 NICOLAS 1
7 MATEO 3
Vamos a evaluar los triajes que han hecho los individuos con respecto a los triajes objetivos y vamos a anotar las diferencias (si se han pasado, quedado cortos o acertado):
dfCompTriaje=dfTriaje %>%inner_join(dfTriObj, by="ACTOR") %>%mutate(DIFERENCIA=TRIAJE-TRIAJEOBJ) %>%mutate(`Resultado del triage`=case_when( DIFERENCIA==2~"Sobreestimado 2 categorías", DIFERENCIA==1~"Sobreestimado 1 categoría", DIFERENCIA==-1~"Infraestimado 1 categoría", DIFERENCIA==-2~"Infraestimado 2 categorías",TRUE~"Etiquetado con categoría correcta")) %>%#reordenar nivelesmutate(`Resultado del triage`=forcats::fct_relevel(`Resultado del triage`, "Infraestimado 1 categoría", "Infraestimado 2 categorías", "Etiquetado con categoría correcta", "Sobreestimado 1 categoría", "Sobreestimado 2 categorías")) %>%mutate(`Resultado del triage`=ordered(`Resultado del triage`))
Me gustaría ver comparar los aciertos según GRUPO según el ACTOR, que sabemos que está muy relacionado algunos de ellos con ciertas características que estaban presentes en los vídeos:
p3<-dfCompTriaje %>%ggbarstats(y=Actor, x=`Resultado del triage`, bf.message =FALSE)+theme(axis.text.x =element_text(angle =90, hjust =1, vjust =0.5))+xlab("")+# usar paleta ordinal para el colorscale_fill_manual(values =c("darkblue", "blue", "gray", "orange", "darkorange"))
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
p3
Los aciertos corresponden al cero (VIOLETA), que desde luego no es tan abundante como esperaba. En ocasiones aciertan incluso peor que eligiendo al azar (vease el caso de ARTURO)
Los valores positivos indican que el Sujeto se ha pasado en el valor del triaje con respecto al valor objetivo, y los negativos representan lo contrario. Solo en el caso de MARIO la gente se equivoca de forma simétrica. En los demás (salvo en el de NICOLAS) todo el mundo que se equivoca, o bien se pasa o bien se queda corto. En el caso de NICOLAS, la gente tiende a quedarse corta aunque un 6% se pasa. Estaría bien pensar sobre esto.
Vamos a desglosar esos patrones según GRUPO:
p3<- dfCompTriaje %>%filter(GRUPO==0) %>%ggbarstats(y=Actor, x=`Resultado del triage`, bf.message =FALSE, title="Casos sin Check-list")+theme(axis.text.x =element_text(angle =90, hjust =1, vjust =0.5))+xlab("")+# usar paleta ordinal para el colorscale_fill_manual(values =c("darkblue", "blue", "gray", "orange", "darkorange"))
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
p3
p4<- dfCompTriaje %>%filter(GRUPO==1) %>%ggbarstats(y=Actor, x=`Resultado del triage`, bf.message =FALSE, title="Casos con Check-list")+theme(axis.text.x =element_text(angle =90, hjust =1, vjust =0.5))+xlab("")+# usar paleta ordinal para el colorscale_fill_manual(values =c("darkblue", "blue", "gray", "orange", "darkorange"))
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
p4
Los dos juntos:
#unir gráficos p3 y p4 en uno sologridExtra::grid.arrange(p3,p4, nrow=2)
Comparaciones de resultados totales en triajes
Ahora solo nos interesa saber qué resultado total hemos tenido en los triajes. Se puede evaluar de dos formas en principio: Mirando aciertos/errores o bien viendo el error medio (en valor absoluto) cometido donde error 0 es acierto.
dfTriajeTotal %>%ggbetweenstats(x=Grupo, y=PCTACIERTOS, bf.message =FALSE)+ylab("Porcentaje de aciertos")+xlab("")
dfTriajeTotal %>%ggbetweenstats(x=Grupo, y=ERRORMEDIO, bf.message =FALSE)+ylab("Error medio cometido")+xlab("")
Modelo multinivel
EN este usamos otra base de datos. Consideramos a los actores como miembros de un conjunto infinito de actores random que van a ser evaluados por los sujetos. Con ellos podemos acertar o no en el triaje.
Ahora hacemos el modelo de regresión logístico multinivel usando el ACTOR como un factor RANDOM:
modeloMultinivel=glmer(ACIERTO ~ GRUPO+SEXO+EDAD+TMMS_ATENCION+TMMS_CLARIDAD+TMMS_REGULACION+RESILIENCIA+PSICOLOGIA+#TOTALCOMP+ (1|ACTOR), data = dfMultinivel, family =binomial(link ="logit"))summary(modeloMultinivel)
Generalized linear mixed model fit by maximum likelihood (Laplace
Approximation) [glmerMod]
Family: binomial ( logit )
Formula: ACIERTO ~ GRUPO + SEXO + EDAD + TMMS_ATENCION + TMMS_CLARIDAD +
TMMS_REGULACION + RESILIENCIA + PSICOLOGIA + (1 | ACTOR)
Data: dfMultinivel
AIC BIC logLik deviance df.resid
1046.0 1092.3 -513.0 1026.0 751
Scaled residuals:
Min 1Q Median 3Q Max
-1.9046 -0.9356 -0.6215 0.9678 1.5628
Random effects:
Groups Name Variance Std.Dev.
ACTOR (Intercept) 0.0972 0.3118
Number of obs: 761, groups: ACTOR, 7
Fixed effects:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.119327 0.684137 -0.174 0.86154
GRUPO 0.462878 0.156869 2.951 0.00317 **
SEXO -0.092516 0.170228 -0.543 0.58680
EDAD 0.003273 0.006861 0.477 0.63334
TMMS_ATENCION 0.031012 0.023070 1.344 0.17886
TMMS_CLARIDAD 0.021772 0.026276 0.829 0.40733
TMMS_REGULACION 0.030599 0.025183 1.215 0.22433
RESILIENCIA -0.045661 0.016807 -2.717 0.00659 **
PSICOLOGIA 0.170794 0.160447 1.064 0.28711
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Correlation of Fixed Effects:
(Intr) GRUPO SEXO EDAD TMMS_A TMMS_C TMMS_R RESILI
GRUPO -0.021
SEXO -0.469 -0.097
EDAD -0.639 -0.237 0.260
TMMS_ATENCI -0.228 0.085 -0.313 0.245
TMMS_CLARID -0.107 -0.090 0.030 -0.048 -0.299
TMMS_REGULA -0.172 0.005 0.117 0.176 -0.008 -0.174
RESILIENCIA -0.330 0.055 0.070 -0.075 -0.103 -0.214 -0.484
PSICOLOGIA 0.068 0.091 -0.010 -0.106 0.092 -0.139 0.045 -0.142
