Diseño cuadrado latino

Diseño desbalanceado FS-BG-CA

modelo \[y_{ijk} = \mu + \tau_i + \beta_{j} + tau\beta_{ij} + \epsilon_{ijk}\] \(i=1,2, \dots,a:\text{num tratamientos}\) \(a\) numero de niveles del factor \(j=1,2,\dots,\text{num tratamientos}\) \(b\) numero de bloques \(k=1,2, \dots,r_i\) \(r_i\) repeticion de cada tratamiento

set.seed(123)

aceite = c(
  rnorm(12, 10, 0.8),
  rnorm(12, 11,0.78),
  rnorm(11, 9, 0.70),
  
  rnorm(12, 10, 0.8),
  rnorm(12, 11,0.78),
  rnorm(11, 9, 0.70)
)

bloque = gl(2,35,70, c('b1', 'b2'))

metodo = rep(rep(c('T1', 'T2', 'T3'), c(12,12,11)), 2)

datos = data.frame(metodo, bloque, aceite)
head(datos)

##   metodo bloque    aceite
## 1     T1     b1  9.551619
## 2     T1     b1  9.815858
## 3     T1     b1 11.246967
## 4     T1     b1 10.056407
## 5     T1     b1 10.103430
## 6     T1     b1 11.372052

table(datos$metodo, datos$bloque)

##     
##      b1 b2
##   T1 12 12
##   T2 12 12
##   T3 11 11

#Corriendo como si fuera balanceado el cual no aplica para este caso

mod1 = aov(aceite ~ bloque * metodo, datos)
summary (mod1)

##               Df Sum Sq Mean Sq F value   Pr(>F)    
## bloque         1   0.05   0.054   0.107    0.745    
## metodo         2  41.24  20.622  40.834 3.72e-12 ***
## bloque:metodo  2   0.65   0.323   0.640    0.531    
## Residuals     64  32.32   0.505                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#corriendo desbalanceado, OJO aunque los dos den lo mismo en este caso, no siempre es asi, cuando hay más factores puede cambiar, entonces la siguiente manera es la que se debe utilizar:

mod2 = anova (lm(aceite ~ bloque * metodo, datos))
mod2

## Analysis of Variance Table
## 
## Response: aceite
##               Df Sum Sq Mean Sq F value    Pr(>F)    
## bloque         1  0.054  0.0541  0.1071    0.7446    
## metodo         2 41.243 20.6217 40.8342 3.716e-12 ***
## bloque:metodo  2  0.646  0.3231  0.6399    0.5307    
## Residuals     64 32.321  0.5050                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

##Cuadrado Latino - Un solo factor - Dos razon de bloqueo - Fertilizante no es una razon de factor de bloqueo - Proc_sem ( proveedor de las semillas) - BIOMASA ( Variable cuantitativa continua)

lote <- c(rep("lote1",1),
          rep("lote2",1),
          rep("lote3",1),
          rep("lote4",1),
          rep("lote5",1))

genot <- c(rep("gA",5),
           rep("gB",5),
           rep("gC",5),
           rep("gD",5),
           rep("gE",5))

proc_sem <- c("A","E","C","B","D",
              "C","B","A","D","E", 
              "B","C","D","E","A", 
              "D","A","E","C","B", 
              "E","D","B","A","C")

biomasa <- c(42,45,41,56,47, 
             47,54,46,52,49,
             55,52,57,49,45,
             51,44,47,50,54, 
             44,50,48,43,46)

mydata <- data.frame(lote, genot, proc_sem, biomasa)
mydata

##     lote genot proc_sem biomasa
## 1  lote1    gA        A      42
## 2  lote2    gA        E      45
## 3  lote3    gA        C      41
## 4  lote4    gA        B      56
## 5  lote5    gA        D      47
## 6  lote1    gB        C      47
## 7  lote2    gB        B      54
## 8  lote3    gB        A      46
## 9  lote4    gB        D      52
## 10 lote5    gB        E      49
## 11 lote1    gC        B      55
## 12 lote2    gC        C      52
## 13 lote3    gC        D      57
## 14 lote4    gC        E      49
## 15 lote5    gC        A      45
## 16 lote1    gD        D      51
## 17 lote2    gD        A      44
## 18 lote3    gD        E      47
## 19 lote4    gD        C      50
## 20 lote5    gD        B      54
## 21 lote1    gE        E      44
## 22 lote2    gE        D      50
## 23 lote3    gE        B      48
## 24 lote4    gE        A      43
## 25 lote5    gE        C      46

GRAFICOS DESCRIPTIVOS

library(lattice)
bwplot(biomasa ~ genot | proc_sem + lote, mydata)

### Modelo de analisis de varianza Ver que diferencias se presentan

mod <- lm(biomasa ~ lote + genot +proc_sem, mydata)
anova(mod)

## Analysis of Variance Table
## 
## Response: biomasa
##           Df Sum Sq Mean Sq F value   Pr(>F)    
## lote       4  17.76   4.440  0.7967 0.549839    
## genot      4 109.36  27.340  4.9055 0.014105 *  
## proc_sem   4 286.16  71.540 12.8361 0.000271 ***
## Residuals 12  66.88   5.573                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

tbl = matrix (mydata$proc_sem, 5)
colnames(tbl) = unique (mydata$genot)
rownames(tbl) =unique(mydata$lote)
tbl

##       gA  gB  gC  gD  gE 
## lote1 "A" "C" "B" "D" "E"
## lote2 "E" "B" "C" "A" "D"
## lote3 "C" "A" "D" "E" "B"
## lote4 "B" "D" "E" "C" "A"
## lote5 "D" "E" "A" "B" "C"

Hipotesis: Los genotipos son todos identicos \[H_0: \mu_{B_{g_1}} =\mu_{B_{g_2}} =\mu_{B_{g_3}} =\mu_{B_{g_4}} =\mu_{B_{g_5}} \]

GRAFICO DE COMO SE COMPORTAN LOS GENOTIPOS SEGUN EL PROVEEDOR ( NO ES UTIL PARA ESTE EJECRCICIO POR EL EJE “X” ES CUALITATIVO)

bwplot(biomasa ~ genot | proc_sem , mydata)

interaction.plot(genot, proc_sem, biomasa, lwd=2)

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.2.2

ggplot(mydata)+
  aes(genot,
      biomasa,
      fill=proc_sem)+
  geom_col(
    position = 'dodge')

El mejor genotipo de semillas para nuestro ejercicio son las de PROVEEDOR “c”, por el grafico de TuckeyC

REVISION DE SUPUESTOS

res_mod = mod$residuals
#Normalidad
shapiro.test(res_mod)

## 
##  Shapiro-Wilk normality test
## 
## data:  res_mod
## W = 0.97691, p-value = 0.8178

Se cumple el supuesto porque su resultado es 81%

#IGUALDAD DE VARIANZAS
bartlett.test(res_mod, genot)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  res_mod and genot
## Bartlett's K-squared = 5.9223, df = 4, p-value = 0.205

Se cumple el supuesto de varinazas iguales porque es mayor al 5%

library(TukeyC)

## Warning: package 'TukeyC' was built under R version 4.2.3

tt = TukeyC(mod, 'genot')
plot(tt)

LLEGANDO A LA CONCLUSION DE QUE EL MEJOR GENOTIPO DE SEMILLA ES EL “C” PROQUE NO GUARDADA NINGUNA SIMULITUD CON LAS OTRAS, Y SUS REDIMIENTO DE BIOMASA ES DE 52.0

library(collapsibleTree)

## Warning: package 'collapsibleTree' was built under R version 4.2.2

collapsibleTreeSummary(mydata,
                       c('lote','proc_sem', 'genot'),
                       collapsed = F)

library (ggplot2)

ggplot (mydata)+
aes (biomasa, genot)+ 
geom_point (size=5, shape=15)+ 
facet_grid(lote ~ proc_sem)

ggplot (mydata)+
aes(lote, genot, fill = biomasa)+ 
geom_tile()+
facet_wrap( ~ proc_sem, nrow = 1)+
theme(axis.text.x = element_text(angle = 90))