Taller ANOVA RM
Huris Solis
22/10/2021
PROBLEMA 1
En un experimento diseñado para estudiar el efecto del paso del tiempo sobre la calidad del recuerdo, a un grupo de 9 sujetos se les hace memorizar una historia durante 20 minutos. Más tarde, al cabo de una hora, de un día, de una semana y de un mes, se les pide que intenten memorizar la historia escribiendo todo lo que recuerden. Un grupo de expertos evalúa la calidad del recuerdo de cada sujeto hasta elaborar los datos que muestra la tabla de datos. Se trata de un diseño de un factor (al que podemos llamar tiempo) con cuatro niveles (los cuatro momentos en los que se registra el recuerdo: al cabo de una hora, un día, una semana y un mes) y una variable dependiente (la calidad del recuerdo)
Datos
Id<-c(1,2,3,4,5,6,7,8,9)
H<-c(16,12,12,15,18,13,18,15,20)
D<-c(8,9,10,13,12,13,16,9,9)
S<-c(8,9,10,7,12,8,10,6,11)
M<-c(12,10,8,11,12,10,13,6,8)
df<-data.frame(Id=Id,H=H,D=D,S=S,M=M)
df## Id H D S M
## 1 1 16 8 8 12
## 2 2 12 9 9 10
## 3 3 12 10 10 8
## 4 4 15 13 7 11
## 5 5 18 12 12 12
## 6 6 13 13 8 10
## 7 7 18 16 10 13
## 8 8 15 9 6 6
## 9 9 20 9 11 8library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.4 v dplyr 1.0.7
## v tidyr 1.1.4 v stringr 1.4.0
## v readr 2.0.2 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(ggpubr)
library(rstatix)##
## Attaching package: 'rstatix'## The following object is masked from 'package:stats':
##
## filterdf <- df %>% gather(key="Time",value="score",H,D,S,M) %>% convert_as_factor(Id,Time)
df## Id Time score
## 1 1 H 16
## 2 2 H 12
## 3 3 H 12
## 4 4 H 15
## 5 5 H 18
## 6 6 H 13
## 7 7 H 18
## 8 8 H 15
## 9 9 H 20
## 10 1 D 8
## 11 2 D 9
## 12 3 D 10
## 13 4 D 13
## 14 5 D 12
## 15 6 D 13
## 16 7 D 16
## 17 8 D 9
## 18 9 D 9
## 19 1 S 8
## 20 2 S 9
## 21 3 S 10
## 22 4 S 7
## 23 5 S 12
## 24 6 S 8
## 25 7 S 10
## 26 8 S 6
## 27 9 S 11
## 28 1 M 12
## 29 2 M 10
## 30 3 M 8
## 31 4 M 11
## 32 5 M 12
## 33 6 M 10
## 34 7 M 13
## 35 8 M 6
## 36 9 M 8Resumen Estadístico
df %>% group_by(Time) %>% get_summary_stats(score,type="mean_sd")## # A tibble: 4 x 5
## Time variable n mean sd
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 D score 9 11 2.65
## 2 H score 9 15.4 2.83
## 3 M score 9 10 2.29
## 4 S score 9 9 1.94df## Id Time score
## 1 1 H 16
## 2 2 H 12
## 3 3 H 12
## 4 4 H 15
## 5 5 H 18
## 6 6 H 13
## 7 7 H 18
## 8 8 H 15
## 9 9 H 20
## 10 1 D 8
## 11 2 D 9
## 12 3 D 10
## 13 4 D 13
## 14 5 D 12
## 15 6 D 13
## 16 7 D 16
## 17 8 D 9
## 18 9 D 9
## 19 1 S 8
## 20 2 S 9
## 21 3 S 10
## 22 4 S 7
## 23 5 S 12
## 24 6 S 8
## 25 7 S 10
## 26 8 S 6
## 27 9 S 11
## 28 1 M 12
## 29 2 M 10
## 30 3 M 8
## 31 4 M 11
## 32 5 M 12
## 33 6 M 10
## 34 7 M 13
## 35 8 M 6
## 36 9 M 8Visualización
bxp<-ggboxplot(df,x="Time",y="score", add="point")
bxp
Supuestos del modelo
Outliers
df %>% group_by(Time) %>% identify_outliers(score)## [1] Time Id score is.outlier is.extreme
## <0 rows> (or 0-length row.names)R/. No hay outlier.
Normalidad
df %>% group_by(Time) %>% shapiro_test(score)## # A tibble: 4 x 4
## Time variable statistic p
## <fct> <chr> <dbl> <dbl>
## 1 D score 0.896 0.231
## 2 H score 0.933 0.511
## 3 M score 0.947 0.653
## 4 S score 0.978 0.951R/. La distribución de los resultados obtenidos es normal.
ggqqplot(df,"score",facet.by="Time")
cÁLCULO DE ANOVA
res.aov<-anova_test(data=df,dv=score,wid=Id,within=Time)
get_anova_table(res.aov)## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 Time 3 24 17.331 3.34e-06 * 0.532Comparación de Medias
pwc<-df %>% pairwise_t_test(score~Time,paired=TRUE,p.adjust.method="bonferroni")
pwc## # A tibble: 6 x 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 score D H 9 9 -3.77 8 0.005 0.033 *
## 2 score D M 9 9 1.28 8 0.237 1 ns
## 3 score D S 9 9 1.97 8 0.084 0.504 ns
## 4 score H M 9 9 5.16 8 0.000866 0.005 **
## 5 score H S 9 9 7.43 8 0.0000743 0.000446 ***
## 6 score M S 9 9 1.2 8 0.264 1 nsReporte
pwc <- pwc %>% add_xy_position(x="Time")
bxp+
stat_pvalue_manual(pwc) +
labs(
subtitle = get_test_label(res.aov,detailed=TRUE),
caption=get_pwc_label(pwc)
)
R/. Solo hay diferencia significativa entre la calidad de memoria a las horas y demás tiempo. Cumple con la normalidad
PROBLEMA 2
Modelo de dos factores con medidas repetidas
df2<-read.csv("https://raw.githubusercontent.com/HSolis08/D.experimental/main/p2.csv")
df2$Su=factor(df2$Su)
df2$Ind=factor(df2$Ind)
df2$Ho=as.numeric(df2$Ho)
df2$Se=as.numeric(df2$Se)
df2$Di=as.numeric(df2$Di)
df2$Me=as.numeric(df2$Me)
df2## Su Ind Ho Di Se Me
## 1 1 n 6 6 3 2
## 2 1 l 8 6 4 3
## 3 2 n 7 5 5 5
## 4 2 l 10 8 5 2
## 5 3 n 4 2 1 3
## 6 3 l 7 7 2 2
## 7 4 n 7 5 3 4
## 8 4 l 11 9 3 6
## 9 5 n 6 4 4 5
## 10 5 l 10 6 4 3
## 11 6 n 5 2 1 1
## 12 6 l 9 4 3 5df2<-df2 %>% gather(key="time",value="score",Ho,Di,Se,Me) %>% convert_as_factor(time)
df2## Su Ind time score
## 1 1 n Ho 6
## 2 1 l Ho 8
## 3 2 n Ho 7
## 4 2 l Ho 10
## 5 3 n Ho 4
## 6 3 l Ho 7
## 7 4 n Ho 7
## 8 4 l Ho 11
## 9 5 n Ho 6
## 10 5 l Ho 10
## 11 6 n Ho 5
## 12 6 l Ho 9
## 13 1 n Di 6
## 14 1 l Di 6
## 15 2 n Di 5
## 16 2 l Di 8
## 17 3 n Di 2
## 18 3 l Di 7
## 19 4 n Di 5
## 20 4 l Di 9
## 21 5 n Di 4
## 22 5 l Di 6
## 23 6 n Di 2
## 24 6 l Di 4
## 25 1 n Se 3
## 26 1 l Se 4
## 27 2 n Se 5
## 28 2 l Se 5
## 29 3 n Se 1
## 30 3 l Se 2
## 31 4 n Se 3
## 32 4 l Se 3
## 33 5 n Se 4
## 34 5 l Se 4
## 35 6 n Se 1
## 36 6 l Se 3
## 37 1 n Me 2
## 38 1 l Me 3
## 39 2 n Me 5
## 40 2 l Me 2
## 41 3 n Me 3
## 42 3 l Me 2
## 43 4 n Me 4
## 44 4 l Me 6
## 45 5 n Me 5
## 46 5 l Me 3
## 47 6 n Me 1
## 48 6 l Me 5Resumen estadístico
df2 %>% group_by(time) %>% get_summary_stats(score,type="mean_sd")## # A tibble: 4 x 5
## time variable n mean sd
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 Di score 12 5.33 2.15
## 2 Ho score 12 7.5 2.15
## 3 Me score 12 3.42 1.56
## 4 Se score 12 3.17 1.34df2## Su Ind time score
## 1 1 n Ho 6
## 2 1 l Ho 8
## 3 2 n Ho 7
## 4 2 l Ho 10
## 5 3 n Ho 4
## 6 3 l Ho 7
## 7 4 n Ho 7
## 8 4 l Ho 11
## 9 5 n Ho 6
## 10 5 l Ho 10
## 11 6 n Ho 5
## 12 6 l Ho 9
## 13 1 n Di 6
## 14 1 l Di 6
## 15 2 n Di 5
## 16 2 l Di 8
## 17 3 n Di 2
## 18 3 l Di 7
## 19 4 n Di 5
## 20 4 l Di 9
## 21 5 n Di 4
## 22 5 l Di 6
## 23 6 n Di 2
## 24 6 l Di 4
## 25 1 n Se 3
## 26 1 l Se 4
## 27 2 n Se 5
## 28 2 l Se 5
## 29 3 n Se 1
## 30 3 l Se 2
## 31 4 n Se 3
## 32 4 l Se 3
## 33 5 n Se 4
## 34 5 l Se 4
## 35 6 n Se 1
## 36 6 l Se 3
## 37 1 n Me 2
## 38 1 l Me 3
## 39 2 n Me 5
## 40 2 l Me 2
## 41 3 n Me 3
## 42 3 l Me 2
## 43 4 n Me 4
## 44 4 l Me 6
## 45 5 n Me 5
## 46 5 l Me 3
## 47 6 n Me 1
## 48 6 l Me 5Visualizacion de los datos
bxp=ggboxplot(df2,x="time",y="score",color="Ind",palette="jco")
bxp
Supuestos de Modelo
Outliers
df2 %>% group_by(Ind,time) %>% identify_outliers(score)## [1] Ind time Su score is.outlier is.extreme
## <0 rows> (or 0-length row.names)Normalidad
df2 %>% group_by(Ind,time) %>% shapiro_test(score)## # A tibble: 8 x 5
## Ind time variable statistic p
## <fct> <fct> <chr> <dbl> <dbl>
## 1 l Di score 0.974 0.918
## 2 l Ho score 0.958 0.804
## 3 l Me score 0.863 0.201
## 4 l Se score 0.960 0.820
## 5 n Di score 0.876 0.252
## 6 n Ho score 0.908 0.421
## 7 n Me score 0.920 0.505
## 8 n Se score 0.908 0.425ggqqplot(df2,"score",ggtheme=theme_bw()) + facet_grid(time~Ind,labeller="label_both")
Cálculo de ANOVA
Anova<-anova_test(data=df2,dv=score,wid=Su,within=c(Ind,time))
get_anova_table(Anova)## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 Ind 1 5 20.351 6.00e-03 * 0.275
## 2 time 3 15 38.058 2.98e-07 * 0.613
## 3 Ind:time 3 15 5.315 1.10e-02 * 0.186Pruebas Post Hoc
one.way= df2 %>% group_by(time) %>% anova_test(dv=score,wid=Su,within=Ind) %>% get_anova_table() %>% adjust_pvalue(method="bonferroni")
one.way## # A tibble: 4 x 9
## time Effect DFn DFd F p `p<.05` ges p.adj
## * <fct> <chr> <dbl> <dbl> <dbl> <dbl> <chr> <dbl> <dbl>
## 1 Di Ind 1 5 13.9 0.014 "*" 0.421 0.056
## 2 Ho Ind 1 5 100 0.000171 "*" 0.654 0.000684
## 3 Me Ind 1 5 0.024 0.883 "" 0.003 1
## 4 Se Ind 1 5 4 0.102 "" 0.068 0.408Comparaciones de Medias
pwc2= df2 %>%
group_by(time) %>%
pairwise_t_test(
score~Ind,paired=TRUE,
p.adjust.method="bonferroni"
)
pwc2## # A tibble: 4 x 11
## time .y. group1 group2 n1 n2 statistic df p p.adj
## * <fct> <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 Di score l n 6 6 3.73 5 0.014 0.014
## 2 Ho score l n 6 6 10 5 0.000171 0.000171
## 3 Me score l n 6 6 0.155 5 0.883 0.883
## 4 Se score l n 6 6 2 5 0.102 0.102
## # ... with 1 more variable: p.adj.signif <chr>Reporte
pwc<-pwc %>% add_xy_position(x="time")
bxp+
stat_pvalue_manual(pwc,tip.length=0,hide.ns=TRUE)+
labs(
subtitle=get_test_label(Anova,detailed=TRUE),
caption=get_pwc_label(pwc)
)## Warning: Removed 3 rows containing non-finite values (stat_bracket).
R/. Cumple los supuesto de no hay outlier, normalidad. Hay diferencia significativa entre los factores e interacciones; por tanto, el tiempo y lo memorizado (letra o números) afecta significativamente la calidad de la memoria.
PROBLEMA 3
df3<-read.csv("https://raw.githubusercontent.com/HSolis08/D.experimental/main/p3.csv")
df3$Id=factor(df3$Id)
df3$Memoria=factor(df3$Memoria)
df3$Hora=as.numeric(df3$Hora)
df3$Dia=as.numeric(df3$Dia)
df3$Semana=as.numeric(df3$Semana)
df3$Mes=as.numeric(df3$Mes)
df3## Id Memoria Hora Dia Semana Mes
## 1 1 R 10 8 7 8
## 2 2 R 9 8 7 6
## 3 3 R 8 6 6 7
## 4 4 R 7 7 6 6
## 5 5 R 10 9 8 8
## 6 6 RA 8 6 5 3
## 7 7 RA 8 7 6 5
## 8 8 RA 9 7 5 6
## 9 9 RA 8 6 4 4
## 10 10 RA 7 5 4 5
## 11 11 RL 7 5 4 3
## 12 12 RL 8 6 4 4
## 13 13 RL 8 6 5 6
## 14 14 RL 8 5 3 4
## 15 15 RL 7 5 4 3df3<-df3 %>% gather(key="time",value="score",Hora,Dia,Semana,Mes) %>% convert_as_factor(Id,time)
df3## Id Memoria time score
## 1 1 R Hora 10
## 2 2 R Hora 9
## 3 3 R Hora 8
## 4 4 R Hora 7
## 5 5 R Hora 10
## 6 6 RA Hora 8
## 7 7 RA Hora 8
## 8 8 RA Hora 9
## 9 9 RA Hora 8
## 10 10 RA Hora 7
## 11 11 RL Hora 7
## 12 12 RL Hora 8
## 13 13 RL Hora 8
## 14 14 RL Hora 8
## 15 15 RL Hora 7
## 16 1 R Dia 8
## 17 2 R Dia 8
## 18 3 R Dia 6
## 19 4 R Dia 7
## 20 5 R Dia 9
## 21 6 RA Dia 6
## 22 7 RA Dia 7
## 23 8 RA Dia 7
## 24 9 RA Dia 6
## 25 10 RA Dia 5
## 26 11 RL Dia 5
## 27 12 RL Dia 6
## 28 13 RL Dia 6
## 29 14 RL Dia 5
## 30 15 RL Dia 5
## 31 1 R Semana 7
## 32 2 R Semana 7
## 33 3 R Semana 6
## 34 4 R Semana 6
## 35 5 R Semana 8
## 36 6 RA Semana 5
## 37 7 RA Semana 6
## 38 8 RA Semana 5
## 39 9 RA Semana 4
## 40 10 RA Semana 4
## 41 11 RL Semana 4
## 42 12 RL Semana 4
## 43 13 RL Semana 5
## 44 14 RL Semana 3
## 45 15 RL Semana 4
## 46 1 R Mes 8
## 47 2 R Mes 6
## 48 3 R Mes 7
## 49 4 R Mes 6
## 50 5 R Mes 8
## 51 6 RA Mes 3
## 52 7 RA Mes 5
## 53 8 RA Mes 6
## 54 9 RA Mes 4
## 55 10 RA Mes 5
## 56 11 RL Mes 3
## 57 12 RL Mes 4
## 58 13 RL Mes 6
## 59 14 RL Mes 4
## 60 15 RL Mes 3Resumen estadístico
df3 %>% group_by(time) %>% get_summary_stats(score,type="mean_sd")## # A tibble: 4 x 5
## time variable n mean sd
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 Dia score 15 6.4 1.24
## 2 Hora score 15 8.13 0.99
## 3 Mes score 15 5.2 1.70
## 4 Semana score 15 5.2 1.42df3## Id Memoria time score
## 1 1 R Hora 10
## 2 2 R Hora 9
## 3 3 R Hora 8
## 4 4 R Hora 7
## 5 5 R Hora 10
## 6 6 RA Hora 8
## 7 7 RA Hora 8
## 8 8 RA Hora 9
## 9 9 RA Hora 8
## 10 10 RA Hora 7
## 11 11 RL Hora 7
## 12 12 RL Hora 8
## 13 13 RL Hora 8
## 14 14 RL Hora 8
## 15 15 RL Hora 7
## 16 1 R Dia 8
## 17 2 R Dia 8
## 18 3 R Dia 6
## 19 4 R Dia 7
## 20 5 R Dia 9
## 21 6 RA Dia 6
## 22 7 RA Dia 7
## 23 8 RA Dia 7
## 24 9 RA Dia 6
## 25 10 RA Dia 5
## 26 11 RL Dia 5
## 27 12 RL Dia 6
## 28 13 RL Dia 6
## 29 14 RL Dia 5
## 30 15 RL Dia 5
## 31 1 R Semana 7
## 32 2 R Semana 7
## 33 3 R Semana 6
## 34 4 R Semana 6
## 35 5 R Semana 8
## 36 6 RA Semana 5
## 37 7 RA Semana 6
## 38 8 RA Semana 5
## 39 9 RA Semana 4
## 40 10 RA Semana 4
## 41 11 RL Semana 4
## 42 12 RL Semana 4
## 43 13 RL Semana 5
## 44 14 RL Semana 3
## 45 15 RL Semana 4
## 46 1 R Mes 8
## 47 2 R Mes 6
## 48 3 R Mes 7
## 49 4 R Mes 6
## 50 5 R Mes 8
## 51 6 RA Mes 3
## 52 7 RA Mes 5
## 53 8 RA Mes 6
## 54 9 RA Mes 4
## 55 10 RA Mes 5
## 56 11 RL Mes 3
## 57 12 RL Mes 4
## 58 13 RL Mes 6
## 59 14 RL Mes 4
## 60 15 RL Mes 3Visualización de Datos
bxp=ggboxplot(df3,x="time",y="score",color="Memoria",palette="jco")
bxp
Supuestos del Modelo
Outlier
df3 %>% group_by(Id,time) %>% identify_outliers(score)## [1] Id time Memoria score is.outlier is.extreme
## <0 rows> (or 0-length row.names)Normalidad
df3 %>% group_by(Memoria,time) %>% shapiro_test(score)## # A tibble: 12 x 5
## Memoria time variable statistic p
## <fct> <fct> <chr> <dbl> <dbl>
## 1 R Dia score 0.961 0.814
## 2 R Hora score 0.902 0.421
## 3 R Mes score 0.821 0.119
## 4 R Semana score 0.881 0.314
## 5 RA Dia score 0.881 0.314
## 6 RA Hora score 0.883 0.325
## 7 RA Mes score 0.961 0.814
## 8 RA Semana score 0.881 0.314
## 9 RL Dia score 0.684 0.00647
## 10 RL Hora score 0.684 0.00647
## 11 RL Mes score 0.833 0.146
## 12 RL Semana score 0.883 0.325ggqqplot(df3,"score",ggtheme=theme_bw()) + facet_grid(time~Memoria,labeller="label_both")
Homogeneidad de varianza
res.aov=anova_test(data=df3,dv=score,wid=Id,between = Memoria,within=time)
get_anova_table(res.aov)## ANOVA Table (type II tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 Memoria 2 12 11.839 1.00e-03 * 0.572
## 2 time 3 36 76.978 9.94e-16 * 0.673
## 3 Memoria:time 6 36 2.622 3.30e-02 * 0.123Pruebas Post Hoc
one.way<- df3 %>% group_by(time) %>% anova_test(dv=score,wid=Id,between=Memoria) %>%
get_anova_table() %>% adjust_pvalue(method="bonferroni")## Coefficient covariances computed by hccm()
## Coefficient covariances computed by hccm()
## Coefficient covariances computed by hccm()
## Coefficient covariances computed by hccm()one.way## # A tibble: 4 x 9
## time Effect DFn DFd F p `p<.05` ges p.adj
## * <fct> <chr> <dbl> <dbl> <dbl> <dbl> <chr> <dbl> <dbl>
## 1 Dia Memoria 2 12 8.09 0.006 "*" 0.574 0.024
## 2 Hora Memoria 2 12 2.24 0.149 "" 0.272 0.596
## 3 Mes Memoria 2 12 9.95 0.003 "*" 0.624 0.012
## 4 Semana Memoria 2 12 16.4 0.000367 "*" 0.732 0.00147REPORTE
pwc<-pwc %>% add_xy_position(x="time")
bxp+
stat_pvalue_manual(pwc,tip.length=0,hide.ns=TRUE)+
labs(
subtitle=get_test_label(res.aov,detailed=TRUE),
caption=get_pwc_label(pwc)
)## Warning: Removed 3 rows containing non-finite values (stat_bracket).
Existe diferencia significativa entre los factores a un 95 % de confianza, por tanto el tiempo y tipo de memoria y la interaccion de ellos influye en la calidad de la memoria. Se cumple el supuesto de no outlier, perola normalidad se cumple para todos los datos excepto para la memoria libre de dia y hora.
PROBLEMA 4
N=c(1,2,3,4,5,6,7,8,9,10,11,12)
M1=c(108,103,96,84,118,110,129,90,84,96,105,113)
M2=c(96,117,107,85,125,107,128,84,104,100,114,117)
M3=c(110,127,106,92,125,96,123,101,100,103,105,132)
M4=c(122,133,107,99,116,91,128,113,88,105,112,130)
df4=data.frame(N=N,M1=M1,M2=M2,M3=M3,M4=M4)
df4## N M1 M2 M3 M4
## 1 1 108 96 110 122
## 2 2 103 117 127 133
## 3 3 96 107 106 107
## 4 4 84 85 92 99
## 5 5 118 125 125 116
## 6 6 110 107 96 91
## 7 7 129 128 123 128
## 8 8 90 84 101 113
## 9 9 84 104 100 88
## 10 10 96 100 103 105
## 11 11 105 114 105 112
## 12 12 113 117 132 130df4 = df4 %>% gather(key="time",value="score",M1,M2,M3,M4) %>% convert_as_factor(N,time)
df4## N time score
## 1 1 M1 108
## 2 2 M1 103
## 3 3 M1 96
## 4 4 M1 84
## 5 5 M1 118
## 6 6 M1 110
## 7 7 M1 129
## 8 8 M1 90
## 9 9 M1 84
## 10 10 M1 96
## 11 11 M1 105
## 12 12 M1 113
## 13 1 M2 96
## 14 2 M2 117
## 15 3 M2 107
## 16 4 M2 85
## 17 5 M2 125
## 18 6 M2 107
## 19 7 M2 128
## 20 8 M2 84
## 21 9 M2 104
## 22 10 M2 100
## 23 11 M2 114
## 24 12 M2 117
## 25 1 M3 110
## 26 2 M3 127
## 27 3 M3 106
## 28 4 M3 92
## 29 5 M3 125
## 30 6 M3 96
## 31 7 M3 123
## 32 8 M3 101
## 33 9 M3 100
## 34 10 M3 103
## 35 11 M3 105
## 36 12 M3 132
## 37 1 M4 122
## 38 2 M4 133
## 39 3 M4 107
## 40 4 M4 99
## 41 5 M4 116
## 42 6 M4 91
## 43 7 M4 128
## 44 8 M4 113
## 45 9 M4 88
## 46 10 M4 105
## 47 11 M4 112
## 48 12 M4 130RESUMEN ESTADISTICO
df4 %>% group_by(time) %>% get_summary_stats(score,type="mean_sd")## # A tibble: 4 x 5
## time variable n mean sd
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 M1 score 12 103 13.7
## 2 M2 score 12 107 14.2
## 3 M3 score 12 110 13.3
## 4 M4 score 12 112 14.8VISUALIZACIÓN
bxp<-ggboxplot(df4,x="time",y="score", add="point")
bxp
SUPUESTOS DEL MODELO
Outliers
df4 %>% group_by(time) %>% identify_outliers(score)## [1] time N score is.outlier is.extreme
## <0 rows> (or 0-length row.names)NORMALIDAD
df4 %>% group_by(time) %>% shapiro_test(score)## # A tibble: 4 x 4
## time variable statistic p
## <fct> <chr> <dbl> <dbl>
## 1 M1 score 0.968 0.883
## 2 M2 score 0.957 0.736
## 3 M3 score 0.911 0.222
## 4 M4 score 0.960 0.778ggqqplot(df4,"score",facet.by="time")
Calculo del Anova
res.aov<-anova_test(data=df4,dv=score,wid=N,within=time)
get_anova_table(res.aov)## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 time 1.83 20.11 3.027 0.075 0.06Comparación de medias
pwc=df4 %>% pairwise_t_test(score~time,paired=TRUE,p.adjust.method="bonferroni")
pwc## # A tibble: 6 x 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 score M1 M2 12 12 -1.55 11 0.149 0.894 ns
## 2 score M1 M3 12 12 -2.30 11 0.042 0.253 ns
## 3 score M1 M4 12 12 -2.44 11 0.033 0.198 ns
## 4 score M2 M3 12 12 -1.09 11 0.3 1 ns
## 5 score M2 M4 12 12 -1.16 11 0.271 1 ns
## 6 score M3 M4 12 12 -0.896 11 0.39 1 nsREPORTE
pwc <- pwc %>% add_xy_position(x="time")
bxp+
stat_pvalue_manual(pwc) +
labs(
subtitle = get_test_label(res.aov,detailed=TRUE),
caption=get_pwc_label(pwc)
)
No hay cambio significativo respecto a la inteligencia vs el tiempo en los niños estudiados. Los resultados cumplen los supuestos de no outlier y normalidad.
PROBLEMA 5
df5<-read.csv("https://raw.githubusercontent.com/HSolis08/D.experimental/main/p5.csv")
df5$ID=factor(df5$ID)
df5$R=factor(df5$R)
df5$A0=as.numeric(df5$A0)
df5$A4=as.numeric(df5$A4)
df5$A8=as.numeric(df5$A8)
df5## ID R A0 A4 A8
## 1 1 ab 420 420 480
## 2 1 pr 480 600 780
## 3 2 ab 420 480 480
## 4 2 pr 360 480 600
## 5 3 ab 480 480 540
## 6 3 pr 660 780 780
## 7 4 ab 420 540 540
## 8 4 pr 480 780 900
## 9 5 ab 540 660 540
## 10 5 pr 480 660 720
## 11 6 ab 360 420 360
## 12 6 pr 360 480 540
## 13 7 ab 480 480 600
## 14 7 pr 540 720 840
## 15 8 ab 480 600 660
## 16 8 pr 540 720 900
## 17 9 ab 540 600 540
## 18 9 pr 480 720 780
## 19 10 ab 480 420 540
## 20 10 pr 540 660 780df5=df5 %>% gather(key="Angulo",value="score",A0,A4,A8) %>% convert_as_factor(ID,Angulo)
df5## ID R Angulo score
## 1 1 ab A0 420
## 2 1 pr A0 480
## 3 2 ab A0 420
## 4 2 pr A0 360
## 5 3 ab A0 480
## 6 3 pr A0 660
## 7 4 ab A0 420
## 8 4 pr A0 480
## 9 5 ab A0 540
## 10 5 pr A0 480
## 11 6 ab A0 360
## 12 6 pr A0 360
## 13 7 ab A0 480
## 14 7 pr A0 540
## 15 8 ab A0 480
## 16 8 pr A0 540
## 17 9 ab A0 540
## 18 9 pr A0 480
## 19 10 ab A0 480
## 20 10 pr A0 540
## 21 1 ab A4 420
## 22 1 pr A4 600
## 23 2 ab A4 480
## 24 2 pr A4 480
## 25 3 ab A4 480
## 26 3 pr A4 780
## 27 4 ab A4 540
## 28 4 pr A4 780
## 29 5 ab A4 660
## 30 5 pr A4 660
## 31 6 ab A4 420
## 32 6 pr A4 480
## 33 7 ab A4 480
## 34 7 pr A4 720
## 35 8 ab A4 600
## 36 8 pr A4 720
## 37 9 ab A4 600
## 38 9 pr A4 720
## 39 10 ab A4 420
## 40 10 pr A4 660
## 41 1 ab A8 480
## 42 1 pr A8 780
## 43 2 ab A8 480
## 44 2 pr A8 600
## 45 3 ab A8 540
## 46 3 pr A8 780
## 47 4 ab A8 540
## 48 4 pr A8 900
## 49 5 ab A8 540
## 50 5 pr A8 720
## 51 6 ab A8 360
## 52 6 pr A8 540
## 53 7 ab A8 600
## 54 7 pr A8 840
## 55 8 ab A8 660
## 56 8 pr A8 900
## 57 9 ab A8 540
## 58 9 pr A8 780
## 59 10 ab A8 540
## 60 10 pr A8 780Resumen estadistico
df5 %>% group_by(Angulo) %>% get_summary_stats(score,type="mean_sd")## # A tibble: 3 x 5
## Angulo variable n mean sd
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 A0 score 20 477 74.1
## 2 A4 score 20 585 123.
## 3 A8 score 20 645 154.df5## ID R Angulo score
## 1 1 ab A0 420
## 2 1 pr A0 480
## 3 2 ab A0 420
## 4 2 pr A0 360
## 5 3 ab A0 480
## 6 3 pr A0 660
## 7 4 ab A0 420
## 8 4 pr A0 480
## 9 5 ab A0 540
## 10 5 pr A0 480
## 11 6 ab A0 360
## 12 6 pr A0 360
## 13 7 ab A0 480
## 14 7 pr A0 540
## 15 8 ab A0 480
## 16 8 pr A0 540
## 17 9 ab A0 540
## 18 9 pr A0 480
## 19 10 ab A0 480
## 20 10 pr A0 540
## 21 1 ab A4 420
## 22 1 pr A4 600
## 23 2 ab A4 480
## 24 2 pr A4 480
## 25 3 ab A4 480
## 26 3 pr A4 780
## 27 4 ab A4 540
## 28 4 pr A4 780
## 29 5 ab A4 660
## 30 5 pr A4 660
## 31 6 ab A4 420
## 32 6 pr A4 480
## 33 7 ab A4 480
## 34 7 pr A4 720
## 35 8 ab A4 600
## 36 8 pr A4 720
## 37 9 ab A4 600
## 38 9 pr A4 720
## 39 10 ab A4 420
## 40 10 pr A4 660
## 41 1 ab A8 480
## 42 1 pr A8 780
## 43 2 ab A8 480
## 44 2 pr A8 600
## 45 3 ab A8 540
## 46 3 pr A8 780
## 47 4 ab A8 540
## 48 4 pr A8 900
## 49 5 ab A8 540
## 50 5 pr A8 720
## 51 6 ab A8 360
## 52 6 pr A8 540
## 53 7 ab A8 600
## 54 7 pr A8 840
## 55 8 ab A8 660
## 56 8 pr A8 900
## 57 9 ab A8 540
## 58 9 pr A8 780
## 59 10 ab A8 540
## 60 10 pr A8 780Visualización de datos
bxp<-ggboxplot(df5,x="Angulo",y="score",color="R",palette="jco")
bxp
Supuestos del Modelo
Outlier
df5 %>% group_by(R,Angulo) %>% identify_outliers(score)## # A tibble: 6 x 6
## R Angulo ID score is.outlier is.extreme
## <fct> <fct> <fct> <dbl> <lgl> <lgl>
## 1 ab A8 6 360 TRUE FALSE
## 2 ab A8 8 660 TRUE FALSE
## 3 pr A0 2 360 TRUE FALSE
## 4 pr A0 3 660 TRUE FALSE
## 5 pr A0 6 360 TRUE FALSE
## 6 pr A8 6 540 TRUE FALSENormalidad
df5 %>% group_by(R,Angulo) %>% shapiro_test(score)## # A tibble: 6 x 5
## R Angulo variable statistic p
## <fct> <fct> <chr> <dbl> <dbl>
## 1 ab A0 score 0.911 0.287
## 2 ab A4 score 0.886 0.151
## 3 ab A8 score 0.897 0.203
## 4 pr A0 score 0.897 0.202
## 5 pr A4 score 0.869 0.0965
## 6 pr A8 score 0.892 0.180ggqqplot(df5,"score",ggtheme=theme_bw()) + facet_grid(Angulo~
R,labeller="label_both")
Homogeneidad de varianza
df5 %>% group_by(Angulo) %>% levene_test(score~R)## # A tibble: 3 x 5
## Angulo df1 df2 statistic p
## <fct> <int> <int> <dbl> <dbl>
## 1 A0 1 18 0.574 0.458
## 2 A4 1 18 0.372 0.550
## 3 A8 1 18 0.812 0.379Calculo de Anova
res.aov<-anova_test(data=df5,dv=score,wid=ID,within=c(R,Angulo))
get_anova_table(res.aov)## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 R 1 9 33.766 2.56e-04 * 0.387
## 2 Angulo 2 18 40.719 2.09e-07 * 0.390
## 3 R:Angulo 2 18 45.310 9.42e-08 * 0.188Repeated.Measures.ANOVA <- aov(score~ Angulo + R + Angulo*R + Error(ID/Angulo*R), data=df5)
summary(Repeated.Measures.ANOVA)##
## Error: ID
## Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 9 292140 32460
##
## Error: R
## Df Sum Sq Mean Sq
## R 1 285660 285660
##
## Error: ID:Angulo
## Df Sum Sq Mean Sq F value Pr(>F)
## Angulo 2 289920 144960 40.72 2.09e-07 ***
## Residuals 18 64080 3560
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Error: ID:R
## Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 9 76140 8460
##
## Error: ID:Angulo:R
## Df Sum Sq Mean Sq F value Pr(>F)
## Angulo:R 2 105120 52560 45.31 9.42e-08 ***
## Residuals 18 20880 1160
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Prueba Post Hoc
one.way<- df5 %>% group_by(Angulo) %>% anova_test(dv=score,wid=ID,within=R) %>% get_anova_table() %>% adjust_pvalue(method="bonferroni")
one.way## # A tibble: 3 x 9
## Angulo Effect DFn DFd F p `p<.05` ges p.adj
## * <fct> <chr> <dbl> <dbl> <dbl> <dbl> <chr> <dbl> <dbl>
## 1 A0 R 1 9 1.55 0.244 "" 0.043 0.732
## 2 A4 R 1 9 19.7 0.002 "*" 0.392 0.006
## 3 A8 R 1 9 126. 0.00000138 "*" 0.605 0.00000414Comparacion de Medias
pwc<- df5 %>%
group_by(Angulo) %>%
pairwise_t_test(
score~R, paired=TRUE,
p.adjust.method="bonferroni"
)
pwc## # A tibble: 3 x 11
## Angulo .y. group1 group2 n1 n2 statistic df p p.adj
## * <fct> <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 A0 score ab pr 10 10 -1.25 9 0.244 0.244
## 2 A4 score ab pr 10 10 -4.44 9 0.002 0.002
## 3 A8 score ab pr 10 10 -11.2 9 0.00000138 0.00000138
## # ... with 1 more variable: p.adj.signif <chr>Reporte
pwc<-pwc %>% add_xy_position(x="Angulo")
bxp+
stat_pvalue_manual(pwc,tip.length=0,hide.ns=TRUE)+
labs(
subtitle=get_test_label(res.aov,detailed=TRUE),
caption=get_pwc_label(pwc)
)
Los datos obtenidos cumplen los supuestos de no outlier, distribucion normal y homocedasticidad;pero existe diferencia significativa entre los factores de ruido y rotación y la interacción de ellos.
PROBLEMA 6
df6 = data.frame(patient=rep(1:5, each=4),
drug=rep(1:4, times=5),
response=c(30, 28, 16, 34,
14, 18, 10, 22,
24, 20, 18, 30,
38, 34, 20, 44,
26, 28, 14, 30))
df6$patient=factor(df6$patient)
df6$drug=factor(df6$drug)
df6## patient drug response
## 1 1 1 30
## 2 1 2 28
## 3 1 3 16
## 4 1 4 34
## 5 2 1 14
## 6 2 2 18
## 7 2 3 10
## 8 2 4 22
## 9 3 1 24
## 10 3 2 20
## 11 3 3 18
## 12 3 4 30
## 13 4 1 38
## 14 4 2 34
## 15 4 3 20
## 16 4 4 44
## 17 5 1 26
## 18 5 2 28
## 19 5 3 14
## 20 5 4 30RESUMEN ESTADISTICO
df6 %>% group_by(drug) %>% get_summary_stats(response,type="mean_sd")## # A tibble: 4 x 5
## drug variable n mean sd
## <fct> <chr> <dbl> <dbl> <dbl>
## 1 1 response 5 26.4 8.76
## 2 2 response 5 25.6 6.54
## 3 3 response 5 15.6 3.85
## 4 4 response 5 32 8Visualización
bxp<-ggboxplot(df6,x="drug",y="response", add="point")
bxp
SUPUESTOS DEL MODELO
Outliers
df6%>% group_by(drug) %>% identify_outliers(response)## # A tibble: 3 x 5
## drug patient response is.outlier is.extreme
## <fct> <fct> <dbl> <lgl> <lgl>
## 1 1 2 14 TRUE FALSE
## 2 4 2 22 TRUE FALSE
## 3 4 4 44 TRUE FALSENormalidad
df6%>% group_by(drug) %>% shapiro_test(response)## # A tibble: 4 x 4
## drug variable statistic p
## <fct> <chr> <dbl> <dbl>
## 1 1 response 0.985 0.962
## 2 2 response 0.922 0.544
## 3 3 response 0.979 0.928
## 4 4 response 0.949 0.731ggqqplot(df6,"response",facet.by="drug")
Cálculo de ANOVA
res.aov<-anova_test(data=df6,dv=response,wid=patient,within=drug)
get_anova_table(res.aov)## ANOVA Table (type III tests)
##
## Effect DFn DFd F p p<.05 ges
## 1 drug 3 12 24.759 1.99e-05 * 0.468Comparaciones de medias
pwc<-df6 %>% pairwise_t_test(response~drug,paired=TRUE,p.adjust.method="bonferroni")
pwc## # A tibble: 6 x 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 response 1 2 5 5 0.492 4 0.648 1 ns
## 2 response 1 3 5 5 4.19 4 0.014 0.083 ns
## 3 response 1 4 5 5 -7.48 4 0.002 0.01 *
## 4 response 2 3 5 5 4.39 4 0.012 0.071 ns
## 5 response 2 4 5 5 -4 4 0.016 0.097 ns
## 6 response 3 4 5 5 -7.36 4 0.002 0.011 *Reporte
pwc <- pwc %>% add_xy_position(x="time")
bxp+
stat_pvalue_manual(pwc) +
labs(
subtitle = get_test_label(res.aov,detailed=TRUE),
caption=get_pwc_label(pwc)
)## Warning: Removed 6 rows containing non-finite values (stat_bracket).
R/. Los datos obtenidos cumplen con la distribución normal, la homocedasticidad y no posee outlier significativos. Presenta influencia significativa los medicamentos sobre el tiempo de reacción.