Taller 1_DISENO EXPERIMENTOS
Natalia Deaquiz
2023-05-15
PUNTO 1
library(readxl)
datos1 <- read_excel("~/SEMESTRE 2023-1/DISENO DE EXPERIMENTOS/TALLER DISE_1.xlsx",
sheet = "Hoja1")
print(datos1)## # A tibble: 12 × 3
## Tmp Prs Rep
## <dbl> <dbl> <chr>
## 1 0.88 0.05 I
## 2 0.87 0.05 II
## 3 0.89 0.05 III
## 4 0.92 0.1 I
## 5 0.94 0.1 II
## 6 0.93 0.1 III
## 7 0.95 0.2 I
## 8 0.94 0.2 II
## 9 0.95 0.2 III
## 10 0.98 0.25 I
## 11 0.99 0.25 II
## 12 0.98 0.25 IIIdatos1$Prs = as.factor(datos1$Prs)
datos1$Tmp = as.numeric(datos1$Tmp)
## Se pone esta operación porqué los datos de presión son fijos.
## La variable que se analiza es la ultima que se pone en el arbol#ARBOL DE DECISION
library(collapsibleTree)
collapsibleTreeSummary(datos1,
c('Prs',
'Rep',
'Tmp'),
collapsed = FALSE)summary(datos1)## Tmp Prs Rep
## Min. :0.8700 0.05:3 Length:12
## 1st Qu.:0.9125 0.1 :3 Class :character
## Median :0.9400 0.2 :3 Mode :character
## Mean :0.9350 0.25:3
## 3rd Qu.:0.9575
## Max. :0.9900¿Afecta el nivel de presión hasta la fractura del bloque de madera? Sí afecta, a medida aumenta la presión aumenta el tiempo de fractura del bloque de madera.
#ANALISIS DESCRIPTIVO
library(ggplot2)
ggplot(data = datos1, aes(x = factor(Prs), y = Tmp, fill= Prs)) +
geom_boxplot() +
xlab("Prs") +
ylab("Tmp")
El boxplot nos indica que no hay datos atipicos visibles en los datos.
ggplot(datos1, aes(x = Prs, y = Tmp, fill = Prs))+
geom_col(position = 'dodge') +
xlab ("Prs") +
ylab ("Tmp")
library(ggplot2)En este caso,mayores presiones requieren más tiempo de rupura del bloque de madera. Para elegir el más optimo es necesario tener en consideracion las necesidades del agricultor, puesto que
#Análisis inferencial# #HIPOTESIS ##Comparar las medias de la presion \[H_0:\mu_{p_1}=\mu_{p_2}=\mu_{p_3}=\mu_{p_4}\\\] \[H_a: \mu_{p_1}\neq\mu_{p_2}\neq\mu_{p_3}\neq\mu_{p_4}\] #MODELO DE DISEÑO
\[Y_{ij} = \mu + \varphi_{i} + \epsilon_{ij} \\ \mu : \text{Media global del tiempo } \\ \varphi_{0.5}: \text{Efecto de la presion a 0.5 atm} \\ \varphi_{0.10}: \text{Efecto de la presion a 0.10 atm }\\ \varphi_{0.20}: \text{Efecto de la presion a 0.20 atm }\\ \varphi_{0.25}: \text{Efecto de la presion a 0.25 atm }\\ \epsilon_{ij}: Error \]
#TABLA DEL ANOVA ##Se lee de izquierda a derecha ## Se pone primero el Tmp porque es la variable a analizar ## Tiempo ~ (dado) presión #ifelse pone una condición, si se cumple pone una respuesta sobre eso #Analiza varianzas entre las medias
mod1 = aov(Tmp ~ Prs,
datos1)
sum1<-summary(mod1)
sum1 <- unlist(sum1)
sum1 = sum1[9]
summary(mod1)## Df Sum Sq Mean Sq F value Pr(>F)
## Prs 3 0.016567 0.005522 82.83 2.3e-06 ***
## Residuals 8 0.000533 0.000067
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1ifelse(sum1>0.05, "Ho es verdad","Ha es verdad")## Pr(>F)1
## "Ha es verdad"Se rechaza la hipotesis nula H0,debido a que da una valor >5%, por tanto, se detecta una diferencia estadísticamente significativa entre los grupos mediante el ANOVA, es decir, al menos una se las presiones en la madera influye en el tiempo de fractura.
###REVISIÓN DE SUPUESTOS ##Se revisa la normalidad de residuales #HIPOTESIS \[H_0:\text{Hay normalidad en los residuales}\] \[H_a: \text{NO hay normalidad en los residuales}\]
hist(mod1$residuals)
shp1<-shapiro.test(mod1$residuals)
ifelse(shp1[2]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se cumple el supuesto de normalidad, debido a que los residuales tienen un p-valor >5%, es decir, tienen una distribución normal.
#Homocedasticidad - Varianza homogenea Esta prueba analiza si los datos varian en la misma medida. [3] Posicion en la lista de elementos
#HIPOTESIS \[H_0:\text{Hay igualdad de varianzas en los residuales}\] \[H_a: \text{NO Hay igualdad de varianzas en los residuales}\]
bart1<-bartlett.test(mod1$residuals, datos1$Prs)
ifelse(bart1[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se acepta la H0, debido a que tiene un valor >5%, lo que indicaria que se cumple el supuesto de Homocedasticidad,es decir, no se encuentran diferencias significativas en las varianzas entre las presiones.
#INTERPRETACION BIOLOGICA La presión influye considerablemente en el tiempo de ruptura, teniendo en cuenta que al realizar el analisis de varianza podemos concluir que las media del tiempo para cada presión son diferentes confirmandolo con la prueba de tukey donde se obtuvieron tres agrupaciones (a,b,c) las cuales indican que las presiones de 0.25(a) y 0.05(c) difieren en gran medida en comparacion con las presiones de 0.10 (b) y 0.20 (b). Con la prueba de duncan se identifica que la presion que ejerce mejor efecto es la DE 0.25.
##Comparaciones de medias a posteriori ##Se pone el Prs porque es la variable que agrupa los datos ##Means - Medias de tiempo en cada presión ##Letras significan los niveles de diferencia en los niveles
library(TukeyC)
tt = TukeyC(mod1, 'Prs')
plot(tt)
La presión de 0.20 y 0.10 difieren menos que las presiones de 0.25 y
0.05. Esto quiere decir, que el tiempo que tarda en romperse el bloque
en las presiones 0.20 y 0.10 no difieren en gran medida. En sintesis,
existen diferencias entre todos los efectos de las presiones excepto
entre la 0.20 y 0.10.
#PRUEBA DE MAXIMA DIFERENCIA DE TUKEY
tt1=TukeyHSD(mod1, 'Prs')
par(mar=c(4,6,3,1))
plot(tt1, las=1)
abline(v=0, lty=2, col='red', lwd=2)
Al analizar esta prueba, se establece que las unicas presiones que
muestran diferencias entre si son las 0.2 y 0.1, esto se analiza porque
estan interceptadas por la linea roja.
##p<5%— Si difieren ##p>5%— No difieren
tt1## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Tmp ~ Prs, data = datos1)
##
## $Prs
## diff lwr upr p adj
## 0.1-0.05 0.05000000 0.028650987 0.07134901 0.0003178
## 0.2-0.05 0.06666667 0.045317653 0.08801568 0.0000396
## 0.25-0.05 0.10333333 0.081984320 0.12468235 0.0000014
## 0.2-0.1 0.01666667 -0.004682347 0.03801568 0.1344163
## 0.25-0.1 0.05333333 0.031984320 0.07468235 0.0002012
## 0.25-0.2 0.03666667 0.015317653 0.05801568 0.0025538library(agricolae)
dt1=duncan.test(mod1, 'Prs', console=T)##
## Study: mod1 ~ "Prs"
##
## Duncan's new multiple range test
## for Tmp
##
## Mean Square Error: 6.666667e-05
##
## Prs, means
##
## Tmp std r Min Max
## 0.05 0.8800000 0.010000000 3 0.87 0.89
## 0.1 0.9300000 0.010000000 3 0.92 0.94
## 0.2 0.9466667 0.005773503 3 0.94 0.95
## 0.25 0.9833333 0.005773503 3 0.98 0.99
##
## Alpha: 0.05 ; DF Error: 8
##
## Critical Range
## 2 3 4
## 0.01537336 0.01602049 0.01638221
##
## Means with the same letter are not significantly different.
##
## Tmp groups
## 0.25 0.9833333 a
## 0.2 0.9466667 b
## 0.1 0.9300000 c
## 0.05 0.8800000 dplot(dt1)
Esta prueba indica que la presion 0.25 es mejor que las otras y la peor
presion es la de 0.05.
#PRUEBA DE GRUBBS Mide la ausencia de atipicos #HIPOTESIS \[H_0:\text{NO hay datos atipicos}\] \[H_a: \text{Hay datos atipicos}\]
library(outliers)
grub1<-grubbs.test(mod1$residuals)
ifelse(grub1[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se acepta la H0, debido a que tiene un p-valor >5%, es decir, no se detectaron valores atipicos en los datos.
#CUATRO MODALIDADES DEL ANALISIS DE VARIANZA - Al revisar 1000 permutaciones se confirma que los datos y el modelo mantiene una diferencia de varianzas
#HIPOTESIS ##Comparar las medias de la presion \[H_0:\mu_{p_1}=\mu_{p_2}=\mu_{p_3}=\mu_{p_4}\] \[H_a: \mu_{p_1}\neq\mu_{p_2}\neq\mu_{p_3}\neq\mu_{p_4}\]
library(RVAideMemoire)## *** Package RVAideMemoire v 0.9-82-2 ***##
## Attaching package: 'RVAideMemoire'## The following object is masked from 'package:TukeyC':
##
## cvperm1<-perm.anova(Tmp ~ Prs, data = datos1, nperm = 1000, progress = F)ifelse(perm1[5]>0.05, "Ho es verdad","Ha es verdad")## Pr(>F)
## Prs "Ha es verdad"
## Residuals NASe rechaza la H0, es decir, existe un diferencia estadisticamente significativa en los efectos de las presiones sobre el bloque de madera.
#Análisis de varianza no parametricos CUANDO NO SE CUMPLE EL SUPUESTO DE NORMALIDAD Y HOMOCEDASTICIDAD. ESTA PRUEBA PROMEDIO RANGO ANALIZA LAS MEDIANAS DE LOS GRUPOS HIPOTESIS R = Rangos \[H_0: R_p1 = R_p2 = R_p3 = R_p4\]
krus1<- kruskal.test(datos1$Tmp, datos1$Prs);krus1##
## Kruskal-Wallis rank sum test
##
## data: datos1$Tmp and datos1$Prs
## Kruskal-Wallis chi-squared = 10.274, df = 3, p-value = 0.01637ifelse(krus1[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ha es verdad"Se rechaza la H0 debido a que tiene un p-valor < 5%, es decir, existe una diferencia significativa entre al menos uno las presiones sobre el tiempo de duracion.
PUNTO 2
library(readxl)
datos2 <- read_excel("~/SEMESTRE 2023-1/DISENO DE EXPERIMENTOS/TALLER DISE_1.xlsx",
sheet = "Hoja2")
print(datos2)## # A tibble: 24 × 3
## CAT REND Rep
## <chr> <dbl> <chr>
## 1 A 60 I
## 2 A 63 II
## 3 A 62 III
## 4 A 61 IV
## 5 A 63 V
## 6 A 62 VI
## 7 B 65 I
## 8 B 67 II
## 9 B 70 III
## 10 B 68 IV
## # ℹ 14 more rowsdatos1$CAT = as.factor(datos1$Prs)
datos1$REND = as.numeric(datos1$Tmp) #ARBOL DE DECISION
library(collapsibleTree)
collapsibleTreeSummary(datos2, c('CAT','Rep','REND'),
collapsed = FALSE)summary(datos2)## CAT REND Rep
## Length:24 Min. :58.00 Length:24
## Class :character 1st Qu.:62.00 Class :character
## Mode :character Median :65.00 Mode :character
## Mean :64.71
## 3rd Qu.:67.00
## Max. :73.00¿Tienen los cuatro catalizadores el mismo efecto sobre el rendimiento? No, los catalizadores no tienen el mismo efecto en los rendimientos.
#ANALISIS DESCRIPTIVO
library(ggplot2)
ggplot(data = datos2, aes(x = factor(CAT), y = REND, fill =CAT)) +
geom_boxplot() +
xlab("CAT") +
ylab("REND")
El boxplot nos indica que los catalizadores A y D tienen menores
rendimientos en comparacion con los catalizadores B y C. Siendo el que
tiene mejores rendimientos el catalizador C.
library(ggplot2)
ggplot(datos2, aes(x = CAT, y = REND, fill = CAT))+
geom_col(position = 'dodge') +
xlab ("CAT") +
ylab ("REND")
Esta grafica muestra que el catalizador C tiene mejores rendimientos en
comparacion con los otros catalizadores.
###Analisis inferencial
#HIPOTESIS ##Comparar las medias de los catalizadores. (Se pone asi porque se esta analizando los efectos del CATALIZADOR EN LOS RENDIMIENTOS) \[H_0:\mu_{A}=\mu_{B}=\mu_{C}=\mu_{D}\\\] #MODELO DE DISEÑO \[Y_{ij} = \mu + \tau_{i} + \epsilon_{ij} \\ \mu : \text{Media global del rendimiento } \\ \tau_{A}: \text{Efecto del catalizador A} \\ \tau_{B}: \text{Efecto del catalizador B }\\ \tau_{C}: \text{Efecto del catalizador C }\\ \tau_{D}: \text{Efecto del catalizador D }\\ \epsilon_{ij}: Error \] \[H_a: \mu_{A}\neq\mu_{B}\neq\mu_{C}\neq\mu_{D}\]
#TABLA DEL ANOVA
mod2 = aov(REND ~ CAT,
datos2)
sum2<-summary(mod2)
sum2 <- unlist(sum2)
sum2= sum2[9]
summary(mod2)## Df Sum Sq Mean Sq F value Pr(>F)
## CAT 3 192.5 64.15 14.5 3.01e-05 ***
## Residuals 20 88.5 4.43
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1ifelse(sum2>0.05, "Ho es verdad","Ha es verdad")## Pr(>F)1
## "Ha es verdad"Se rechaza la hipotesis nula H0, dado que, da un valor <5%, por tanto, existe una diferencia estadísticamente significativa entre los grupos mediante el ANOVA, es decir, al menos una se los catalizadores tiene un efecto en el rendimiento.
###REVISIÓN DE SUPUESTOS ##Se revisa la normalidad de residuales
hist(mod2$residuals)
#HIPOTESIS \[H_0:\text{Hay
normalidad en los residuales}\] \[H_a:
\text{NO hay normalidad en los residuales}\]
shp2<-shapiro.test(mod2$residuals)
ifelse(shp2[2]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se cumple el supuesto de normalidad, debido a que los residuales tienen un p-valor >5%, es decir, tienen una distribución normal.
#Homocedasticidad - Varianza homogenea Esta prueba analiza si los datos varian en la misma medida.
#HIPOTESIS \[H_0:\text{Hay igualdad de varianzas en los residuales}\] \[H_a: \text{NO Hay igualdad de varianzas en los residuales}\]
bart2<-bartlett.test(mod2$residuals, datos2$CAT)
ifelse(bart2[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"No se rechaza la H0, debido a que tiene un valor >5%, lo que indicaria que las varianzas en los residuales no presentan diferencias estadisticamente significativas entre si.
###Comparaciones de medias a posteriori # Prueba de Maxima diferencia de Tukey
library(stats)
par(mar=c(4, 6, 3, 1))
tt = TukeyHSD(mod2, 'CAT')
plot(tt, las=1)
abline(v=0, lty=2, col='red',lwd=2)
tt## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = REND ~ CAT, data = datos2)
##
## $CAT
## diff lwr upr p adj
## B-A 5.0000000 1.600704 8.399296 0.0027711
## C-A 6.3333333 2.934037 9.732629 0.0002282
## D-A 0.1666667 -3.232629 3.565963 0.9990452
## C-B 1.3333333 -2.065963 4.732629 0.6948686
## D-B -4.8333333 -8.232629 -1.434037 0.0037860
## D-C -6.1666667 -9.565963 -2.767371 0.0003110library(TukeyC)
tt = TukeyC(mod2, 'CAT')
plot(tt)
Los catalizadores C y B (a) no difieren en gran medida entre ellos,
igualmente que los catalizadores A Y D (b). Sin embargo, si difieren
entre grupos. Es decir, los efectos de los catalizadores con letra (a)
no tienen mucha diferencia en el rendimiento entre ellos, pero si en
comparación con el otro grupo (b).
library(agricolae)
dt2=duncan.test(mod2, 'CAT', console=T)##
## Study: mod2 ~ "CAT"
##
## Duncan's new multiple range test
## for REND
##
## Mean Square Error: 4.425
##
## CAT, means
##
## REND std r Min Max
## A 61.83333 1.169045 6 60 63
## B 66.83333 1.940790 6 65 70
## C 68.16667 2.639444 6 66 73
## D 62.00000 2.366432 6 58 65
##
## Alpha: 0.05 ; DF Error: 20
##
## Critical Range
## 2 3 4
## 2.533394 2.659212 2.739173
##
## Means with the same letter are not significantly different.
##
## REND groups
## C 68.16667 a
## B 66.83333 a
## D 62.00000 b
## A 61.83333 bplot(dt2)
Esta prueba nos indica que el rendimiento del proceso quimico es mejor
con el catalizador C. #INTERPRETACION BIOLOGICA Los
catalizadores no tienen el mismo efecto en el rendimiento, esto se
dedujo de la prueba ANOVA rechaza la H0, es decir, las medias de las
varianzas son diferentes. Por otro lado, por medio de la prueba de
normalidad
#PRUEBA DE GRUBBS Mide la ausencia de atipicos #HIPOTESIS \[H_0:\text{NO hay datos atipicos}\] \[H_a: \text{Hay datos atipicos}\]
library(outliers)
grub2<-grubbs.test(mod2$residuals)
ifelse(grub2[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se acepta la H0, debido a que tiene un p-valor >5%, es decir, no se detectaron valores atipicos en los datos.
#CUATRO MODALIDADES DEL ANALISIS DE VARIANZA - Al revisar 1000 permutaciones se confirma que los datos y el modelo mantiene una diferencia de varianzas
#HIPOTESIS ##Comparar las medias de los catalizadores \[H_0:\mu_{A}=\mu_{B}=\mu_{C}=\mu_{D}\\\] \[H_a: \mu_{A}\neq\mu_{B}\neq\mu_{C}\neq\mu_{D}\]
library(RVAideMemoire)
perm2<-perm.anova(REND ~ CAT, data = datos2, nperm = 1000, progress = F)ifelse(perm2[5]>0.05, "Ho es verdad","Ha es verdad")## Pr(>F)
## CAT "Ha es verdad"
## Residuals NA#Análisis de varianza no parametricos HIPOTESIS \[H_0: R_A = R_B = R_C = R_D\]
krus2<- kruskal.test(datos2$REND,datos2$CAT);krus2##
## Kruskal-Wallis rank sum test
##
## data: datos2$REND and datos2$CAT
## Kruskal-Wallis chi-squared = 17.333, df = 3, p-value = 0.0006035ifelse(krus2[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ha es verdad"PUNTO 3 - BLOQUEO Efecto de la duración de flores en florero
library(readxl)
datos3 <- read_excel("~/SEMESTRE 2023-1/DISENO DE EXPERIMENTOS/TALLER DISE_1.xlsx",
sheet = "Hoja3")
print(datos3)## # A tibble: 9 × 3
## SITIO BLOQ TMP
## <chr> <dbl> <dbl>
## 1 NORTE 1 96
## 2 CENTRO 1 85
## 3 SUR 1 80
## 4 NORTE 2 90
## 5 CENTRO 2 88
## 6 SUR 2 76
## 7 NORTE 3 85
## 8 CENTRO 3 82
## 9 SUR 3 78datos3$SITIO = as.factor(datos3$SITIO)
datos3$TMP = as.numeric(datos3$TMP)
datos3$BLOQ = as.numeric(datos3$BLOQ)#ARBOL DE DECISION
library(collapsibleTree)
collapsibleTreeSummary(datos3,
c('SITIO',
'BLOQ',
'TMP'),
collapsed = FALSE)summary(datos3)## SITIO BLOQ TMP
## CENTRO:3 Min. :1 Min. :76.00
## NORTE :3 1st Qu.:1 1st Qu.:80.00
## SUR :3 Median :2 Median :85.00
## Mean :2 Mean :84.44
## 3rd Qu.:3 3rd Qu.:88.00
## Max. :3 Max. :96.00#ANALISIS DESCRIPTIVO
library(ggplot2)
ggplot(data = datos3, aes(x = factor(SITIO), y = TMP, fill= SITIO)) +
geom_boxplot() +
xlab("SITIO") +
ylab("TMP")
El boxplot nos indica que el sitio SUR tiene menor efecto en la duracion
de las flores en el florero en comparacion con los otros sitios, siendo
el que tiene mayor efecto el sitio NORTE.
library(ggplot2)
ggplot(datos3, aes(x = SITIO , y = TMP, fill = SITIO))+
geom_col(position = 'dodge') +
xlab ("SITIO") +
ylab ("TMP")
Esta grafica nos indica que el NORTE tiene mejores efectos en la
duracion de las flores en el florero.
###Analisis inferencial
#HIPOTESIS ##Comparar las medias del sitio \[H_0:\mu_{N}=\mu_{C}=\mu_{S}\] \[H_a:\mu_{N}\neq\mu_{C}\neq\mu_{C}\] #MODELO DE DISEÑO
$$Y_{ij} = + {i} +{j}+ {ij} \ Y{ij}: \
: \ {i}: \ {j}:\ _{ij}: Error $$\
#TABLA DEL ANOVA #El p-valor se mira para el sitio. #Se mira el f-valor del bloque. Si es mayor o menor al 1.
mod3 = aov(TMP ~ BLOQ + SITIO, datos3)
summary(mod3)## Df Sum Sq Mean Sq F value Pr(>F)
## BLOQ 1 42.67 42.67 4.848 0.0789 .
## SITIO 2 229.56 114.78 13.043 0.0104 *
## Residuals 5 44.00 8.80
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Se rechaza la H0, debido a que tiene un p-valor <0.05, es decir, se detecta una diferencia estadísticamente significativa entre los efectos de los sitios en la duración. Por otro lado,para determinar la eficiencia del bloqueo, se analiza el f-valor, en este caso, se tiene un f-valor de >4.84 para el BLOQ y un f-valor de 13.04 para le sitio, lo que indica que apesar de que es >1, no vale la pena bloquear. ##REVISIÓN DE SUPUESTOS ##Se revisa la normalidad de residuales #HIPOTESIS \[H_0:\text{Hay normalidad en los residuales}\] \[H_a: \text{NO hay normalidad en los residuales}\]
shp3<-shapiro.test(mod3$residuals)
ifelse(shp1[2]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"No se rechaza la H0,por tanto, se cumple el supuesto de normalidad, debido a que los residuales tienen un p-valor >5%, es decir, tienen una distribución normal.
#Homocedasticidad- Varianza homogenea Esta prueba analiza si los datos varian en la misma medida. [3] Posicion en la lista de elementos #HIPOTESIS \[H_0:\text{Hay igualdad de varianzas en los residuales}\] \[H_a: \text{NO Hay igualdad de varianzas en los residuales}\]
bart3<-bartlett.test(mod3$residuals, datos3$SITIO)
ifelse(bart3[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"No se rechaza la H0, debido a que tiene un valor >5%, lo que indicaria que las varianzas se podrian considerar estadisticamente iguales.
##Comparaciones de medias a posteriori
library(TukeyC)
tt = TukeyC(mod3,'SITIO')
plot(tt)
Los efectos del Norte con respecto a los del centro no son
estadisticamente significativos, sin embargo, si se comparan con los
efectos del Sur si presenta una diferencia significativa. Es decir, las
flores en el sitio Norte tienen mayor efecto en la durabilidad que las
flores en el sitio SUR.
#PRUEBA DE MAXIMA DIFERENCIA DE TUKEY
tt3=TukeyHSD(mod3, 'SITIO')## Warning in replications(paste("~", xx), data = mf): non-factors ignored: BLOQpar(mar=c(4,6,3,1))
plot(tt3, las=1)
abline(v=0, lty=2, col='red', lwd=2)
##p<5%— Si difieren ##p>5%— No difieren
tt3## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = TMP ~ BLOQ + SITIO, data = datos3)
##
## $SITIO
## diff lwr upr p adj
## NORTE-CENTRO 5.333333 -2.548031 13.2146978 0.1637485
## SUR-CENTRO -7.000000 -14.881364 0.8813645 0.0744269
## SUR-NORTE -12.333333 -20.214698 -4.4519689 0.0087436Esta prueba nos que los sitios que muestran diferencias significativa entre si son el Norte y el Sur.
library(agricolae)
dt3=duncan.test(mod3, 'SITIO', console=T)##
## Study: mod3 ~ "SITIO"
##
## Duncan's new multiple range test
## for TMP
##
## Mean Square Error: 8.8
##
## SITIO, means
##
## TMP std r Min Max
## CENTRO 85.00000 3.000000 3 82 88
## NORTE 90.33333 5.507571 3 85 96
## SUR 78.00000 2.000000 3 76 80
##
## Alpha: 0.05 ; DF Error: 5
##
## Critical Range
## 2 3
## 6.226258 6.420048
##
## Means with the same letter are not significantly different.
##
## TMP groups
## NORTE 90.33333 a
## CENTRO 85.00000 a
## SUR 78.00000 bplot(dt3)
Esta prueba indica que estadisticamente el sitio Norte y Centro tienen mejores efectos en la duracion de las flores en el florero es en el sitio Norte y y el peor en el Sur.
#INTERPRETACION BIOLOGICA
#PRUEBA DE GRUBBS Mide la ausencia de atipicos #HIPOTESIS \[H_0:\text{NO hay datos atipicos}\] \[H_a: \text{Hay datos atipicos}\]
library(outliers)
grub3<-grubbs.test(mod3$residuals)
ifelse(grub3[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se rechaza la H0, debido a que tiene un p-valor >5%, es decir, que no se detectaron valores atipicos en los datos.
#CUATRO MODALIDADES DEL ANALISIS DE VARIANZA - Al revisar 1000 permutaciones se confirma que los datos y el modelo mantiene una diferencia de varianzas
#HIPOTESIS ##Comparar las medias de los catalizadores \[H_0:\mu_{N}=\mu_{C}=\mu_{S}\\\] \[H_a: \mu_{N}\neq\mu_{C}\neq\mu_{S}\\\]
library(RVAideMemoire)
perm3<-perm.anova(TMP ~ BLOQ + SITIO, data = datos3, nperm = 1000, progress = F)ifelse(perm3[5]>0.05, "Ho es verdad","Ha es verdad")## Pr(>F)
## BLOQ "Ho es verdad"
## SITIO "Ha es verdad"
## Residuals NA#Análisis de varianza no parametricos HIPOTESIS \[H_0: R_N = R_C = R_S\]
krus3<- kruskal.test(datos3$TMP,datos3$SITIO, datos3$BLOQ);krus3##
## Kruskal-Wallis rank sum test
##
## data: datos3$TMP and datos3$SITIO
## Kruskal-Wallis chi-squared = 6.2521, df = 2, p-value = 0.04389ifelse(krus3[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ha es verdad"PUNTO 4
library(readxl)
datos4 <- read_excel("~/SEMESTRE 2023-1/DISENO DE EXPERIMENTOS/TALLER DISE_1.xlsx",
sheet = "Hoja4")
print(datos4)## # A tibble: 9 × 4
## FACTOR REGION ESTACION RESPUESTA
## <chr> <chr> <chr> <dbl>
## 1 C R1 E1 265
## 2 B R1 E2 410
## 3 A R1 E3 220
## 4 A R2 E1 280
## 5 C R2 E2 300
## 6 B R2 E3 384
## 7 B R3 E1 360
## 8 A R3 E2 240
## 9 C R3 E3 251datos4$FACTOR = as.factor(datos4$FACTOR)
datos4$RESPUESTA = as.numeric(datos4$RESPUESTA)
datos4$REGION = as.factor(datos4$REGION)
datos4$ESTACION = as.factor(datos4$ESTACION) #ARBOL DE DECISION
library(collapsibleTree)
collapsibleTreeSummary(datos4,
c('FACTOR',
'REGION',
'ESTACION',
'RESPUESTA'),
collapsed = FALSE)summary(datos4)## FACTOR REGION ESTACION RESPUESTA
## A:3 R1:3 E1:3 Min. :220.0
## B:3 R2:3 E2:3 1st Qu.:251.0
## C:3 R3:3 E3:3 Median :280.0
## Mean :301.1
## 3rd Qu.:360.0
## Max. :410.0###ANALISIS DESCRIPTIVO
library(ggplot2)
ggplot(data = datos4, aes(x =(FACTOR), y = RESPUESTA, fill = FACTOR)) +
geom_boxplot() +
xlab("FACTOR") +
ylab("RESPUESTA")
Este boxplot nos indica que el factor B tiene mejores ventas en
comparaciones con los otros factores, siendo el de peor ventas el factor
A.
library(lattice)
bwplot(RESPUESTA ~ REGION|ESTACION + REGION, datos4)
En el analisis de este boxplot si se toma la region como analisis, se
podria concluir que la region1 en la estacion 2 tiene mejores resultados
que
###Analisis inferencial #HIPOTESIS ##Comparar las medias del FACTOR \[H_0:\mu_{F_A}=\mu_{F_B}=\mu_{F_C}\\\] \[H_a: \mu_{F_A}\neq\mu_{F_B}\neq\mu_{F_C}\\\] #MODELO DE DISEÑO $$Y_{ijk} = + _i + _j + k + {ijk}\
Y_{ij}: \ : \ {i}: \ {j}:\ _{ijk}: Error $$
#TABLA DEL ANOVA Df es los niveles que se tienen -1 En este caso se tienen 3, entonces por eso da 2
mod4= aov( RESPUESTA ~ REGION + FACTOR + ESTACION,
datos4)
summary(mod4)## Df Sum Sq Mean Sq F value Pr(>F)
## REGION 2 2163 1081 2.992 0.2505
## FACTOR 2 32380 16190 44.792 0.0218 *
## ESTACION 2 1506 753 2.083 0.3244
## Residuals 2 723 361
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Se rechaza la H0, debido a que el p-valor de los factores da <5%, por tanto, las medias de los factores, es decir, los efectos de los productos en las ventas son diferentes. Por otro lado, para determinar la eficiencia de los bloqueos se mira el f-valor. En este caso, como la REGION y la ESTACION tienen valores <1, significa que valio la pena el bloqueo de ambos factores en los resultados de venta.
##REVISIÓN DE SUPUESTOS ##Se revisa la normalidad de residuales #HIPOTESIS \[H_0:\text{Hay normalidad en los residuales}\] \[H_a: \text{NO hay normalidad en los residuales}\]
shp4<-shapiro.test(mod4$residuals)
ifelse(shp4[2]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ha es verdad"Se rechaza la H0, es decir, no se cumple el supuesto de normalidad en los residuales debido a que tiene un p-valor <5%.
#Homocedasticidad- Varianza homogenea Esta prueba analiza si los datos varian en la misma medida. #HIPOTESIS \[H_0:\text{Hay igualdad de varianzas en los residuales}\] \[H_a: \text{NO Hay igualdad de varianzas en los residuales}\]
bart4<-bartlett.test(mod4$residuals, datos4$FACTOR)
ifelse(bart4[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se acepta la H0, es decir, hay igualdad en la varianzas de los FACTORES, por tanto, se cumple el supuesto de normalidad.
##Comparaciones de medias a posteriori
library(TukeyC)
tt = TukeyC(mod4, 'FACTOR')
plot(tt)
Los productos C Y A (a) no presentan diferencias significativas entre sí
en cuanto al efecto en las ventas, sin embargo, si se comparan esos dos
con el producto B (b) si presentan diferencias significativas, siendo el
de mejores resultados el producto B.
#PRUEBA DE MAXIMA DIFERENCIA DE TUKEY
tt4=TukeyHSD(mod4, 'FACTOR')
par(mar=c(4,6,3,1))
plot(tt4, las=1)
abline(v=0, lty=2, col='red', lwd=2)
##p<5%— Si difieren ##p>5%— No difieren
tt4## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = RESPUESTA ~ REGION + FACTOR + ESTACION, data = datos4)
##
## $FACTOR
## diff lwr upr p adj
## B-A 138.00000 46.55795 229.44205 0.0225911
## C-A 25.33333 -66.10872 116.77538 0.4061820
## C-B -112.66667 -204.10872 -21.22462 0.0335115Esta prueba nos que los sitios que muestran diferencias significativa entre si son los factores C-B Y B-A.
library(agricolae)
dt4=duncan.test(mod4, 'FACTOR', console=T)##
## Study: mod4 ~ "FACTOR"
##
## Duncan's new multiple range test
## for RESPUESTA
##
## Mean Square Error: 361.4444
##
## FACTOR, means
##
## RESPUESTA std r Min Max
## A 246.6667 30.55050 3 220 280
## B 384.6667 25.00667 3 360 410
## C 272.0000 25.23886 3 251 300
##
## Alpha: 0.05 ; DF Error: 2
##
## Critical Range
## 2 3
## 66.73257 63.81449
##
## Means with the same letter are not significantly different.
##
## RESPUESTA groups
## B 384.6667 a
## C 272.0000 b
## A 246.6667 bplot(dt4)
Esta prueba indica que las mejores ventas estan en el factor B.
#PRUEBA DE GRUBBS Mide la ausencia de atipicos #HIPOTESIS \[H_0:\text{NO hay datos atipicos}\] \[H_a: \text{Hay datos atipicos}\]
library(outliers)
grub4<-grubbs.test(mod4$residuals)
ifelse(grub4[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"Se cumple el supuesto de que no hay valores atipicos en los datos.
#Como los datos no cumplieron el supuesto de normalidad de la prueba de shapiro se realiza un análisis de varianza no parametrico. ###INCUMPLIMIENTO SUPUESTOS DE NORMALIDAD #Análisis de varianza no parametricos HIPOTESIS \[H_0: R_p1 = R_p2 = R_p3 = R_p4\]
krus4<- kruskal.test(datos4$RESPUESTA, datos4$FACTOR);krus4##
## Kruskal-Wallis rank sum test
##
## data: datos4$RESPUESTA and datos4$FACTOR
## Kruskal-Wallis chi-squared = 5.9556, df = 2, p-value = 0.05091ifelse(krus4[3]>0.01, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"No se rechaza la H0 debido a que tiene un p-valor > 5%, es decir, existe una diferencia significativa entre al menos uno las presiones sobre el tiempo de duracion.
PUNTO 5
library(readxl)
datos5 <- read_excel("~/SEMESTRE 2023-1/DISENO DE EXPERIMENTOS/TALLER DISE_1.xlsx",
sheet = "Hoja5")
print(datos5)## # A tibble: 12 × 5
## RESPUESTA FACTOR CIC CE CaMg
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 9.5 1 74 9 52
## 2 10.5 1 81 11 54
## 3 8.5 1 63 7 44
## 4 12 2 77 12 57
## 5 11.6 2 65 9 46
## 6 10.4 2 68 8 45
## 7 9.6 3 87 11 50
## 8 12.2 3 67 10 43
## 9 14.2 3 66 11 47
## 10 13.8 4 61 7 37
## 11 14.1 4 86 13 56
## 12 15 4 78 10 52datos5$FACTOR = as.factor(datos5$FACTOR)
datos5$RESPUESTA = as.numeric(datos5$RESPUESTA)
class(datos5$CE)## [1] "numeric"library(collapsibleTree)
collapsibleTreeSummary(datos5,
hierarchy= c('FACTOR',
'RESPUESTA' ),
collapsed = FALSE)MODELO \[Y_{ij} = \mu + \tau_{i} +\theta(X_{ij}+ - \overline{x} ) + \epsilon_{ij} \\\] ###HIPOTESIS 1 COVARIABLES \[H_0:\theta = 0\] Rechazo H0 es decir el covariante tiene efectos en los resultados.
###HIPOTESIS 2 FACTORES \[H_0: \mu_{1} = \mu_{2} = \mu_{3} = \mu_{4}\\\]
###ANALISIS DE COVARIANZA
mod5 = aov(RESPUESTA~CIC+CE+CaMg+FACTOR,datos5)
summary(mod5)## Df Sum Sq Mean Sq F value Pr(>F)
## CIC 1 0.003 0.003 0.004 0.95332
## CE 1 14.137 14.137 19.789 0.00671 **
## CaMg 1 2.924 2.924 4.093 0.09896 .
## FACTOR 3 29.561 9.854 13.793 0.00747 **
## Residuals 5 3.572 0.714
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#No se rechaza la primera hipotesis para la CIC,es decir, tiene pendiente cero. Por tanto, no tiene efectos en los resultados.
#Se rechaza la primera hipotesis para el CE,es decir, no tiene pendiente cero, por tanto, esta covariante ejerce un efecto en los resultados.
#No se rechaza la primera hipotesis para el CaMg, es decir, tiene pendiente cero. Por tanto, no tiene efectos en los resultados.
#Se rechaza la segunda hipotesis nula debido a que el p-valor es >5%, por tanto, se encuentran diferencias significativas entre los niveles del factor
##REVISIÓN DE SUPUESTOS ##Se revisa la normalidad de residuales #HIPOTESIS \[H_0:\text{Hay normalidad en los residuales}\] \[H_a: \text{NO hay normalidad en los residuales}\]
shp5<-shapiro.test(mod5$residuals)
ifelse(shp5[2]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"No rechaza la H0, es decir, se cumple el supuesto de normalidad en los residuales debido a que tiene un p-valor >5%.
#Homocedasticidad- Varianza homogenea Esta prueba analiza si los datos varian en la misma medida. #HIPOTESIS \[H_0:\text{Hay igualdad de varianzas en los residuales}\] \[H_a: \text{NO Hay igualdad de varianzas en los residuales}\]
bart5<-bartlett.test(mod5$residuals, datos5$FACTOR)
ifelse(bart4[3]>0.05, "Ho es verdad","Ha es verdad")## p.value
## "Ho es verdad"No se rechaza la H0, es decir, hay igualdad en la varianzas de los FACTORES, por tanto, se cumple el supuesto de que las varianzas son iguales.
GRAFICOS
library(ggplot2)
ggplot(datos5, aes(x = CIC, y = RESPUESTA, color = datos5$FACTOR )) +
geom_point(color = datos5$FACTOR, pch = 16, size = 4) +
labs(title='CIC',color ="red")+
geom_smooth(aes(color = datos5$FACTOR),
linewidth = 2,
method = 'lm',
formula = 'y~x',
se=F)+
geom_smooth(method = 'lm',
formula = 'y~x',
se = F,
col ="black")## Warning: Use of `datos5$FACTOR` is discouraged.
## ℹ Use `FACTOR` instead.
Por medio del grafico se puede determinar que la profundidad de siembra
del 3 y 4 factor afectan el tiempo de germinacion.
library(ggplot2)
ggplot(datos5, aes(x = CE, y = RESPUESTA, color = datos5$FACTOR )) +
geom_point(color = datos5$FACTOR, pch = 16, size = 4) +
labs(title='CE',color ="red")+
geom_smooth(aes(color = datos5$FACTOR),
linewidth = 2,
method = 'lm',
formula = 'y~x',
se=F)+
geom_smooth(method = 'lm',
formula = 'y~x',
se = F,
col ="black")## Warning: Use of `datos5$FACTOR` is discouraged.
## ℹ Use `FACTOR` instead.