EJERCICIO 1
En un experimento se consideran tres especies de plantas y dos tipos de reactivos para activar el ciclo de florescencia de las plantas. Se mide en cada planta la sobrevivencia de la flor,es decir, el tiempo en días en que aparece la flor hasta cuando presenta signos de marchitamiento
library(readxl)
## Warning: package 'readxl' was built under R version 4.3.2
ejercicio1 <- read_excel("D:/Usuario/Desktop/exp/dosfact1.xlsx")
View(ejercicio1)
Conteo de valores
conteo_valores_tratamiento <- table(ejercicio1$reactivo,ejercicio1$Especie)
print("Número de observaciones (réplicas) por tratamiento:")
## [1] "Número de observaciones (réplicas) por tratamiento:"
print(conteo_valores_tratamiento)
##
## A B C
## R1 3 3 3
## R2 3 3 3
MEDIDAS DESCRIPTIVAS DE LA VARIABLE DEPENDIENTE
# Calcular estadísticas descriptivas por categoría
resultados_descriptivos <- summarytools::descr(ejercicio1$Tiempo)
print(resultados_descriptivos)
## Descriptive Statistics
## ejercicio1$Tiempo
## N: 18
##
## Tiempo
## ----------------- --------
## Mean 12.50
## Std.Dev 3.50
## Min 8.00
## Q1 9.00
## Median 12.50
## Q3 15.00
## Max 20.00
## MAD 3.71
## IQR 5.75
## CV 0.28
## Skewness 0.43
## SE.Skewness 0.54
## Kurtosis -0.90
## N.Valid 18.00
## Pct.Valid 100.00
# Imprimir los resultados descriptivos
print(resultados_descriptivos)
## Descriptive Statistics
## ejercicio1$Tiempo
## N: 18
##
## Tiempo
## ----------------- --------
## Mean 12.50
## Std.Dev 3.50
## Min 8.00
## Q1 9.00
## Median 12.50
## Q3 15.00
## Max 20.00
## MAD 3.71
## IQR 5.75
## CV 0.28
## Skewness 0.43
## SE.Skewness 0.54
## Kurtosis -0.90
## N.Valid 18.00
## Pct.Valid 100.00
RESULTADOS DESCRIPTIVOS
# Calcular estadísticas descriptivas por categoría
resultados_descriptivos <- by(ejercicio1$Tiempo, ejercicio1$Especie, summary)
print(resultados_descriptivos)
## ejercicio1$Especie: A
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 8.00 9.00 10.50 11.00 12.75 15.00
## ------------------------------------------------------------
## ejercicio1$Especie: B
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 8.00 9.25 11.50 11.67 14.50 15.00
## ------------------------------------------------------------
## ejercicio1$Especie: C
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 10.00 12.25 14.50 14.83 17.50 20.00
# Imprimir los resultados descriptivos
print(resultados_descriptivos)
## ejercicio1$Especie: A
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 8.00 9.00 10.50 11.00 12.75 15.00
## ------------------------------------------------------------
## ejercicio1$Especie: B
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 8.00 9.25 11.50 11.67 14.50 15.00
## ------------------------------------------------------------
## ejercicio1$Especie: C
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 10.00 12.25 14.50 14.83 17.50 20.00
Se presentan estadísticas descriptivas para la variable “Tiempo” divididas por especie (A, B y C). Para la especie A, los valores oscilan entre 8.00 y 15.00, con una mediana de 10.50 y una media de 11.00. La especie B muestra valores que varían desde 8.00 hasta 15.00, con una mediana de 11.50 y una media de 11.67. En cuanto a la especie C, los valores oscilan desde 10.00 hasta 20.00, con una mediana de 14.50 y una media de 14.83. Estas estadísticas descriptivas proporcionan información sobre la distribución de los tiempos de acuerdo con cada especie en el conjunto de datos, lo que permite comparar las diferencias en el tiempo necesario para completar una tarea entre las especies.
ANOVA Factor 1 α: Reactivo \(H_0:No existen diferencias significativas entre los tipos de reactivos para la sobrevivencia de la flor\) \(H_a: Existen diferencias significativas en la supervivencia de la flor entre al menos dos de los tipos de reactivos utilizados\) \(H_0:α1=α2=...=αa=0\) \(H_a:α1≠0 para algún i\) Factor 2 β: Especie \(H_0:No existen diferencias significativas entre las especies para la sobrevivencia de la flor\) \(H_a: Existen diferencias significativas en la supervivencia de la flor entre al menos dos especies de plantas\) \(H_0:β1=β2=...=βb=0\) \(H_a:βj≠0 para algún j\) Interacción \(H_0:No existe interacción significativa entre la especie y el tipo de reactivo para la sobrevivencia de la flor\) \(H_a: Existen interacción significativas entre la especie y el reactivo para la supervivencia de la flor\) \(H_0:(αβ)ij=0 para todo ij\) \(H_a:(αβ)ij≠0 para algún ij\)
modelo_anova <- aov(Tiempo ~ reactivo * Especie, data = ejercicio1)
resultado_anova <- summary(modelo_anova)
print(resultado_anova)
## Df Sum Sq Mean Sq F value Pr(>F)
## reactivo 1 133.39 133.39 70.618 2.26e-06 ***
## Especie 2 50.33 25.17 13.324 0.000896 ***
## reactivo:Especie 2 2.11 1.06 0.559 0.586073
## Residuals 12 22.67 1.89
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
El análisis de varianza (ANOVA) realizado en un diseño con dos variables predictoras, “reactivo” y “Especie”, junto con su interacción, revela que tanto “reactivo” como “Especie” tienen efectos significativos en la variable de respuesta. Los valores p muy bajos para ambas variables indican que las diferencias entre sus niveles son estadísticamente significativas. Sin embargo, la interacción “reactivo:Especie” no resulta significativa a un nivel de significancia común, sugiriendo que la influencia conjunta de ambas variables no es estadísticamente significativa en este contexto.
Diagrama de cajas y bigotes
boxplot(ejercicio1$Tiempo ~ ejercicio1$reactivo * ejercicio1$Especie,
main = "Diagrama de Cajas de Sobrevivencia",
xlab = "Combinacion de Reactivo y Especie",
ylab = "Sobrevivencia",
col = c("lightgreen", "yellow", "lightblue","orange","pink","purple"))
En el gráfico de cajas, se pueden identificar varias combinaciones que
muestran diferencias significativas en la supervivencia de las flores,
con un valor de p menor a 0.05. Estas combinaciones incluyen R2:A y
R1:A, R2:B y R1:A, R1:C y R1:A, R1:C y R2:C, R1:B y R1:A, entre otras.
En estas combinaciones, las distribuciones no se superponen, lo que
indica diferencias significativas en la supervivencia entre los grupos.
Sin embargo, en los casos de R1:B y R1:A, así como R2:B y R2:A, las
distribuciones se superponen, lo que sugiere que no hay diferencias
significativas en la supervivencia entre estos grupos.
PRUEBAS POST HOC LSD
modelo_anova <- aov(Tiempo ~ reactivo + Especie + reactivo:Especie, data = ejercicio1)
LSD_result <- TukeyHSD(modelo_anova)
print(LSD_result)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Tiempo ~ reactivo + Especie + reactivo:Especie, data = ejercicio1)
##
## $reactivo
## diff lwr upr p adj
## R2-R1 -5.444444 -6.856061 -4.032827 2.3e-06
##
## $Especie
## diff lwr upr p adj
## B-A 0.6666667 -1.450262 2.783595 0.6862717
## C-A 3.8333333 1.716405 5.950262 0.0011057
## C-B 3.1666667 1.049738 5.283595 0.0047100
##
## $`reactivo:Especie`
## diff lwr upr p adj
## R2:A-R1:A -4.6666667 -8.4359375 -0.8973958 0.0129801
## R1:B-R1:A 1.0000000 -2.7692709 4.7692709 0.9415283
## R2:B-R1:A -4.3333333 -8.1026042 -0.5640625 0.0214217
## R1:C-R1:A 4.6666667 0.8973958 8.4359375 0.0129801
## R2:C-R1:A -1.6666667 -5.4359375 2.1026042 0.6791464
## R1:B-R2:A 5.6666667 1.8973958 9.4359375 0.0029859
## R2:B-R2:A 0.3333333 -3.4359375 4.1026042 0.9995991
## R1:C-R2:A 9.3333333 5.5640625 13.1026042 0.0000291
## R2:C-R2:A 3.0000000 -0.7692709 6.7692709 0.1523873
## R2:B-R1:B -5.3333333 -9.1026042 -1.5640625 0.0048364
## R1:C-R1:B 3.6666667 -0.1026042 7.4359375 0.0582517
## R2:C-R1:B -2.6666667 -6.4359375 1.1026042 0.2380136
## R1:C-R2:B 9.0000000 5.2307291 12.7692709 0.0000421
## R2:C-R2:B 2.6666667 -1.1026042 6.4359375 0.2380136
## R2:C-R1:C -6.3333333 -10.1026042 -2.5640625 0.0011711
El análisis de comparaciones múltiples Tukey revela diferencias significativas en el tiempo de respuesta en función de los niveles de las variables “reactivo” y “Especie,” así como su interacción. Entre las comparaciones significativas, se destaca que el “reactivo” R2 tiene un tiempo de respuesta significativamente menor que R1. En cuanto a la “Especie,” se observa que la especie C muestra tiempos de respuesta significativamente más largos en comparación con A y B. Además, la interacción “reactivo:Especie” también presenta diferencias significativas en múltiples combinaciones, lo que sugiere que la influencia del “reactivo” en el tiempo de respuesta varía según la “Especie.” Estos resultados proporcionan información valiosa sobre las diferencias en el tiempo de respuesta en el contexto del diseño experimental.
Tukey
resultado_tukey <- TukeyHSD(modelo_anova)
print(resultado_tukey)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Tiempo ~ reactivo + Especie + reactivo:Especie, data = ejercicio1)
##
## $reactivo
## diff lwr upr p adj
## R2-R1 -5.444444 -6.856061 -4.032827 2.3e-06
##
## $Especie
## diff lwr upr p adj
## B-A 0.6666667 -1.450262 2.783595 0.6862717
## C-A 3.8333333 1.716405 5.950262 0.0011057
## C-B 3.1666667 1.049738 5.283595 0.0047100
##
## $`reactivo:Especie`
## diff lwr upr p adj
## R2:A-R1:A -4.6666667 -8.4359375 -0.8973958 0.0129801
## R1:B-R1:A 1.0000000 -2.7692709 4.7692709 0.9415283
## R2:B-R1:A -4.3333333 -8.1026042 -0.5640625 0.0214217
## R1:C-R1:A 4.6666667 0.8973958 8.4359375 0.0129801
## R2:C-R1:A -1.6666667 -5.4359375 2.1026042 0.6791464
## R1:B-R2:A 5.6666667 1.8973958 9.4359375 0.0029859
## R2:B-R2:A 0.3333333 -3.4359375 4.1026042 0.9995991
## R1:C-R2:A 9.3333333 5.5640625 13.1026042 0.0000291
## R2:C-R2:A 3.0000000 -0.7692709 6.7692709 0.1523873
## R2:B-R1:B -5.3333333 -9.1026042 -1.5640625 0.0048364
## R1:C-R1:B 3.6666667 -0.1026042 7.4359375 0.0582517
## R2:C-R1:B -2.6666667 -6.4359375 1.1026042 0.2380136
## R1:C-R2:B 9.0000000 5.2307291 12.7692709 0.0000421
## R2:C-R2:B 2.6666667 -1.1026042 6.4359375 0.2380136
## R2:C-R1:C -6.3333333 -10.1026042 -2.5640625 0.0011711
El análisis Tukey de comparaciones múltiples de medias revela diferencias significativas en el tiempo de respuesta en función de las combinaciones de niveles de las variables “reactivo,” “Especie” y su interacción. Se destaca que R2 tiene un tiempo de respuesta significativamente menor en comparación con R1 para la variable “reactivo.” En cuanto a la “Especie,” la especie C muestra tiempos de respuesta significativamente más largos que las especies A y B. Además, en la interacción “reactivo:Especie,” se observan diferencias significativas en varias combinaciones, lo que sugiere que la influencia del “reactivo” en el tiempo de respuesta varía según la “Especie.” Estos resultados proporcionan una visión detallada de las diferencias en el tiempo de respuesta en el contexto del diseño experimental.
plot(resultado_tukey)
Supuestos del modelo DIstribución normal de los
residuos
residuos<-residuals(modelo_anova)
par(mfrow=c(1,3))
# Gráfico Q-Q de los residuos con color
qqnorm(residuos, col = "orange", main = "Gráfico Q-Q de Residuos")
qqline(residuos, col = "black")
# Curva de densidad de los residuos
densidad_residuos <- density(residuos)
plot(densidad_residuos, main = "Curva de Densidad de Residuos", xlab = "Residuos", col = "blue")
polygon(densidad_residuos, col = "green", border = "black")
# Boxplot de residuos
boxplot(residuos, col = "pink",
main = "Boxplot de Residuos",
xlab = "Combinación de Reactivo y Especie",
ylab = "Residuos")
Se puede observar que los residuos tienen una distribución relativamente
normal, ya que la curva de densidad tiene una forma casi simetrica, al
igual que el diagrama de cajas.
Shapiro-wilk
\(H_0: Los valores no explicados por las variables en la variable de supervivencia de la flor siguen una distribución normal con una media de cero y una variabilidad constante.\) \(H_0:La distribución de los residuos de la variable de supervivencia de la flor no se ajusta a una distribución normal.\)
modelo_anova <- aov(Tiempo ~ reactivo + Especie + reactivo:Especie, data = ejercicio1)
shapiro.test(residuals(modelo_anova))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_anova)
## W = 0.9721, p-value = 0.8361
El resultado del test de normalidad de Shapiro-Wilk indica que los residuos del modelo anova siguen una distribución normal. Esto se basa en un valor de W de 0.9721 y un valor p de 0.8361. Dado que el valor p es mayor que el nivel de significancia común (0.05), no hay evidencia suficiente para rechazar la hipótesis nula de normalidad. En otras palabras, los residuos del modelo se ajustan a una distribución normal, lo que sugiere que el supuesto de normalidad no se ve violado en este caso.
Homogeneidad de varianzas
# Boxplot de los residuos
boxplot(residuos ~ ejercicio1$reactivo: ejercicio1$Especie,
col = "blue",
xlab = "Combinación de Reactivo y Especie",
ylab = "Residuos",
main = "Boxplot de Residuos por Combinación de Reactivo y Especie")
En el gráfico de cajas, se muestran los valores estimados por el modelo para la supervivencia de la flor en relación con la raíz cuadrada de los residuos estandarizados. En este gráfico, no se aprecia ninguna tendencia evidente en la dispersión de los valores. Esto sugiere que no hay indicios de que se viole el supuesto de que las varianzas son consistentes en todos los niveles, es decir, se cumple la homogeneidad de varianzas.
Residuos
color_palette <- colorRampPalette(c("orange", "black", "orange"))
plot(residuos, main = "Prueba de independencia", pch = 20, cex = 2, col = color_palette(120), ylab = "Residuos", xlab = " ")
Prueba de barlett \(H_0: La varianza es constante\) \(H_a: La varianza no es constante en algun grupo\)
grupos <- with(ejercicio1, interaction(reactivo, Especie))
# Prueba de Bartlett
resultado_bartlett <- bartlett.test(residuals(modelo_anova), grupos)
print("Prueba de Bartlett:")
## [1] "Prueba de Bartlett:"
print(resultado_bartlett)
##
## Bartlett test of homogeneity of variances
##
## data: residuals(modelo_anova) and grupos
## Bartlett's K-squared = 2.5886, df = 5, p-value = 0.7631
En este caso, el valor de la estadística de Bartlett (K-squared) es 2.5886, con 5 grados de libertad, y el valor p asociado es 0.7631. Dado que el valor p es mayor que el nivel de significancia común (0.05), no hay evidencia suficiente para rechazar la hipótesis nula de homogeneidad de varianzas. Esto sugiere que las varianzas de los residuos del modelo (modelo_anova) son consistentes en todos los grupos representados por “grupos.” En otras palabras, se cumple el supuesto de homogeneidad de varianzas en este análisis.
Prueba de Durbin Watson
\(H_0: Los residuos son independientes entre tratamientos\) \(H_a: Los residuos no son independientes entre tratamientos\)
library(lmtest)
## Warning: package 'lmtest' was built under R version 4.3.2
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.3.2
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
# Realiza la prueba de Durbin-Watson en los residuos
resultado_durbin_watson <- dwtest(modelo_anova)
print(resultado_durbin_watson)
##
## Durbin-Watson test
##
## data: modelo_anova
## DW = 2.4902, p-value = 0.4146
## alternative hypothesis: true autocorrelation is greater than 0
El valor DW es de 2.4902, y el valor p asociado es 0.4146. El valor p es mayor que el nivel de significancia común (0.05), lo que sugiere que no hay evidencia suficiente para rechazar la hipótesis nula de que no existe autocorrelación positiva en los residuos. En otras palabras, no se encuentra una autocorrelación significativa en los residuos del modelo, lo que respalda la independencia de los errores y la validez del modelo en ese aspecto.
MODELO LINEAL
require(faraway)
## Loading required package: faraway
data("ejercicio1")
## Warning in data("ejercicio1"): data set 'ejercicio1' not found
ejercicio1
## # A tibble: 18 × 3
## reactivo Especie Tiempo
## <chr> <chr> <dbl>
## 1 R1 A 12
## 2 R1 A 13
## 3 R1 A 15
## 4 R1 B 13
## 5 R1 B 15
## 6 R1 B 15
## 7 R1 C 16
## 8 R1 C 18
## 9 R1 C 20
## 10 R2 A 9
## 11 R2 A 8
## 12 R2 A 9
## 13 R2 B 10
## 14 R2 B 8
## 15 R2 B 9
## 16 R2 C 12
## 17 R2 C 10
## 18 R2 C 13
require(table1)
## Loading required package: table1
##
## Attaching package: 'table1'
## The following objects are masked from 'package:base':
##
## units, units<-
table1(~Tiempo|Especie,data=ejercicio1)
| A (N=6) |
B (N=6) |
C (N=6) |
Overall (N=18) |
|
|---|---|---|---|---|
| Tiempo | ||||
| Mean (SD) | 11.0 (2.76) | 11.7 (3.08) | 14.8 (3.82) | 12.5 (3.50) |
| Median [Min, Max] | 10.5 [8.00, 15.0] | 11.5 [8.00, 15.0] | 14.5 [10.0, 20.0] | 12.5 [8.00, 20.0] |
#modelo lineal (para diseño de experimentos)
mod1=lm(Tiempo~reactivo+Especie,data=ejercicio1)
anova(mod1)
## Analysis of Variance Table
##
## Response: Tiempo
## Df Sum Sq Mean Sq F value Pr(>F)
## reactivo 1 133.389 133.389 75.368 5.222e-07 ***
## Especie 2 50.333 25.167 14.220 0.0004251 ***
## Residuals 14 24.778 1.770
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Los resultados del análisis de varianza reflejan la influencia significativa de las variables “reactivo” y “Especie” en la variable de respuesta “Tiempo.” Tanto “reactivo” como “Especie” presentan valores de p muy bajos, lo que indica que las diferencias entre los niveles de estas variables son estadísticamente significativas. Estos resultados confirman que las variables “reactivo” y “Especie” desempeñan un papel importante en la variación de la variable “Tiempo” en el marco del diseño experimental.
#posanova
require(agricolae)
## Loading required package: agricolae
Especie=LSD.test(mod1,"Tiempo")
Especie
## $statistics
## MSerror Df Mean CV
## 1.769841 14 12.5 10.64283
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Tiempo 9 0.05
##
## $means
## Tiempo std r se LCL UCL Min Max Q25 Q50 Q75
## 8 8 0 2 0.9407022 5.982394 10.01761 8 8 8 8 8
## 9 9 0 3 0.7680801 7.352632 10.64737 9 9 9 9 9
## 10 10 0 2 0.9407022 7.982394 12.01761 10 10 10 10 10
## 12 12 0 2 0.9407022 9.982394 14.01761 12 12 12 12 12
## 13 13 0 3 0.7680801 11.352632 14.64737 13 13 13 13 13
## 15 15 0 3 0.7680801 13.352632 16.64737 15 15 15 15 15
## 16 16 NA 1 1.3303538 13.146675 18.85333 16 16 16 16 16
## 18 18 NA 1 1.3303538 15.146675 20.85333 18 18 18 18 18
## 20 20 NA 1 1.3303538 17.146675 22.85333 20 20 20 20 20
##
## $comparison
## NULL
##
## $groups
## Tiempo groups
## 20 20 a
## 18 18 ab
## 16 16 abc
## 15 15 bc
## 13 13 cd
## 12 12 de
## 10 10 ef
## 9 9 f
## 8 8 f
##
## attr(,"class")
## [1] "group"
Los resultados presentados incluyen estadísticas descriptivas de la variable “Tiempo,” donde se destaca una media de 12.5 y un coeficiente de variación de aproximadamente 10.64%. Además, se proporciona información detallada sobre los diferentes niveles de la variable “Tiempo,” incluyendo medidas de tendencia central, dispersión y percentiles. Los niveles de la variable se han agrupado y etiquetado con letras (‘a’, ‘ab’, ‘abc’, ‘bc’, ‘cd’, ‘de’, ‘ef’, ‘f’) para indicar diferencias significativas entre los grupos. Estos resultados son valiosos para comprender la distribución de la variable y las relaciones entre sus niveles en el contexto del análisis estadístico realizado.
#validar los supuestos
#P1 - normalidad
plot(mod1)
shapiro.test(mod1$residuals)
##
## Shapiro-Wilk normality test
##
## data: mod1$residuals
## W = 0.96255, p-value = 0.6516
#en la prueba de shapiro la hipotesis es normalidad
#si el valor p es mayor al 5% (0.05) no rechazo la normalidad
#P2 - homogeneidad de varianza
plot(mod1)
# tipos de variables
str(ejercicio1)
## tibble [18 × 3] (S3: tbl_df/tbl/data.frame)
## $ reactivo: chr [1:18] "R1" "R1" "R1" "R1" ...
## $ Especie : chr [1:18] "A" "A" "A" "B" ...
## $ Tiempo : num [1:18] 12 13 15 13 15 15 16 18 20 9 ...
#Generar tablas con los descriptivos
table1(~Tiempo|reactivo,data=ejercicio1)
| R1 (N=9) |
R2 (N=9) |
Overall (N=18) |
|
|---|---|---|---|
| Tiempo | |||
| Mean (SD) | 15.2 (2.54) | 9.78 (1.72) | 12.5 (3.50) |
| Median [Min, Max] | 15.0 [12.0, 20.0] | 9.00 [8.00, 13.0] | 12.5 [8.00, 20.0] |
table1(~Tiempo|Especie,data=ejercicio1)
| A (N=6) |
B (N=6) |
C (N=6) |
Overall (N=18) |
|
|---|---|---|---|---|
| Tiempo | ||||
| Mean (SD) | 11.0 (2.76) | 11.7 (3.08) | 14.8 (3.82) | 12.5 (3.50) |
| Median [Min, Max] | 10.5 [8.00, 15.0] | 11.5 [8.00, 15.0] | 14.5 [10.0, 20.0] | 12.5 [8.00, 20.0] |
Los resultados presentan estadísticas descriptivas del tiempo en dos grupos, “R1” y “R2,” junto con una visión general de los 18 datos combinados. En el grupo “R1,” el tiempo tiene una media de 15.2 y una desviación estándar de 2.54, con valores que varían entre 12.0 y 20.0. En contraste, en el grupo “R2,” el tiempo promedio es de 9.78, con una desviación estándar de 1.72, y los valores oscilan entre 8.00 y 13.0. La media general para los 18 datos es de 12.5, con una desviación estándar de 3.50, y los valores varían desde 8.00 hasta 20.0. Estos resultados resumen las diferencias en los valores medios y la variabilidad del tiempo entre los grupos “R1” y “R2.”
require(ggplot2)
## Loading required package: ggplot2
ggplot(ejercicio1,aes(x=Especie,y=Tiempo))+geom_point()+
geom_smooth()+theme_classic()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
ejercicio1$Tiempo_factor=as.factor(ejercicio1$Tiempo)
ejercicio1$Tiempo_factor
## [1] 12 13 15 13 15 15 16 18 20 9 8 9 10 8 9 12 10 13
## Levels: 8 9 10 12 13 15 16 18 20
mod1=lm(Tiempo~Especie+reactivo,data=ejercicio1)
anova(mod1)
## Analysis of Variance Table
##
## Response: Tiempo
## Df Sum Sq Mean Sq F value Pr(>F)
## Especie 2 50.333 25.167 14.220 0.0004251 ***
## reactivo 1 133.389 133.389 75.368 5.222e-07 ***
## Residuals 14 24.778 1.770
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Encontramos que la variable “Especie” tiene un valor de F de 14.220 con un valor de p de 0.0004251, lo que indica una influencia significativa en el tiempo. De manera similar, la variable “reactivo” también tiene un efecto significativo en el tiempo, con un valor de F de 75.368 y un valor de p extremadamente bajo (5.222e-07). Esto sugiere que tanto “Especie” como “reactivo” tienen un impacto importante en la variación del tiempo. Por otro lado, los residuos, representados como “Residuals,” tienen una suma de cuadrados (Sum Sq) de 24.778, lo que indica la variación no explicada en el modelo.
##efecto tipo interación
require(ggplot2)
ggplot(ejercicio1,aes(x=Tiempo,y=Especie,colour=reactivo))+geom_point()+
geom_smooth()+theme_classic()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 11.985
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 1.015
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 0
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4.0602
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : span too small. fewer
## data values than degrees of freedom.
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 11.985
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 1.015
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 0
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 4.0602
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : span too small. fewer data values than degrees of freedom.
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 7.995
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 1.005
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 0
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : at 9.005
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : radius 2.5e-05
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : all data on boundary of neighborhood. make span bigger
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 2.5e-05
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : zero-width neighborhood. make span bigger
## Warning: Computation failed in `stat_smooth()`
## Caused by error in `predLoess()`:
## ! NA/NaN/Inf en llamada a una función externa (arg 5)
#modelo de diseño
mod3=lm(Tiempo~Especie+reactivo,data=ejercicio1)
anova(mod3)
## Analysis of Variance Table
##
## Response: Tiempo
## Df Sum Sq Mean Sq F value Pr(>F)
## Especie 2 50.333 25.167 14.220 0.0004251 ***
## reactivo 1 133.389 133.389 75.368 5.222e-07 ***
## Residuals 14 24.778 1.770
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
En este análisis, se observa que ambas variables tienen un efecto estadísticamente significativo en el tiempo. La variable “Especie” muestra un valor de F de 14.220 con un valor de p de 0.0004251, lo que indica que hay diferencias significativas en el tiempo entre al menos dos de los niveles de “Especie”. De manera similar, la variable “reactivo” tiene un efecto aún más significativo, con un valor de F de 75.368 y un valor de p extremadamente bajo (5.222e-07), lo que sugiere diferencias sustanciales en el tiempo en función de los niveles de “reactivo”. Los residuos, representados como “Residuals,” tienen una suma de cuadrados de 24.778, indicando la variación no explicada en el modelo.
#posanova
compara3=LSD.test(mod3,list("Especie","reactivo"))
compara3
## $statistics
## MSerror Df Mean CV t.value LSD
## 1.769841 14 12.5 10.64283 2.144787 2.32973
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Especie:reactivo 6 0.05
##
## $means
## Tiempo std r se LCL UCL Min Max Q25 Q50 Q75
## A:R1 13.333333 1.5275252 3 0.7680801 11.685965 14.98070 12 15 12.5 13 14.0
## A:R2 8.666667 0.5773503 3 0.7680801 7.019299 10.31403 8 9 8.5 9 9.0
## B:R1 14.333333 1.1547005 3 0.7680801 12.685965 15.98070 13 15 14.0 15 15.0
## B:R2 9.000000 1.0000000 3 0.7680801 7.352632 10.64737 8 10 8.5 9 9.5
## C:R1 18.000000 2.0000000 3 0.7680801 16.352632 19.64737 16 20 17.0 18 19.0
## C:R2 11.666667 1.5275252 3 0.7680801 10.019299 13.31403 10 13 11.0 12 12.5
##
## $comparison
## NULL
##
## $groups
## Tiempo groups
## C:R1 18.000000 a
## B:R1 14.333333 b
## A:R1 13.333333 bc
## C:R2 11.666667 c
## B:R2 9.000000 d
## A:R2 8.666667 d
##
## attr(,"class")
## [1] "group"
En este análisis, se observa que ambas variables tienen un efecto estadísticamente significativo en el tiempo. La variable “Especie” muestra un valor de F de 14.220 con un valor de p de 0.0004251, lo que indica que hay diferencias significativas en el tiempo entre al menos dos de los niveles de “Especie”. De manera similar, la variable “reactivo” tiene un efecto aún más significativo, con un valor de F de 75.368 y un valor de p extremadamente bajo (5.222e-07), lo que sugiere diferencias sustanciales en el tiempo en función de los niveles de “reactivo”.
EJERCICIO #2 En unos laboratorios se estan estudiando los factores que influyen en la resistencia de un tipo particular de fibra. Si se eligen al azar cuatro máquinas tres operarios y se realiza un experimento factorial usando fibras de un mismo lote de producción.
library(readxl)
ejercicio2 <- read_excel("D:/Usuario/Desktop/exp/dosfact2.xlsx")
View(ejercicio2)
conteo_valores_tratamiento <- table(ejercicio2$Maquina, ejercicio2$Fibra)
print("Número de observaciones (réplicas) por tratamiento:")
## [1] "Número de observaciones (réplicas) por tratamiento:"
print(conteo_valores_tratamiento)
##
## 108 109 110 111 112 114 115 116 117 119 120
## A 0 1 2 0 1 1 0 1 0 0 0
## B 0 0 2 1 1 0 2 0 0 0 0
## C 1 2 0 1 0 1 0 0 0 1 0
## D 1 0 1 0 1 1 0 0 1 0 1
ANALISIS DESCRIPTIVO
# Calcular estadísticas descriptivas por categoría
resultados_descriptivos <- summarytools::descr(ejercicio2$Fibra)
print(resultados_descriptivos)
## Descriptive Statistics
## ejercicio2$Fibra
## N: 24
##
## Fibra
## ----------------- --------
## Mean 112.29
## Std.Dev 3.38
## Min 108.00
## Q1 110.00
## Median 111.50
## Q3 114.50
## Max 120.00
## MAD 3.71
## IQR 4.25
## CV 0.03
## Skewness 0.69
## SE.Skewness 0.47
## Kurtosis -0.60
## N.Valid 24.00
## Pct.Valid 100.00
# Imprimir los resultados descriptivos
print(resultados_descriptivos)
## Descriptive Statistics
## ejercicio2$Fibra
## N: 24
##
## Fibra
## ----------------- --------
## Mean 112.29
## Std.Dev 3.38
## Min 108.00
## Q1 110.00
## Median 111.50
## Q3 114.50
## Max 120.00
## MAD 3.71
## IQR 4.25
## CV 0.03
## Skewness 0.69
## SE.Skewness 0.47
## Kurtosis -0.60
## N.Valid 24.00
## Pct.Valid 100.00
En cuanto a la variable “Fibra,” se observa que tiene una media de 112.29, con una desviación estándar de 3.38, lo que indica que los valores tienden a estar cercanos a la media. Los valores mínimo y máximo son 108.00 y 120.00, respectivamente, con un rango intercuartílico (IQR) de 4.25. El coeficiente de variación (CV) es bajo, con un valor del 0.03, lo que sugiere una baja variabilidad relativa en los datos. La distribución de la variable parece ligeramente sesgada hacia la derecha, ya que el valor de skewness es 0.69, y la curtosis es negativa (-0.60), lo que indica una distribución de colas ligeramente más finas que una distribución normal. Se tienen 24 observaciones válidas en esta variable. En resumen, la variable “Fibra” presenta una distribución con baja variabilidad y cierto sesgo hacia la derecha en sus valores.
resultados_descriptivos <- aggregate(Fibra ~ Operario + Maquina + Operario: Maquina, data = ejercicio2, summary)
print(resultados_descriptivos)
## Operario Maquina Fibra.Min. Fibra.1st Qu. Fibra.Median Fibra.Mean
## 1 1 A 109.00 109.25 109.50 109.50
## 2 2 A 110.00 110.50 111.00 111.00
## 3 3 A 114.00 114.50 115.00 115.00
## 4 1 B 110.00 111.25 112.50 112.50
## 5 2 B 110.00 110.25 110.50 110.50
## 6 3 B 112.00 112.75 113.50 113.50
## 7 1 C 108.00 108.25 108.50 108.50
## 8 2 C 109.00 109.50 110.00 110.00
## 9 3 C 114.00 115.25 116.50 116.50
## 10 1 D 108.00 108.50 109.00 109.00
## 11 2 D 112.00 112.50 113.00 113.00
## 12 3 D 117.00 117.75 118.50 118.50
## Fibra.3rd Qu. Fibra.Max.
## 1 109.75 110.00
## 2 111.50 112.00
## 3 115.50 116.00
## 4 113.75 115.00
## 5 110.75 111.00
## 6 114.25 115.00
## 7 108.75 109.00
## 8 110.50 111.00
## 9 117.75 119.00
## 10 109.50 110.00
## 11 113.50 114.00
## 12 119.25 120.00
Para los diferentes operarios y máquinas, se observan promedios de resistencia de fibras distintos, lo que indica variabilidad en el proceso. Por ejemplo, para el operario OP1 y la máquina A, el promedio de resistencia es de 109.50, con un rango entre 109.00 y 110.00. Para el operario OP2 y la misma máquina, el promedio es de 111.00, con un rango de 110.00 a 112.00. Esto se repite para cada combinación de operario y máquina, mostrando diferencias en la resistencia promedio y el rango de valores. Estas diferencias sugieren que tanto el operario como el tipo de máquina pueden influir en la resistencia de las fibras.
ANOVA Factor 1 α: Operario \(H_0:No existen diferencias significativas entre la resistencia de las fibras entre los operarios que realizan el trabajo\) \(H_a: Existen diferencias significativas en la resistencia media de la fibra en función del operario que lleva a cabo el trabajo\) \(H_0:α1=α2=...=αa=0\) \(H_a:α1≠0 para algún i\) Factor 2 β: Maquina \(H_0:No existen diferencias significativas en la resistencia promedio de las fibras en relacion a la maquina utilizada.\) \(H_a: Existen diferencias significativas en la resistencia promedio de las fibras en relacion a el tipo de máquina empleada\) \(H_0:β1=β2=...=βb=0\) \(H_a:βj≠0 para algún j\) Interacción \(H_0:No existe interacción significativa entre el operario y la maquina en cuanto a la resistencia de la fibra\) \(H_a: Existen interacción significativas entre el operario y la maquina en cuanto a la resistencia de la fibra\) \(H_0:(αβ)ij=0 para todo ij\) \(H_a:(αβ)ij≠0 para algún ij\)
modelo_anova <- aov(Fibra ~ Operario * Maquina, data = ejercicio2)
resultado_anova <- summary(modelo_anova)
print(resultado_anova)
## Df Sum Sq Mean Sq F value Pr(>F)
## Operario 1 144.00 144.00 35.446 2.02e-05 ***
## Maquina 3 12.46 4.15 1.022 0.4089
## Operario:Maquina 3 41.50 13.83 3.405 0.0434 *
## Residuals 16 65.00 4.06
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Existen diferencias significativas en la resistencia de las fibras debido al operario que lleva a cabo el trabajo, con un valor de F significativo (F = 35.446) y un p-valor muy bajo (p < 0.001). Sin embargo, en cuanto al tipo de máquina utilizada, no se encontraron diferencias significativas, ya que el valor de F no es significativo (F = 1.022) y el p-valor es relativamente alto (p = 0.4089). Además, la interacción entre el operario y la máquina también muestra diferencias significativas, con un valor de F significativo (F = 3.405) y un p-valor de 0.0434, lo que indica que la combinación de operario y máquina influye en la resistencia de las fibras.
DIAGRAMA DE CAJAS Y BIGOTES
boxplot(ejercicio2$Fibra ~ ejercicio2$Operario * ejercicio2$Maquina,
main = "Diagrama de Cajas de Resistencia",
xlab = "Combinación de operario y tipo de máquina",
ylab = "Resistencia",
col = c("green", "blue", "cyan","darkblue","pink","purple", "yellow","magenta", "orange","brown", "white","lightgray"))
PRUEBAS DE RANGO MULTIPLE LSD
modelo_anova <- aov(Fibra ~ Operario * Maquina, data = ejercicio2)
LSD_result <- TukeyHSD(modelo_anova)
## Warning in replications(paste("~", xx), data = mf): non-factors ignored:
## Operario
## Warning in replications(paste("~", xx), data = mf): non-factors ignored:
## Operario, Maquina
## Warning in TukeyHSD.aov(modelo_anova): 'which' specified some non-factors which
## will be dropped
print(LSD_result)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Fibra ~ Operario * Maquina, data = ejercicio2)
##
## $Maquina
## diff lwr upr p adj
## B-A 0.3333333 -2.995997 3.662664 0.9914845
## C-A -0.1666667 -3.495997 3.162664 0.9989062
## D-A 1.6666667 -1.662664 4.995997 0.4985833
## C-B -0.5000000 -3.829331 2.829331 0.9725181
## D-B 1.3333333 -1.995997 4.662664 0.6677421
## D-C 1.8333333 -1.495997 5.162664 0.4191829
Se indica que no existen diferencias significativas en la resistencia promedio de las fibras entre las máquinas A, B y C, ya que los intervalos de confianza para las diferencias entre sus medias incluyen el valor cero, y los valores ajustados (p-adj) son mayores que el nivel de significancia 0.05. Sin embargo, las diferencias entre la máquina D y las otras máquinas (A, B y C) son significativas, ya que el intervalo de confianza no incluye cero y los valores ajustados (p-adj) son menores que 0.05. De este modo, la máquina D muestra diferencias significativas en la resistencia de las fibras en comparación con las máquinas A, B y C, pero no hay diferencias significativas entre estas últimas.
METODO DE TUKEY
resultado_tukey <- TukeyHSD(modelo_anova)
## Warning in replications(paste("~", xx), data = mf): non-factors ignored:
## Operario
## Warning in replications(paste("~", xx), data = mf): non-factors ignored:
## Operario, Maquina
## Warning in TukeyHSD.aov(modelo_anova): 'which' specified some non-factors which
## will be dropped
print(resultado_tukey)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Fibra ~ Operario * Maquina, data = ejercicio2)
##
## $Maquina
## diff lwr upr p adj
## B-A 0.3333333 -2.995997 3.662664 0.9914845
## C-A -0.1666667 -3.495997 3.162664 0.9989062
## D-A 1.6666667 -1.662664 4.995997 0.4985833
## C-B -0.5000000 -3.829331 2.829331 0.9725181
## D-B 1.3333333 -1.995997 4.662664 0.6677421
## D-C 1.8333333 -1.495997 5.162664 0.4191829
plot(resultado_tukey)
Los resultados anteriores son respaldados y visualmente confirmados
mediante un gráfico que representa las diferencias entre las medias,
incluyendo sus respectivos intervalos de confianza, en la interacción
entre el operario y el tipo de máquina. Esta representación gráfica
permite una observación más detallada de cómo las diferentes
combinaciones de operarios y tipos de máquinas afectan la resistencia
promedio de las fibras. Al examinar las barras de error en el gráfico,
es evidente que algunas de las combinaciones presentan diferencias
significativas en sus medias, mientras que otras no muestran una
variación sustancial. Esta visualización aporta una comprensión más
profunda de la influencia conjunta de ambos factores en la resistencia
de las fibras, confirmando así la significancia de la interacción entre
operario y tipo de máquina en los resultados obtenidos.
SUPUESTOS DEL MODELO Distribución normal de los residuos
residuos<-residuals(modelo_anova)
par(mfrow=c(1,3))
# Gráfico Q-Q de los residuos
qqnorm(residuos, col = "blue", main = "Gráfico Q-Q de Residuos")
qqline(residuos, col = "black")
# Curva de densidad de los residuos
densidad_residuos <- density(residuos)
plot(densidad_residuos, main = "Curva de Densidad de Residuos", xlab = "Residuos", col = "skyblue")
polygon(densidad_residuos, col = "pink", border = "black")
# Boxplot de residuos
boxplot(residuos, col = "violet",
main = "Boxplot de Residuos",
xlab = "Combinación de Operario y máquina",
ylab = "Residuos")
Como se puede observar los residuos cuentan con una distribución normal
ya que las pruebas tienen una distribución homogenea.
SHAPIRO WILK \(H_0:LOs residuos de la variable fibra se distribuyen normalmente, con media cero y varianza\) \(H_a:Los residuos de la variable fibra no siguen una distribución normal\)
shapiro.test(residuals(modelo_anova))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_anova)
## W = 0.957, p-value = 0.3812
Se muestra que el valor de W es igual a 0.957, y el valor de p es 0.3812. Esto indica que los residuos no presentan evidencia significativa en contra de la hipótesis nula de que siguen una distribución normal.
HOMOGENEIDAD DE VARIANZAS
# Boxplot de los residuos
boxplot(residuos ~ ejercicio2$Operario:ejercicio2$Maquina,
col = "violet",
xlab = "Combinación de operario y máquina",
ylab = "Residuos",
main = "Boxplot de Residuos por Combinación de operario y máquina")
PRUEBA DE INDEPENDENCIA
color_palette <- colorRampPalette(c("pink", "black", "pink"))
plot(residuos, main = "Prueba de independencia", pch = 20, cex = 2, col = color_palette(120), ylab = "Residuos", xlab = " ")
En el gráfico previo, se puede observar que los puntos están dispersos de manera irregular y no muestran un patrón definido, lo que sugiere que la variabilidad de los datos es similar en todas las categorías. Esto respalda la presunción de homogeneidad de varianzas en el análisis estadístico.
BARLETT \(H_0: La varianza es constante en todos los grupos\) \(H_a: La varianza no es constante por lo menos en un grupo\)
grupos <- with(ejercicio2, interaction(Operario, Maquina))
# Prueba de Bartlett
resultado_bartlett <- bartlett.test(residuals(modelo_anova), grupos)
print("Prueba de Bartlett:")
## [1] "Prueba de Bartlett:"
print(resultado_bartlett)
##
## Bartlett test of homogeneity of variances
##
## data: residuals(modelo_anova) and grupos
## Bartlett's K-squared = 4.8106, df = 11, p-value = 0.94
Se indica que el valor de la estadística de prueba K-cuadrado es igual a 4.8106, con 11 grados de libertad y un valor p (p-value) de 0.94. Dado que el valor p es mayor que el nivel de significancia usual (0.05), no hay evidencia suficiente para rechazar la hipótesis nula de homogeneidad de varianzas.
INDEPENDENCIA DE LOS RESIDUOS DURBIN WATSON \(H_0: Los residuos entre tratamientos son independientes\) \(H_a: Los residuos entre tratamientos no son independientes\)
library(lmtest)
modelo_anova <- aov(Fibra ~ Operario * Maquina, data = ejercicio2)
# Realiza la prueba de Durbin-Watson en los residuos
resultado_durbin_watson <- dwtest(modelo_anova)
print(resultado_durbin_watson)
##
## Durbin-Watson test
##
## data: modelo_anova
## DW = 2.3169, p-value = 0.3718
## alternative hypothesis: true autocorrelation is greater than 0
Dado que el valor p es mayor que 0.05 (nivel de significancia usual), no hay evidencia suficiente para rechazar la hipótesis nula. En otras palabras, no se encontraron indicios de autocorrelación positiva en los residuos del modelo, lo que respalda la independencia de los datos.
MODELO LINEAL
require(faraway)
data("ejercicio2")
## Warning in data("ejercicio2"): data set 'ejercicio2' not found
rabbit
## treat gain block
## 1 f 42.2 b1
## 2 b 32.6 b1
## 3 c 35.2 b1
## 4 c 40.9 b2
## 5 a 40.1 b2
## 6 b 38.1 b2
## 7 c 34.6 b3
## 8 f 34.3 b3
## 9 d 37.5 b3
## 10 a 44.9 b4
## 11 e 40.8 b4
## 12 c 43.9 b4
## 13 e 32.0 b5
## 14 c 40.9 b5
## 15 d 37.3 b5
## 16 b 37.3 b6
## 17 f 42.8 b6
## 18 e 40.5 b6
## 19 d 37.9 b7
## 20 a 45.2 b7
## 21 b 40.6 b7
## 22 a 44.0 b8
## 23 e 38.5 b8
## 24 f 51.9 b8
## 25 d 27.5 b9
## 26 b 30.6 b9
## 27 e 20.6 b9
## 28 f 41.7 b10
## 29 d 42.3 b10
## 30 a 37.3 b10
require(table1)
table1(~Fibra|Maquina,data=ejercicio2)
| A (N=6) |
B (N=6) |
C (N=6) |
D (N=6) |
Overall (N=24) |
|
|---|---|---|---|---|---|
| Fibra | |||||
| Mean (SD) | 112 (2.71) | 112 (2.32) | 112 (4.18) | 114 (4.46) | 112 (3.38) |
| Median [Min, Max] | 111 [109, 116] | 112 [110, 115] | 110 [108, 119] | 113 [108, 120] | 112 [108, 120] |
#modelo lineal (para diseño de experimentos)
mod1=lm(Fibra~Maquina+Operario,data=ejercicio2)
anova(mod1)
## Analysis of Variance Table
##
## Response: Fibra
## Df Sum Sq Mean Sq F value Pr(>F)
## Maquina 3 12.458 4.153 0.7409 0.5408
## Operario 1 144.000 144.000 25.6901 6.823e-05 ***
## Residuals 19 106.500 5.605
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
se observa que el promedio de resistencia de la fibra en los grupos A, B, C y D es de 112 (SD=2.71), 112 (SD=2.32), 112 (SD=4.18) y 114 (SD=4.46), respectivamente. Además, se proporciona la mediana junto con el rango de valores mínimo y máximo para cada grupo, lo que muestra que las resistencias varían dentro de estos rangos: Grupo A (109-116), Grupo B (110-115), Grupo C (108-119) y Grupo D (108-120). En general, la media de resistencia de la fibra para las 24 observaciones es de 112 (SD=3.38), y los valores oscilan en el rango de 108 a 120.
#posanova
require(agricolae)
compara1=LSD.test(mod1,"Fibra")
compara1
## $statistics
## MSerror Df Mean CV
## 5.605263 19 112.2917 2.108388
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Fibra 11 0.05
##
## $means
## Fibra std r se LCL UCL Min Max Q25 Q50 Q75
## 108 108 0 2 1.674106 104.4961 111.5039 108 108 108 108 108
## 109 109 0 3 1.366902 106.1390 111.8610 109 109 109 109 109
## 110 110 0 5 1.058798 107.7839 112.2161 110 110 110 110 110
## 111 111 0 2 1.674106 107.4961 114.5039 111 111 111 111 111
## 112 112 0 3 1.366902 109.1390 114.8610 112 112 112 112 112
## 114 114 0 3 1.366902 111.1390 116.8610 114 114 114 114 114
## 115 115 0 2 1.674106 111.4961 118.5039 115 115 115 115 115
## 116 116 NA 1 2.367544 111.0447 120.9553 116 116 116 116 116
## 117 117 NA 1 2.367544 112.0447 121.9553 117 117 117 117 117
## 119 119 NA 1 2.367544 114.0447 123.9553 119 119 119 119 119
## 120 120 NA 1 2.367544 115.0447 124.9553 120 120 120 120 120
##
## $comparison
## NULL
##
## $groups
## Fibra groups
## 120 120 a
## 119 119 ab
## 117 117 abc
## 116 116 abc
## 115 115 abc
## 114 114 bc
## 112 112 cd
## 111 111 cd
## 110 110 d
## 109 109 d
## 108 108 d
##
## attr(,"class")
## [1] "group"
Se observaron diferencias significativas en la resistencia de la fibra entre los diferentes niveles de “Fibra,” y se identificaron grupos de niveles con resistencias similares.
#validar los supuestos
#P1 - normalidad
plot(mod1)
shapiro.test(mod1$residuals)
##
## Shapiro-Wilk normality test
##
## data: mod1$residuals
## W = 0.91097, p-value = 0.03703
#en la prueba de shapiro la hipotesis es normalidad
#si el valor p es mayor al 5% (0.05) no rechazo la normalidad
#P2 - homogeneidad de varianza
plot(mod1)
# tipos de variables
str(ejercicio2)
## tibble [24 × 3] (S3: tbl_df/tbl/data.frame)
## $ Operario: num [1:24] 1 1 1 1 1 1 1 1 2 2 ...
## $ Maquina : chr [1:24] "A" "A" "B" "B" ...
## $ Fibra : num [1:24] 109 110 110 115 108 109 110 108 110 112 ...
#Generar tablas con los descriptivos
table1(~Fibra|Maquina,data=ejercicio2)
| A (N=6) |
B (N=6) |
C (N=6) |
D (N=6) |
Overall (N=24) |
|
|---|---|---|---|---|---|
| Fibra | |||||
| Mean (SD) | 112 (2.71) | 112 (2.32) | 112 (4.18) | 114 (4.46) | 112 (3.38) |
| Median [Min, Max] | 111 [109, 116] | 112 [110, 115] | 110 [108, 119] | 113 [108, 120] | 112 [108, 120] |
table1(~Fibra|Operario,data=ejercicio2)
## Warning in table1.formula(~Fibra | Operario, data = ejercicio2): Terms to the
## right of '|' in formula 'x' define table columns and are expected to be factors
## with meaningful labels.
| 1 (N=8) |
2 (N=8) |
3 (N=8) |
Overall (N=24) |
|
|---|---|---|---|---|
| Fibra | ||||
| Mean (SD) | 110 (2.23) | 111 (1.55) | 116 (2.70) | 112 (3.38) |
| Median [Min, Max] | 110 [108, 115] | 111 [109, 114] | 116 [112, 120] | 112 [108, 120] |
Estos resultados indican diferencias en la resistencia de la fibra entre los grupos “1,” “2,” y “3,” con el Grupo “3” siendo el que muestra la resistencia promedio más alta.
require(ggplot2)
ggplot(ejercicio2,aes(x=Fibra,y=Maquina))+geom_point()+
geom_smooth()+theme_classic()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 108.97
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 3.035
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.3276e-17
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 108.97
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 3.035
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 2.3276e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 4
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 109.97
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.025
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 5.0169e-17
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 16.201
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 109.97
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 2.025
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 5.0169e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 16.201
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 107.94
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 3.055
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.3026e-17
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 107.94
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 3.055
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 2.3026e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 4
ejercicio2$Fibra_factor=as.factor(ejercicio2$Fibra)
ejercicio2$Fibra_factor
## [1] 109 110 110 115 108 109 110 108 110 112 110 111 111 109 114 112 116 114 112
## [20] 115 114 119 120 117
## Levels: 108 109 110 111 112 114 115 116 117 119 120
mod1=lm(Fibra~Maquina+Operario,data=ejercicio2)
anova(mod1)
## Analysis of Variance Table
##
## Response: Fibra
## Df Sum Sq Mean Sq F value Pr(>F)
## Maquina 3 12.458 4.153 0.7409 0.5408
## Operario 1 144.000 144.000 25.6901 6.823e-05 ***
## Residuals 19 106.500 5.605
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
El factor “Operario” muestra una significativa influencia en la variabilidad, ya que tiene un valor de p (Pr(>F)) muy bajo (6.823e-05), indicando que es altamente significativo. Por otro lado, el factor “Maquina” no muestra una influencia significativa en la variabilidad, ya que su valor de p es considerablemente alto (0.5408). Estos resultados sugieren que el “Operario” tiene un impacto significativo en la resistencia de la fibra, mientras que el tipo de “Maquina” no tiene un efecto importante.
##efecto tipo interación
require(ggplot2)
ggplot(ejercicio2,aes(x=Fibra,y=Maquina,colour=Operario))+geom_point()+
geom_smooth()+theme_classic()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 108.97
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 3.035
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.3276e-17
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 108.97
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 3.035
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 2.3276e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 4
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 109.97
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 2.025
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 5.0169e-17
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 16.201
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 109.97
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 2.025
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 5.0169e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 16.201
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 107.94
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 3.055
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 2.3026e-17
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 4
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 107.94
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 3.055
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 2.3026e-17
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 4
## Warning: The following aesthetics were dropped during statistical transformation: colour
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
#modelo de diseño
mod3=lm(Fibra~Maquina+Operario,data=ejercicio2)
anova(mod3)
## Analysis of Variance Table
##
## Response: Fibra
## Df Sum Sq Mean Sq F value Pr(>F)
## Maquina 3 12.458 4.153 0.7409 0.5408
## Operario 1 144.000 144.000 25.6901 6.823e-05 ***
## Residuals 19 106.500 5.605
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Se muestra que el factor “Maquina” no tiene un impacto significativo en la variabilidad de la resistencia de la fibra, ya que su valor de p (Pr(>F)) es alto (0.5408). En contraste, el factor “Operario” tiene un efecto altamente significativo en la variabilidad de la resistencia, ya que su valor de p es muy bajo (6.823e-05), lo que indica que es un factor relevante. Estos resultados sugieren que el “Operario” es un factor importante en la determinación de la resistencia de la fibra, mientras que el tipo de “Maquina” no tiene un efecto significativo.
#posanova
compara3=LSD.test(mod3,list("Fibra","Maquina"))
compara3
## $statistics
## MSerror Df Mean CV
## 5.605263 19 112.2917 2.108388
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Fibra:Maquina 20 0.05
##
## $means
## Fibra std r se LCL UCL Min Max Q25 Q50 Q75
## 108:C 108 NA 1 2.367544 103.0447 112.9553 108 108 108 108 108
## 108:D 108 NA 1 2.367544 103.0447 112.9553 108 108 108 108 108
## 109:A 109 NA 1 2.367544 104.0447 113.9553 109 109 109 109 109
## 109:C 109 0 2 1.674106 105.4961 112.5039 109 109 109 109 109
## 110:A 110 0 2 1.674106 106.4961 113.5039 110 110 110 110 110
## 110:B 110 0 2 1.674106 106.4961 113.5039 110 110 110 110 110
## 110:D 110 NA 1 2.367544 105.0447 114.9553 110 110 110 110 110
## 111:B 111 NA 1 2.367544 106.0447 115.9553 111 111 111 111 111
## 111:C 111 NA 1 2.367544 106.0447 115.9553 111 111 111 111 111
## 112:A 112 NA 1 2.367544 107.0447 116.9553 112 112 112 112 112
## 112:B 112 NA 1 2.367544 107.0447 116.9553 112 112 112 112 112
## 112:D 112 NA 1 2.367544 107.0447 116.9553 112 112 112 112 112
## 114:A 114 NA 1 2.367544 109.0447 118.9553 114 114 114 114 114
## 114:C 114 NA 1 2.367544 109.0447 118.9553 114 114 114 114 114
## 114:D 114 NA 1 2.367544 109.0447 118.9553 114 114 114 114 114
## 115:B 115 0 2 1.674106 111.4961 118.5039 115 115 115 115 115
## 116:A 116 NA 1 2.367544 111.0447 120.9553 116 116 116 116 116
## 117:D 117 NA 1 2.367544 112.0447 121.9553 117 117 117 117 117
## 119:C 119 NA 1 2.367544 114.0447 123.9553 119 119 119 119 119
## 120:D 120 NA 1 2.367544 115.0447 124.9553 120 120 120 120 120
##
## $comparison
## NULL
##
## $groups
## Fibra groups
## 120:D 120 a
## 119:C 119 ab
## 117:D 117 abc
## 116:A 116 abcd
## 115:B 115 abcd
## 114:A 114 abcde
## 114:C 114 abcde
## 114:D 114 abcde
## 112:A 112 bcde
## 112:B 112 bcde
## 112:D 112 bcde
## 111:B 111 cde
## 111:C 111 cde
## 110:A 110 de
## 110:B 110 de
## 110:D 110 de
## 109:A 109 de
## 109:C 109 e
## 108:C 108 e
## 108:D 108 e
##
## attr(,"class")
## [1] "group"
El análisis estadístico de la variable “Fibra” en relación con el factor “Maquina” indica que no existen diferencias significativas en la resistencia promedio de las fibras debido al tipo de máquina utilizada. Las medias y los intervalos de confianza para cada nivel de la máquina se superponen considerablemente. Por lo tanto, no se puede concluir que el tipo de máquina tenga un efecto significativo en la resistencia de la fibra.
EJERCICIO 3
Se desea investigar de qué manera afecta el tiempo de curado y el tipo de acelerante a la resistencia del caucho vulcanizado.
ejercicio3=read_excel("D:/Usuario/Desktop/exp/dosfact3.xlsx")
ejercicio3#paravisualizar1dosfact
## # A tibble: 18 × 3
## Curado Acelerante Resistencia
## <dbl> <chr> <dbl>
## 1 40 A 3900
## 2 40 A 3600
## 3 40 B 4300
## 4 40 B 3700
## 5 40 C 3700
## 6 40 C 4100
## 7 60 A 4100
## 8 60 A 3500
## 9 60 B 4200
## 10 60 B 3900
## 11 60 C 3900
## 12 60 C 4000
## 13 80 A 4000
## 14 80 A 3800
## 15 80 B 4300
## 16 80 B 3600
## 17 80 C 3600
## 18 80 C 3800
conteo_valores_tratamiento <- table(ejercicio3$Resistencia, ejercicio3$Acelerante)
print("Número de observaciones (réplicas) por tratamiento:")
## [1] "Número de observaciones (réplicas) por tratamiento:"
print(conteo_valores_tratamiento)
##
## A B C
## 3500 1 0 0
## 3600 1 1 1
## 3700 0 1 1
## 3800 1 0 1
## 3900 1 1 1
## 4000 1 0 1
## 4100 1 0 1
## 4200 0 1 0
## 4300 0 2 0
# Calcular estadísticas descriptivas por categoría
resultados_descriptivos <- summarytools::descr(ejercicio3$Resistencia)
print(resultados_descriptivos)
## Descriptive Statistics
## ejercicio3$Resistencia
## N: 18
##
## Resistencia
## ----------------- -------------
## Mean 3888.89
## Std.Dev 247.07
## Min 3500.00
## Q1 3700.00
## Median 3900.00
## Q3 4100.00
## Max 4300.00
## MAD 296.52
## IQR 375.00
## CV 0.06
## Skewness 0.16
## SE.Skewness 0.54
## Kurtosis -1.25
## N.Valid 18.00
## Pct.Valid 100.00
# Imprimir los resultados descriptivos
print(resultados_descriptivos)
## Descriptive Statistics
## ejercicio3$Resistencia
## N: 18
##
## Resistencia
## ----------------- -------------
## Mean 3888.89
## Std.Dev 247.07
## Min 3500.00
## Q1 3700.00
## Median 3900.00
## Q3 4100.00
## Max 4300.00
## MAD 296.52
## IQR 375.00
## CV 0.06
## Skewness 0.16
## SE.Skewness 0.54
## Kurtosis -1.25
## N.Valid 18.00
## Pct.Valid 100.00
Los datos de resistencia tienen un promedio de 3888.89 con una desviación estándar de 247.07. La resistencia varía desde 3500.00 hasta 4300.00, con un rango intercuartil de 375.00. Los datos muestran una ligera asimetría positiva y una distribución aplanada en comparación con una distribución normal. Hay 18 observaciones válidas, abarcando el 100% de los datos.
Medidas descriptivas
resultados_descriptivos <- aggregate(Resistencia ~ Acelerante + Curado + Resistencia:Acelerante, data = ejercicio3, summary)
print(resultados_descriptivos)
## Acelerante Curado Resistencia.Min. Resistencia.1st Qu. Resistencia.Median
## 1 A 40 3600 3675 3750
## 2 B 40 3700 3850 4000
## 3 C 40 3700 3800 3900
## 4 A 60 3500 3650 3800
## 5 B 60 3900 3975 4050
## 6 C 60 3900 3925 3950
## 7 A 80 3800 3850 3900
## 8 B 80 3600 3775 3950
## 9 C 80 3600 3650 3700
## Resistencia.Mean Resistencia.3rd Qu. Resistencia.Max.
## 1 3750 3825 3900
## 2 4000 4150 4300
## 3 3900 4000 4100
## 4 3800 3950 4100
## 5 4050 4125 4200
## 6 3950 3975 4000
## 7 3900 3950 4000
## 8 3950 4125 4300
## 9 3700 3750 3800
El análisis descriptivo de los tratamientos muestra que la resistencia promedio de las muestras varía según el tiempo y el tipo de acelerante utilizado. Por ejemplo, para el tiempo (T1) con el acelerante A, la resistencia promedio es de 3750, mientras que para el tiempo (T3) con el acelerante B, la resistencia promedio es de 3950. Los valores mínimos y máximos también difieren entre los tratamientos, lo que indica variabilidad en la resistencia. Estos resultados son fundamentales para comprender cómo cada tratamiento afecta la resistencia del material y proporcionan información valiosa para la toma de decisiones en el proceso.
ANOVA Factor 1 α: Resistencia \(H_0:No existen diferencias significativas en la resistencia entre los tipos de curado\) \(H_a: Existen diferencias significativas en la resistencia entre los tipos de curado\) \(H_0:α1=α2=...=αa=0\) \(H_a:α1≠0 para algún i\) Factor 2 β: Acelerante \(H_0:No existen diferencias significativas en la resistencia en los distintos acelerantes\) \(H_a: Existen diferencias significativas en la resistencia en los distintos acelerante especies de plantas\) \(H_0:β1=β2=...=βb=0\) \(H_a:βj≠0 para algún j\) Interacción \(H_0:No existe interacción significativa entre el curado y el acelerante con relacion a la resistencia\) \(H_a: Existen interacción significativas entre el curado y el acelerante con relacion a la resistenciar\) \(H_0:(αβ)ij=0 para todo ij\) \(H_a:(αβ)ij≠0 para algún ij\)
modelo_anova <- aov(Resistencia ~ Curado * Acelerante, data = ejercicio3)
resultado_anova <- summary(modelo_anova)
print(resultado_anova)
## Df Sum Sq Mean Sq F value Pr(>F)
## Curado 1 3333 3333 0.047 0.833
## Acelerante 2 114444 57222 0.800 0.472
## Curado:Acelerante 2 61667 30833 0.431 0.659
## Residuals 12 858333 71528
Se muestra que en este estudio, los factores “Curado” y “Acelerante” y su interacción “Curado:Acelerante” no tienen un efecto significativo en la resistencia de las muestras, ya que los valores de F y los correspondientes valores de p indican que no hay diferencias significativas entre los grupos. Esto sugiere que la resistencia de las muestras no depende de estas variables o su interacción en este contexto específico.
DIAGRAMA DE CAJAS Y BIGOTES
boxplot(ejercicio3$Resistencia ~ ejercicio3$Acelerante * ejercicio3$Curado,
main = "Diagrama de Cajas de Resistencia",
xlab = "Combinación de tiempo y tipo de acelerante",
ylab = "Resistencia",
col = c("green", "violet", "cyan","blue","pink","purple", "yellow","magenta", "orange","brown", "red","gray"))
Se evidencia que no se observan diferencias notables en la resistencia
del caucho en relación al tiempo de curado y al tipo de acelerante
utilizado. Las líneas medianas y las distribuciones de los distintos
grupos muestran similitudes, y se aprecia cierto grado de superposición
entre los valores.
PRUEBAS POST HOC LSD
modelo_anova <- aov(Resistencia ~ Curado * Acelerante, data = ejercicio3)
LSD_result <- TukeyHSD(modelo_anova)
## Warning in replications(paste("~", xx), data = mf): non-factors ignored: Curado
## Warning in replications(paste("~", xx), data = mf): non-factors ignored:
## Curado, Acelerante
## Warning in TukeyHSD.aov(modelo_anova): 'which' specified some non-factors which
## will be dropped
print(LSD_result)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Resistencia ~ Curado * Acelerante, data = ejercicio3)
##
## $Acelerante
## diff lwr upr p adj
## B-A 183.33333 -228.6127 595.2794 0.4825048
## C-A 33.33333 -378.6127 445.2794 0.9746906
## C-B -150.00000 -561.9461 261.9461 0.6077817
El análisis de comparaciones múltiples de medias de Tukey con un nivel de confianza del 95% no revela diferencias significativas en la resistencia del caucho entre los diferentes tipos de acelerantes (A, B y C). Las diferencias entre los grupos no son estadísticamente significativas, ya que los valores “p adj” son todos mayores que el nivel de significancia establecido (0.05).
TUKEY
resultado_tukey <- TukeyHSD(modelo_anova)
## Warning in replications(paste("~", xx), data = mf): non-factors ignored: Curado
## Warning in replications(paste("~", xx), data = mf): non-factors ignored:
## Curado, Acelerante
## Warning in TukeyHSD.aov(modelo_anova): 'which' specified some non-factors which
## will be dropped
print(resultado_tukey)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Resistencia ~ Curado * Acelerante, data = ejercicio3)
##
## $Acelerante
## diff lwr upr p adj
## B-A 183.33333 -228.6127 595.2794 0.4825048
## C-A 33.33333 -378.6127 445.2794 0.9746906
## C-B -150.00000 -561.9461 261.9461 0.6077817
plot(resultado_tukey)
Esto sugiere que el tipo de acelerante utilizado no tiene un impacto significativo en la resistencia del caucho vulcanizado en este estudio.
SUPUESTOS DEL MODELO Distribución normal
residuos<-residuals(modelo_anova)
par(mfrow=c(1,3))
# Gráfico Q-Q de los residuos
qqnorm(residuos, col = "black", main = "Gráfico Q-Q de Residuos")
qqline(residuos, col = "black")
# Curva de densidad de los residuos
densidad_residuos <- density(residuos)
plot(densidad_residuos, main = "Curva de Densidad de Residuos", xlab = "Residuos", col = "blue")
polygon(densidad_residuos, col = "red", border = "black")
# Boxplot de residuos
boxplot(residuos, col = "pink",
main = "Boxplot de Residuos",
xlab = "Combinación de tiempo y acelerante",
ylab = "Residuos")
SHAPIRO WILK
\(H_0:LOs residuos de la variable resistencia se distribuyen normalmente, con media cero y varianza\) \(H_a:Los residuos de la variable resistencia no siguen una distribución normal\)
shapiro.test(residuals(modelo_anova))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_anova)
## W = 0.9369, p-value = 0.2562
Esto indica que los residuos del modelo siguen una distribución aproximadamente normal, ya que el valor p es mayor que el nivel de significancia típico de 0.05. En otras palabras, no hay evidencia suficiente para rechazar la hipótesis nula de normalidad de los residuos.
Homogeneidad de varianzas
# Boxplot de los residuos
boxplot(residuos ~ ejercicio3$Resistencia:ejercicio3$Acelerante,
col = "lightpink",
xlab = "Combinación de tiempo y acelerante",
ylab = "Residuos",
main = "Boxplot de Residuos por Combinación de tiempo y acelerante")
color_palette <- colorRampPalette(c("purple", "black", "purple"))
plot(residuos, main = "Prueba de independencia", pch = 20, cex = 2, col = color_palette(120), ylab = "Residuos", xlab = " ")
PRUEBA DE BARLETT \(H_0: La varianza es constante en todos los grupos\) \(H_a: La varianza no es constante por lo menos en un grupo\)
DURBIN WATSON \(H_0: Los residuos entre tratamientos son independientes\) \(H_a: Los residuos entre tratamientos no son independientes\)
library(lmtest)
modelo_anova <- aov(Resistencia ~ Curado * Acelerante, data = ejercicio3)
# Realiza la prueba de Durbin-Watson en los residuos
resultado_durbin_watson <- dwtest(modelo_anova)
print(resultado_durbin_watson)
##
## Durbin-Watson test
##
## data: modelo_anova
## DW = 2.7407, p-value = 0.7675
## alternative hypothesis: true autocorrelation is greater than 0
Dado que el valor p es 0.7675, que es significativamente mayor que el nivel de significancia comúnmente utilizado de 0.05, no hay evidencia suficiente para rechazar la hipótesis nula. Esto sugiere que no hay autocorrelación positiva significativa en los residuos del modelo, lo que es una suposición importante en la regresión
MODELO LINEAL
require(faraway)
data("ejercicio2")
## Warning in data("ejercicio2"): data set 'ejercicio2' not found
require(table1)
table1(~Resistencia|Acelerante,data=ejercicio3)
| A (N=6) |
B (N=6) |
C (N=6) |
Overall (N=18) |
|
|---|---|---|---|---|
| Resistencia | ||||
| Mean (SD) | 3820 (232) | 4000 (310) | 3850 (187) | 3890 (247) |
| Median [Min, Max] | 3850 [3500, 4100] | 4050 [3600, 4300] | 3850 [3600, 4100] | 3900 [3500, 4300] |
#modelo lineal (para diseño de experimentos)
mod1=lm(Resistencia~Acelerante+Curado,data=ejercicio3)
anova(mod1)
## Analysis of Variance Table
##
## Response: Resistencia
## Df Sum Sq Mean Sq F value Pr(>F)
## Acelerante 2 114444 57222 0.8708 0.4401
## Curado 1 3333 3333 0.0507 0.8251
## Residuals 14 920000 65714
La mediana de la resistencia es similar en los grupos A y C, pero más alta en el grupo B. Se observa cierta variabilidad en los valores de resistencia dentro de cada grupo, como se evidencia en el rango entre los valores mínimos y máximos de resistencia.
#posanova
require(agricolae)
compara1=LSD.test(mod1,"Resistencia")
compara1
## $statistics
## MSerror Df Mean CV
## 65714.29 14 3888.889 6.591805
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Resistencia 9 0.05
##
## $means
## Resistencia std r se LCL UCL Min Max Q25 Q50 Q75
## 3500 3500 NA 1 256.3480 2950.188 4049.812 3500 3500 3500 3500 3500
## 3600 3600 0 3 148.0026 3282.566 3917.434 3600 3600 3600 3600 3600
## 3700 3700 0 2 181.2654 3311.224 4088.776 3700 3700 3700 3700 3700
## 3800 3800 0 2 181.2654 3411.224 4188.776 3800 3800 3800 3800 3800
## 3900 3900 0 3 148.0026 3582.566 4217.434 3900 3900 3900 3900 3900
## 4000 4000 0 2 181.2654 3611.224 4388.776 4000 4000 4000 4000 4000
## 4100 4100 0 2 181.2654 3711.224 4488.776 4100 4100 4100 4100 4100
## 4200 4200 NA 1 256.3480 3650.188 4749.812 4200 4200 4200 4200 4200
## 4300 4300 0 2 181.2654 3911.224 4688.776 4300 4300 4300 4300 4300
##
## $comparison
## NULL
##
## $groups
## Resistencia groups
## 4300 4300 a
## 4200 4200 ab
## 4100 4100 ab
## 4000 4000 ab
## 3900 3900 ab
## 3800 3800 ab
## 3700 3700 b
## 3600 3600 b
## 3500 3500 b
##
## attr(,"class")
## [1] "group"
El grupo con una resistencia de 4300 presenta la resistencia más alta, mientras que los grupos con resistencias de 3500, 3600 y 3700 muestran las resistencias más bajas. La variabilidad en los valores de resistencia se refleja en los rangos entre los valores mínimos y máximos, así como en los cuartiles Q25, Q50 y Q75. Estos grupos se han dividido en dos categorías principales, con los grupos 4300, 4200, 4100, 4000, 3900 y 3800 perteneciendo a una categoría, y los grupos 3700, 3600 y 3500 a otra.
#validar los supuestos
#P1 - normalidad
plot(mod1)
shapiro.test(mod1$residuals)
##
## Shapiro-Wilk normality test
##
## data: mod1$residuals
## W = 0.9285, p-value = 0.1827
#en la prueba de shapiro la hipotesis es normalidad
#si el valor p es mayor al 5% (0.05) no rechazo la normalidad
#P2 - homogeneidad de varianza
plot(mod1)
# tipos de variables
str(ejercicio3)
## tibble [18 × 3] (S3: tbl_df/tbl/data.frame)
## $ Curado : num [1:18] 40 40 40 40 40 40 60 60 60 60 ...
## $ Acelerante : chr [1:18] "A" "A" "B" "B" ...
## $ Resistencia: num [1:18] 3900 3600 4300 3700 3700 4100 4100 3500 4200 3900 ...
#Generar tablas con los descriptivos
table1(~Resistencia|Acelerante,data=ejercicio3)
| A (N=6) |
B (N=6) |
C (N=6) |
Overall (N=18) |
|
|---|---|---|---|---|
| Resistencia | ||||
| Mean (SD) | 3820 (232) | 4000 (310) | 3850 (187) | 3890 (247) |
| Median [Min, Max] | 3850 [3500, 4100] | 4050 [3600, 4300] | 3850 [3600, 4100] | 3900 [3500, 4300] |
table1(~Resistencia|Curado,data=ejercicio3)
## Warning in table1.formula(~Resistencia | Curado, data = ejercicio3): Terms to
## the right of '|' in formula 'x' define table columns and are expected to be
## factors with meaningful labels.
| 40 (N=6) |
60 (N=6) |
80 (N=6) |
Overall (N=18) |
|
|---|---|---|---|---|
| Resistencia | ||||
| Mean (SD) | 3880 (271) | 3930 (242) | 3850 (266) | 3890 (247) |
| Median [Min, Max] | 3800 [3600, 4300] | 3950 [3500, 4200] | 3800 [3600, 4300] | 3900 [3500, 4300] |
require(ggplot2)
ggplot(ejercicio3,aes(x=Resistencia,y=Acelerante))+geom_point()+
geom_smooth()+theme_classic()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 3800
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 200
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 0
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 3800
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius 200
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 0
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : pseudoinverse used at 4303.5
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : neighborhood radius 403.5
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : reciprocal condition number 0
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric = parametric,
## : There are other near singularities as well. 90000
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used at
## 4303.5
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 403.5
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal condition
## number 0
## Warning in predLoess(object$y, object$x, newx = if (is.null(newdata)) object$x
## else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other near
## singularities as well. 90000
## Warning in max(ids, na.rm = TRUE): ningun argumento finito para max; retornando
## -Inf
## Warning in max(ids, na.rm = TRUE): ningun argumento finito para max; retornando
## -Inf
ejercicio3$Resistencia_factor=as.factor(ejercicio3$Resistencia)
ejercicio3$Rresistencia_factor
## Warning: Unknown or uninitialised column: `Rresistencia_factor`.
## NULL