Problema 1

Una joven, que acababa de seguir un curso de tres días en diseño experimental decidió intentar aplicar su conocimiento adquirido para analizar el efecto de los reactivos sobre la viscosidad de una mezcla de reacción. En primer momento detectó tres variables que podrían haber sido relevantes: eran las cantidades de tres reactivos (llamémoslos A, B y C). La formulación original era de 10 g de A, 4 g de B y 10 g de C. Decidió mantener este escenario experimental como punto de partida y para explorar sus alrededores. Dado que el número de experimentos posibles fue bastante limitado, decidió aplicar un Diseño. Factorial 2*3, requiriendo un total de ocho experimentos.

Hipotesis

Ho= Los residuales pertenecen a una distribución normal con(μ1=0, σ²= cte) H1= Los residuales no pertenecen a una distribución normal con (μ1=0, σ²= cte) Ho= σ²i= σ²j =cte H1= σ²i ≠ σ²j≠cte

A<-c(-1,+1,-1,+1,-1,+1,-1,+1)
B<-c(-1,-1,+1,+1,-1,-1,+1,+1)
C<-c(-1,-1,-1,-1,+1,+1,+1,+1)
Y<-c(51.8,51.6,51.0,42.4,50.2,46.6,52.0,50.0)
df<-data.frame(A=as.factor(A),B=as.factor(B),C=as.factor(C),Y)
df
##    A  B  C    Y
## 1 -1 -1 -1 51.8
## 2  1 -1 -1 51.6
## 3 -1  1 -1 51.0
## 4  1  1 -1 42.4
## 5 -1 -1  1 50.2
## 6  1 -1  1 46.6
## 7 -1  1  1 52.0
## 8  1  1  1 50.0
str(df)
## 'data.frame':    8 obs. of  4 variables:
##  $ A: Factor w/ 2 levels "-1","1": 1 2 1 2 1 2 1 2
##  $ B: Factor w/ 2 levels "-1","1": 1 1 2 2 1 1 2 2
##  $ C: Factor w/ 2 levels "-1","1": 1 1 1 1 2 2 2 2
##  $ Y: num  51.8 51.6 51 42.4 50.2 46.6 52 50

Modelo de Matriz

A <- rep(c(-1,1),4)
B <- rep(c(-1,-1,1,1),2)
C <- rep(c(rep(-1,4),rep(1,4)))
AB <- A*B
AC <- A*C
BC <- B*C
ABC <-A*B*C
run <- 1:8
factnames <- c("Run","A","B","C","AB","AC","BC","ABC")
knitr::kable(cbind(run,A,B,C,AB,AC,BC,ABC),col.names = factnames)
Run A B C AB AC BC ABC
1 -1 -1 -1 1 1 1 -1
2 1 -1 -1 -1 -1 1 1
3 -1 1 -1 -1 1 -1 1
4 1 1 -1 1 -1 -1 -1
5 -1 -1 1 1 -1 -1 1
6 1 -1 1 -1 1 -1 -1
7 -1 1 1 -1 -1 1 -1
8 1 1 1 1 1 1 1 
modeloF<-lm(Y~A+B+C+AB+AC+BC)
summary(modeloF)
## 
## Call:
## lm(formula = Y ~ A + B + C + AB + AC + BC)
## 
## Residuals:
##     1     2     3     4     5     6     7     8 
## -1.25  1.25  1.25 -1.25  1.25 -1.25 -1.25  1.25 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)    49.45       1.25   39.56   0.0161 *
## A              -1.80       1.25   -1.44   0.3864  
## B              -0.60       1.25   -0.48   0.7151  
## C               0.25       1.25    0.20   0.8743  
## AB             -0.85       1.25   -0.68   0.6198  
## AC              0.40       1.25    0.32   0.8028  
## BC              1.90       1.25    1.52   0.3705  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.536 on 1 degrees of freedom
## Multiple R-squared:  0.8392, Adjusted R-squared:  -0.1255 
## F-statistic: 0.8699 on 6 and 1 DF,  p-value: 0.6751
anova=aov(modeloF)
summary(anova)
##             Df Sum Sq Mean Sq F value Pr(>F)
## A            1  25.92   25.92   2.074  0.386
## B            1   2.88    2.88   0.230  0.715
## C            1   0.50    0.50   0.040  0.874
## AB           1   5.78    5.78   0.462  0.620
## AC           1   1.28    1.28   0.102  0.803
## BC           1  28.88   28.88   2.310  0.370
## Residuals    1  12.50   12.50
qqnorm(anova$residuals)
qqline(anova$residuals)

shapiro.test(modeloF$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modeloF$residuals
## W = 0.66466, p-value = 0.0008917
bartlett.test((modeloF$residuals), A, B, C, data=df)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  (modeloF$residuals) and A
## Bartlett's K-squared = 0, df = 1, p-value = 1

Conclusión

En el modelo de regresión se observa que no existe un efecto significativo de los tratamientos y de las interacciones, por su parte el mayor efecto es observado en el intercepto, según el analisis ANOVA.

Los principales reactivos que tienen efectos sobre la viscosidad, a pesar de no ser significativos en el modelo de regresión, son el A y la interacción BC,

La prueba de Shapiro demuestra que no existe normalidad en los datos, ya que P<0.05, con 95% de confianza. BAsandome en todo lo expuesto, puedo decir que el modelo matemático probablemente no se ajuste a la distribución anormal de los datos, esto a pesar de realizar ensayos de 1/y. Por lo que se recomienda repetir el ensayo.

Problema 2

Se desea comparar dos tratamientos para reducir el nivel de colesterol en la sangre. Se seleccionan 20 individuos y se asignan al azar a dos tipos de dietas: A y B. La tabla muestra la reducción conseguida después de dos meses.

A<-c(51.3,39.4,26.3,39.0,48.1,34.2,69.8,31.3,45.2,46.4)
B<-c(29.6,47.0,25.9,13.0,33.1,22.1,34.1,19.5,43.8,24.9)

Hipótesis

   Ho= μ1=μ2 El tratamiento  A es igual al tratamiento B
   HA= μ1≠μ2 Los Tratamientos  A y B son diferentes
          
n1<-length(A)
n2<-length(B)
n1
## [1] 10
n2
## [1] 10
m1=mean(A)
m2=mean(B)
m1
## [1] 43.1
m2
## [1] 29.3
var(A)
## [1] 150.18
var(B)
## [1] 111.7333
s1=sd(A)
s2=sd(B)
s1
## [1] 12.25479
s2
## [1] 10.5704
t.test(A,B)
## 
##  Welch Two Sample t-test
## 
## data:  A and B
## t = 2.6965, df = 17.62, p-value = 0.01495
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##   3.031382 24.568618
## sample estimates:
## mean of x mean of y 
##      43.1      29.3
Sp<-sqrt(((n1-1)*var(A)+(n2-1)*var(B))/(n1+n2-2))
Sp
## [1] 11.44363
boxplot (A, B)

## Conclusion

Según el ensayo de t se puede rechazar hipótesis nula y se acepta la alterna, se dice entonces que HA= μ1≠μ2 Los Tratamientos A y B son diferentes, debido a que el valor de P<0.05, con 95% de confianza.

En la caja de bigotes, se comprueba que las medias no son iguales ya que no hay traslape entre ellas, incluso vemos en la caja 1 del tratamiento A, que hay posibles datos anómalos, sin embargo en la caja 2, tratamiento B los datos se encuentran mejor distribuidos, tanto hacia arriba como hacia abajo. Todo esto con 95% de confianza.

Problema 3

Se desea comparar el rendimiento de cuatro semillas A,B,C y D. Un terreno se divide en 24 parcelas similares y se asigna al azar cada semilla a 6 parcelas.

Hipotesis

Ho= μ1=μ2=μ3=μ4 Todas las semillas son iguales HA= μ1≠μ2≠μ3≠μ4 Algunas semillas son diferentes

df<-expand.grid(c("A","B","C","D"),c(1,2,3,4,5,6))
df$Y<-c(Y=229.1,233.4,211.1,270.4,253.7,233.0,223.1,248.6,241.3,219.2,217.5,230.0,254.7,200.0,211.8,250.7,237.2,224.3,207.6,230.0,241.3,202.0,213.7,245.8)

names(df)=c("Semilla","Parcela","Y")
str(df)
## 'data.frame':    24 obs. of  3 variables:
##  $ Semilla: Factor w/ 4 levels "A","B","C","D": 1 2 3 4 1 2 3 4 1 2 ...
##  $ Parcela: num  1 1 1 1 2 2 2 2 3 3 ...
##  $ Y      : num  229 233 211 270 254 ...
##  - attr(*, "out.attrs")=List of 2
##   ..$ dim     : int [1:2] 4 6
##   ..$ dimnames:List of 2
##   .. ..$ Var1: chr [1:4] "Var1=A" "Var1=B" "Var1=C" "Var1=D"
##   .. ..$ Var2: chr [1:6] "Var2=1" "Var2=2" "Var2=3" "Var2=4" ...
df$Semilla=factor(df$Semilla)
df$Parcela=factor(df$Parcela)
df$Y=as.numeric(df$Y)
df
##    Semilla Parcela     Y
## 1        A       1 229.1
## 2        B       1 233.4
## 3        C       1 211.1
## 4        D       1 270.4
## 5        A       2 253.7
## 6        B       2 233.0
## 7        C       2 223.1
## 8        D       2 248.6
## 9        A       3 241.3
## 10       B       3 219.2
## 11       C       3 217.5
## 12       D       3 230.0
## 13       A       4 254.7
## 14       B       4 200.0
## 15       C       4 211.8
## 16       D       4 250.7
## 17       A       5 237.2
## 18       B       5 224.3
## 19       C       5 207.6
## 20       D       5 230.0
## 21       A       6 241.3
## 22       B       6 202.0
## 23       C       6 213.7
## 24       D       6 245.8
modelo<-lm(Y~Semilla+Parcela,data=df)
anova<-aov(modelo)
summary(anova)
##             Df Sum Sq Mean Sq F value  Pr(>F)    
## Semilla      3   4796  1598.5  11.310 0.00039 ***
## Parcela      5    730   146.0   1.033 0.43377    
## Residuals   15   2120   141.3                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
boxplot(Y~Parcela,data=df)

boxplot(Y~Semilla,data=df)

boxplot(Y~Semilla+Parcela,data=df)

library(agricolae)

library(agricolae)
LSD<-LSD.test(anova,"Semilla",group=T,console=T)
## 
## Study: anova ~ "Semilla"
## 
## LSD t Test for Y 
## 
## Mean Square Error:  141.3429 
## 
## Semilla,  means and individual ( 95 %) CI
## 
##          Y       std r      LCL      UCL   Min   Max
## A 242.8833  9.837971 6 232.5382 253.2285 229.1 254.7
## B 218.6500 14.702075 6 208.3049 228.9951 200.0 233.4
## C 214.1333  5.463576 6 203.7882 224.4785 207.6 223.1
## D 245.9167 15.074537 6 235.5715 256.2618 230.0 270.4
## 
## Alpha: 0.05 ; DF Error: 15
## Critical Value of t: 2.13145 
## 
## least Significant Difference: 14.63024 
## 
## Treatments with the same letter are not significantly different.
## 
##          Y groups
## D 245.9167      a
## A 242.8833      a
## B 218.6500      b
## C 214.1333      b
bar.group(x=LSD$groups,horiz=T,col="359",xlim=c(0,285),
       xlab="Rendimiento en Parcela",ylab="Semilla",main="Rendimiento de Semilla en Parcela")

qqnorm(anova$residuals)
qqline(anova$residuals)

shapiro.test(modelo$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo$residuals
## W = 0.96717, p-value = 0.5979

Prueba de homogeneidad de Varianza

library(car)
## Loading required package: carData
leveneTest(df$Y~df$Semilla)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  3  1.3745 0.2793
##       20

Pruebas de Independencia

plot(modelo$residuals)
abline(h=0)

plot(df$Semilla,modelo$residuals)
abline(h=0)

plot(modelo$fitted.values,modelo$residuals)
abline(h=0)

conclusión

Según el analisis de ANOVA, se rechaza la hipotesis nula y se acepta la hipotesis alterna ya que el Pr<0.05, con 95% de confianza.HA= μ1≠μ2≠μ3≠μ4 Algunas semillas son diferentes.

Para el analisis por parcela, se puede observar segun el boxplot que la parcela 4, 5 y 6 podrían tener similitud en cuanto a la media de sus resultados ya que hay un leve traslape y los datos se agrupan se forman similar en los bigotes de dichas cajas, por otro lado las parcelas 1, 2 y 3 son diferentes a todo el grupo, ya que no hay traslape. Esto con 95% de confianza.

Siguiendo el orden de gráficos e ideas, se observa en el boxplot de semilla que las cajas A y D tienen traslape y las cajas B y C también entre si, con 95% de confianza.

En el gráfico de barras el cual hace referencia al rendimiento de semilla por parcela, se comprueba una vez la fuerte interacción de los grupos de semilla A y D y B con C, en los que cada respectivo grupo proporciona un rendimiento similar por parcela, con 95% de confianza.

Con la prueba de Shapiro-Wilk se comprueba que el conjunto de datos provienen de una distribución normal, ya que P>0.05 con 95% de confianza. Para finalizar con la prueba de levene´s podemos asumir igualdad de varianzas, ya que el P>0.05 con 95% de confianza.

Problema 4

Se ha realizado un experimento para medir el tiempo de combustión de unas muestras de cuatro fibras diferentes. En la tabla siguiente se proporcionan los resultados obtenidos (en segundos). Haga un análisis de anova de estos resultados.

Datos del Experimento

Fibra1<-c(17.8, 16.2, 17.5, 17.4, 15.0)
Fibra2<-c(11.2, 11.4, 15.8, 10.0, 10.4)
Fibra3<-c(11.8, 11.0, 10.0, 9.20, 9.20)
Fibra4<-c(14.9, 10.8, 12.8, 10.7, 10.7)

df<-data.frame(Fibra1=Fibra1,Fibra2=Fibra2,Fibra3=Fibra3,Fibra4=Fibra4)

df<-stack(df)
names(df)<-c("Y","Trat")
str(df)
## 'data.frame':    20 obs. of  2 variables:
##  $ Y   : num  17.8 16.2 17.5 17.4 15 11.2 11.4 15.8 10 10.4 ...
##  $ Trat: Factor w/ 4 levels "Fibra1","Fibra2",..: 1 1 1 1 1 2 2 2 2 2 ...

Gráfico de Datos

boxplot(Y~Trat,data=df)

Hipotesis

Ho μ1=μ2=μ3=μ4 Todos los tratamientos de fibras son iguales. Ha μ1≠μ2≠μ3≠μ4 Todos los tratamientos de fibras no son iguales.

Analisis de Varianza ANOVA

modelo<-aov(Y~Trat,data=df)
summary(modelo)
##             Df Sum Sq Mean Sq F value   Pr(>F)    
## Trat         3 120.50   40.17   13.89 0.000102 ***
## Residuals   16  46.26    2.89                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Prueba de Tukey HSD

tk<-TukeyHSD(modelo)
tk
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Y ~ Trat, data = df)
## 
## $Trat
##                diff      lwr      upr     p adj
## Fibra2-Fibra1 -5.02 -8.09676 -1.94324 0.0013227
## Fibra3-Fibra1 -6.54 -9.61676 -3.46324 0.0000851
## Fibra4-Fibra1 -4.80 -7.87676 -1.72324 0.0019981
## Fibra3-Fibra2 -1.52 -4.59676  1.55676 0.5094118
## Fibra4-Fibra2  0.22 -2.85676  3.29676 0.9968426
## Fibra4-Fibra3  1.74 -1.33676  4.81676 0.3968476
plot(tk)

Prueba de Normalidad

qqnorm(modelo$residuals)
qqline(modelo$residuals)

shapiro.test(modelo$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo$residuals
## W = 0.88926, p-value = 0.02606

Prueba de homogeneidad de Varianza

library(car)
leveneTest(df$Y~df$Trat)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  3  0.1788 0.9092
##       16

Pruebas de Independencia

plot(modelo$residuals)
abline(h=0)

plot(df$Trat,modelo$residuals)
abline(h=0)

plot(modelo$fitted.values,modelo$residuals)
abline(h=0)

## Conclusión

En el grafico de cajas y bigotes se observa la variabilidad de las medios de los 4 diferentes tipos de fibras, en la que no se oberva traslape, incluso en el conjunto de fibra2 presencia de posibles datos anómalos.

A partir del analisis de ANOVA, se puede decir que las 4 fibras ensayas en la reacción de combustión, proporcionan resultados diferentes ya que el P<0.05,por lo tanto se rechaza la Ho y se acepta la Ha μ1≠μ2≠μ3≠μ4. ESte supuesto se comprueba con la prueba HSD de Tukey donde se observa que todos los tratamientos de fibras no son iguales. Con 95% de confianza.

En el ensayo de Shapiro-Wilk, se oberva que los datos no provienen de una distribución normal ya que el valor de P<0.05, con 95% de confianza. Así mismo en el gráfico QQ-plot la mayoría de los residuales no se ajustan a la regresión lineal. Por último la prueba de levene´s indica que existe homocedasticidad entre los datos ya que Pr>0.05 con 95% de confianza.

Problema 5

Se ha medido el tiempo hasta la descarga de dos marcas de pilas y se desea contrastar si en base a esta variable las dos marcas son distintas.

Hipotesis

Ho: μ1 = μ2
HA: μ1 ≠ μ2

Energ<-c(1.40,1.39,1.35,1.38,1.35,1.36,1.31,1.26,1.37)
Ultra<-c(1.56,1.54,1.53,1.54,1.54,1.47,1.49,1.54,1.50)
df<-data.frame(E=Energ, U=Ultra)
df<-stack(df)
names(df)=c("Tiempodescarga","Marca")
str(df)
## 'data.frame':    18 obs. of  2 variables:
##  $ Tiempodescarga: num  1.4 1.39 1.35 1.38 1.35 1.36 1.31 1.26 1.37 1.56 ...
##  $ Marca         : Factor w/ 2 levels "E","U": 1 1 1 1 1 1 1 1 1 2 ...
boxplot(Tiempodescarga ~ Marca,data=df,col=c("yellow","green"))

Analisis de Varianza

modelo<-aov(Tiempodescarga~Marca,data=df)
summary(modelo)
##             Df  Sum Sq Mean Sq F value   Pr(>F)    
## Marca        1 0.13176 0.13176   95.15 3.88e-08 ***
## Residuals   16 0.02216 0.00138                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Prueba de Normalidad

qqnorm(modelo$residuals)
qqline(modelo$residuals)

shapiro.test(modelo$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo$residuals
## W = 0.90446, p-value = 0.06874

Prueba de homogeneidad de Varianza

library(car)
leveneTest(df$Tiempodescarga ~ df$Marca)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  1  0.4346 0.5191
##       16

Pruebas de Independencia

plot(modelo$residuals)
abline(h=0)

plot(df$Marca,modelo$residuals)
abline(h=0)

plot(modelo$fitted.values,modelo$residuals)
abline(h=0)

Conclusión

Según el analisis ANOVA, descartamos la hipotesis nula y se acepta la alterna ya que el valor Pr<0.05 con un 95% de confianza. HA: μ1 ≠ μ2 Este supuesto se comprueba en el gráfico de cajas y bigotes donde no se observa traslape entre ambas cajas, por lo tanto las medias son diferentes. Por lo tanto ambas marcas de baterias son distintas.

Los datos provienen de una distribución normal, ya que en la prueba de Shapiro-wilk el valor de P>0.05, con 95% de confianza. Los datos poseen homocedasticidad, ya que el valor P>0.05, con 95% de confianza.

Problema 6

Un fabricante sospecha que los lotes de materia prima recibidos de un proveedor difieren significativamente de su contenido en calcio. Elige al azar 5 lotes diferentes y un químico hace cinco determinaciones del contenido en calcio de cada lote. Los resultados obtenidos han sido

Hipotesis

Ho: μ1 = μ2
HA: μ1 ≠ μ2

df<-expand.grid(c("L1","L2","L3","L4", "L5"),c(1,2,3,4,5))
df$Y<-c(23.46, 23.59, 23.51, 23.28, 23.29, 23.48, 23.46, 23.64, 23.40, 23.46, 23.56, 23.42, 23.46, 23.37, 23.37, 23.39, 23.49, 23.52, 23.46, 23.32, 23.40, 23.50, 23.49, 23.29, 23.38)
names(df)=c("L","Calcio","Y")
str(df)
## 'data.frame':    25 obs. of  3 variables:
##  $ L     : Factor w/ 5 levels "L1","L2","L3",..: 1 2 3 4 5 1 2 3 4 5 ...
##  $ Calcio: num  1 1 1 1 1 2 2 2 2 2 ...
##  $ Y     : num  23.5 23.6 23.5 23.3 23.3 ...
##  - attr(*, "out.attrs")=List of 2
##   ..$ dim     : int [1:2] 5 5
##   ..$ dimnames:List of 2
##   .. ..$ Var1: chr [1:5] "Var1=L1" "Var1=L2" "Var1=L3" "Var1=L4" ...
##   .. ..$ Var2: chr [1:5] "Var2=1" "Var2=2" "Var2=3" "Var2=4" ...
df$L=factor(df$L)
df$Calcio=factor(df$Calcio)
df$Y=as.numeric(df$Y)
df
##     L Calcio     Y
## 1  L1      1 23.46
## 2  L2      1 23.59
## 3  L3      1 23.51
## 4  L4      1 23.28
## 5  L5      1 23.29
## 6  L1      2 23.48
## 7  L2      2 23.46
## 8  L3      2 23.64
## 9  L4      2 23.40
## 10 L5      2 23.46
## 11 L1      3 23.56
## 12 L2      3 23.42
## 13 L3      3 23.46
## 14 L4      3 23.37
## 15 L5      3 23.37
## 16 L1      4 23.39
## 17 L2      4 23.49
## 18 L3      4 23.52
## 19 L4      4 23.46
## 20 L5      4 23.32
## 21 L1      5 23.40
## 22 L2      5 23.50
## 23 L3      5 23.49
## 24 L4      5 23.29
## 25 L5      5 23.38
modelo<-lm(Y~L+Calcio,data=df)
anova<-aov(modelo)
summary(anova)
##             Df  Sum Sq  Mean Sq F value  Pr(>F)   
## L            4 0.11130 0.027824   5.780 0.00449 **
## Calcio       4 0.01658 0.004144   0.861 0.50820   
## Residuals   16 0.07702 0.004814                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
boxplot(Y~L,data=df)

boxplot(Y~Calcio,data=df)

boxplot(Y~L+Calcio,data=df)

library(agricolae)
LSD<-LSD.test(anova,"L",group=T,console=T)
## 
## Study: anova ~ "L"
## 
## LSD t Test for Y 
## 
## Mean Square Error:  0.004814 
## 
## L,  means and individual ( 95 %) CI
## 
##         Y        std r      LCL      UCL   Min   Max
## L1 23.458 0.06870226 5 23.39222 23.52378 23.39 23.56
## L2 23.492 0.06300794 5 23.42622 23.55778 23.42 23.59
## L3 23.524 0.06877500 5 23.45822 23.58978 23.46 23.64
## L4 23.360 0.07582875 5 23.29422 23.42578 23.28 23.46
## L5 23.364 0.06503845 5 23.29822 23.42978 23.29 23.46
## 
## Alpha: 0.05 ; DF Error: 16
## Critical Value of t: 2.119905 
## 
## least Significant Difference: 0.09302496 
## 
## Treatments with the same letter are not significantly different.
## 
##         Y groups
## L3 23.524      a
## L2 23.492      a
## L1 23.458      a
## L5 23.364      b
## L4 23.360      b
bar.group(x=LSD$groups,horiz=T,col="456",xlim=c(0,30),
          xlab="Calcio",ylab="L",main="Determinación de Calcio\npor L")

qqnorm(anova$residuals)
qqline(anova$residuals)

shapiro.test(modelo$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo$residuals
## W = 0.9364, p-value = 0.1222
library(car)
leveneTest(df$Y~df$L)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  4  0.1186 0.9743
##       20
plot(modelo$residuals)
abline(h=0)

plot(modelo$fitted.values,modelo$residuals)
abline(h=0)

plot(df$L,modelo$residuals)
abline(h=0)

Conclusión

EN el ensayo de ANOVA se observa significancia en cuanto a los lotes ya que el valor de P<0.05 con 95% de confianza. EN el gráfico de caja y bigotes por Lote hay traslape en las medias de L4 y L5 y un pequeño traslape de medias de L1, L2 y L3, se destaca los datos anómalos en L2 y L3. En cuanto a la relación de Calcio, vemos que hay similitud en las concentraciones ya que están muy proximas las lineas centrales de cada caja.

Para evaluar esa interacción, se elabora el gráfico de barras donde vemos que todos los lotes son muy similares en cuanto al contenido de calcio, pero estadisticamente poseen cantidades iguales los lotes L4, L5 (grupo b) y por su parte L1, L2 y L3 (grupo A) con 95% de confianza.

En la prueba de Shapiro-wilk, se observa que los datos provienen de una distribución normal ya que P>0.05 con 95% de confianza. Según la prueba de Leven´s tenemos que los datos poseen homocedasticidad ya que Pr>0.05, con 95% de confianza.

Problema 7

Se analiza el efecto de tres venenos y cuatro antídotos en el tiempo de supervivencia de unas ratas. A partir de los siguientes resultados, realice un análisis de anova.

Hipotesis

Ho: αi = αj HA: αi ≠ αj Ho: βi = βj Ha: βi ≠ βj

Y<-c(0.31,0.45,0.46,0.43,0.82,1.10,0.88,0.72,0.43,0.45,0.63,0.72,0.45,0.71,0.66,0.62,0.36,0.29,0.40,0.23,0.92,0.61,0.49,1.24,0.44,0.35,0.31,0.40,0.56,1.02,0.71,0.38,0.22,0.21,0.18,0.23,0.30,0.37,0.38,0.29,0.23,0.25,0.24,0.22,0.30,0.36,0.31,0.33)
length(Y)
## [1] 48
Veneno<-rep(1:3,each=16)
Antidoto<-rep(rep(1:4,each=4),3)
df<-data.frame(Veneno,Antidoto,Y)
df$Veneno<-factor(df$Veneno)
df$Antidoto<-factor(df$Antidoto)
df
##    Veneno Antidoto    Y
## 1       1        1 0.31
## 2       1        1 0.45
## 3       1        1 0.46
## 4       1        1 0.43
## 5       1        2 0.82
## 6       1        2 1.10
## 7       1        2 0.88
## 8       1        2 0.72
## 9       1        3 0.43
## 10      1        3 0.45
## 11      1        3 0.63
## 12      1        3 0.72
## 13      1        4 0.45
## 14      1        4 0.71
## 15      1        4 0.66
## 16      1        4 0.62
## 17      2        1 0.36
## 18      2        1 0.29
## 19      2        1 0.40
## 20      2        1 0.23
## 21      2        2 0.92
## 22      2        2 0.61
## 23      2        2 0.49
## 24      2        2 1.24
## 25      2        3 0.44
## 26      2        3 0.35
## 27      2        3 0.31
## 28      2        3 0.40
## 29      2        4 0.56
## 30      2        4 1.02
## 31      2        4 0.71
## 32      2        4 0.38
## 33      3        1 0.22
## 34      3        1 0.21
## 35      3        1 0.18
## 36      3        1 0.23
## 37      3        2 0.30
## 38      3        2 0.37
## 39      3        2 0.38
## 40      3        2 0.29
## 41      3        3 0.23
## 42      3        3 0.25
## 43      3        3 0.24
## 44      3        3 0.22
## 45      3        4 0.30
## 46      3        4 0.36
## 47      3        4 0.31
## 48      3        4 0.33
interaction.plot(df$Veneno,df$Antidoto,df$Y)

interaction.plot(df$Antidoto,df$Veneno,df$Y)

modelo<-lm(Y~Veneno*Antidoto,data=df)
anova<-aov(modelo)
summary(anova)
##                 Df Sum Sq Mean Sq F value   Pr(>F)    
## Veneno           2 1.0220  0.5110  23.390 3.10e-07 ***
## Antidoto         3 0.9283  0.3094  14.162 2.97e-06 ***
## Veneno:Antidoto  6 0.2474  0.0412   1.887     0.11    
## Residuals       36 0.7865  0.0218                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
qqnorm(anova$residuals)
qqline(anova$residuals)

shapiro.test(anova$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  anova$residuals
## W = 0.91113, p-value = 0.001467
Y<-(1/Y)
df$Y<-Y
modelo2<-lm(Y~Veneno*Antidoto,data=df)
anova2<-aov(modelo2)
summary(anova2)
##                 Df Sum Sq Mean Sq F value   Pr(>F)    
## Veneno           2  34.76  17.379  73.027 2.14e-13 ***
## Antidoto         3  20.46   6.821  28.661 1.20e-09 ***
## Veneno:Antidoto  6   1.53   0.256   1.074    0.396    
## Residuals       36   8.57   0.238                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
qqnorm(anova2$residuals)
qqline(anova2$residuals)

shapiro.test(anova2$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  anova2$residuals
## W = 0.96675, p-value = 0.1886
plot(anova2$residuals)

library(pid)
## Registered S3 method overwritten by 'DoE.base':
##   method           from       
##   factorize.factor conf.design
paretoPlot(anova2)

library(car)
leveneTest(df$Y~df$Veneno,df$Antidoto)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  2  1.7685 0.1822
##       45

COnclusión

Según el analisis de ANOVA, se puede ver que hay algún tipo de interacción de los factores antidoto y veneno, de manera individual, esto con 95% de confianza.

En la Prueba de Shapiro-Wilk, vemos que los datos no provienen de una distribución normal, puesto que P<0.05. Por lo que se realiza un ajuste de normalización 1/Y, obteniendo un valor de P>0.05

En el gráfico de barras, vemos un efecto positivo en el veneno #3, poco efecto en el veneno 2, sin embargo los antidotos no indican efectos positivos sobre alguno de los venenos ensayados, ni las interacciones entre veneno-antidito indica algun efecto positivo, podría decirse que el veneno 3 posee una toxicidad alta, impidiendo que algún antídoto tenga efecto positivo sobre el, en este caso vemos que es el grupo de datos (veneno 3) en el que el tiempo de supervivencia de las ratas es menor, con 95% de confianza.

Los datos poseen Homocedasticidad según la prueba de levene´s, ya que Pr>0.05. con 95% de confianza.

Problema 8

Se ha realizado un experimento para estudiar el efecto de la temperatura (T) y tiempo de exposición (E) sobre la cantidad absorbida de un compuesto químico por un material sumergido en él. En el estudio se han empleado tres temperaturas (T1, T2, T3) y tres tiempos de exposición (E1, E2, E3): cada tratamiento se ha replicado tres veces.

Hipotesis

Ho: μT1 = μT2 = μT3 μE1 = μE2 = μE3 HA: μT1 ≠ μT2 ≠ μT3 μE1 ≠ μE2 ≠ μE3 (E) tiempo de exposición

Y<-c(35.5,29.7,31.5,91.2,100.7,82.4,70.1,64.1,70.1,52.5,53.3,55.0,71.0,77.0,75.6,79.4,77.7,75.1,85.9,85.2,80.2,87.0,86.1,88.1,83.0,87.0,78.5)

length(Y)
## [1] 27
timeexp<-rep(1:3,each=9)
Temperatura<-rep(rep(1:3,each=3),3)
df<-data.frame(timeexp,Temperatura,Y)
df$timeexp<-factor(df$timeexp)
df$Temperatura<-factor(df$Temperatura)
df
##    timeexp Temperatura     Y
## 1        1           1  35.5
## 2        1           1  29.7
## 3        1           1  31.5
## 4        1           2  91.2
## 5        1           2 100.7
## 6        1           2  82.4
## 7        1           3  70.1
## 8        1           3  64.1
## 9        1           3  70.1
## 10       2           1  52.5
## 11       2           1  53.3
## 12       2           1  55.0
## 13       2           2  71.0
## 14       2           2  77.0
## 15       2           2  75.6
## 16       2           3  79.4
## 17       2           3  77.7
## 18       2           3  75.1
## 19       3           1  85.9
## 20       3           1  85.2
## 21       3           1  80.2
## 22       3           2  87.0
## 23       3           2  86.1
## 24       3           2  88.1
## 25       3           3  83.0
## 26       3           3  87.0
## 27       3           3  78.5
interaction.plot(df$timeexp,df$Temperatura,df$Y)

interaction.plot(df$Temperatura,df$timeexp,df$Y)

modelo<-lm(Y~timeexp*Temperatura,data=df)
anova<-aov(modelo)
summary(anova)
##                     Df Sum Sq Mean Sq F value   Pr(>F)    
## timeexp              2   2113  1056.3   63.59 6.92e-09 ***
## Temperatura          2   3674  1836.8  110.58 7.75e-11 ***
## timeexp:Temperatura  4   2704   676.1   40.70 8.74e-09 ***
## Residuals           18    299    16.6                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
qqnorm(anova$residuals)
qqline(anova$residuals)

shapiro.test(anova$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  anova$residuals
## W = 0.94945, p-value = 0.2079
plot(anova$residuals)

library(pid)
paretoPlot(anova)

library(car)
leveneTest(df$Y~df$timeexp,df$Temperatura)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value   Pr(>F)   
## group  2  6.1191 0.007121 **
##       24                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
plot(modelo$residuals)
abline(h=0)

plot(modelo$fitted.values,modelo$residuals)
abline(h=0)

plot(df$timeexp,modelo$residuals)
abline(h=0)

plot(df$Temperatura,modelo$residuals)
abline(h=0)

Conclusión

Ho: μT1 = μT2 = μT3 μE1 = μE2 = μE3 HA: μT1 ≠ μT2 ≠ μT3 μE1 ≠ μE2 ≠ μE3 (E) tiempo de exposición

En el anova se observa que los factores; tiempo de exposición y tempuratura y su interacción son significantes con 95% de confianza, por su parte analizando el gráfico de pareto, se puede concluir que el tiempo de exposición 3 (E3) y la temperatura 2, son los factores que ejercen un mayor efecto positivo sobre la cantidad absorbida en mg del compuesto químico y dicho material sumergido en el, con un 95% de confianza.

Según la cajas y bigotes, boxplot, se podría decir que las medias son similares ya que en el conjunto tanto de temperaturas como de tiempo de exposición hay traslape entre cajas, sin embargo no se descarta posible presencia de datos anómalos en tiempo de exposición 1 y temperatura 2.

En la prueba de shapiro vemos normalidad en los datos ya que P>0.05 con 95% de confianza por lo tanto hay normalidad de los datos. Con la prueba de leven’s se analiza la homocedasticidad de los datos y se rechaza la hipotesis nula de varianza ya que son todas diferentes, con un valor p<0.05, con 95% de confianza.