DE viernes 28 abril 2023

Diseño de Cuadrado Latino

#1 razon de bloqueo lote
lote <- c(rep("lote1", 1),
        rep("lote2", 1),
        rep("lote3", 1),
        rep("lote4", 1),
        rep("lote5", 1)
)

#5 genotipos o variedades de papa
genotipo <- c(rep("genotA",5), 
             rep("genotB",5), 
             rep("genotC",5), 
             rep("genotD",5), 
             rep("genotE",5)
)

#2 razon de bloqueo origen de la semilla
prov <- 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")

#variable respuesta en este caso es biomasa
biom <- 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)


data <- data.frame(
  lote, genotipo, prov, biom)
head(data)

library(lattice)
library(ggplot2)

GRÁFICOS DESCRIPTIVOS

bwplot(biom ~ lote | prov +
         lote, data, las = 2)

MODELO

\[y_{ijk} = \mu + \tau_i + \beta_j + \delta_k + \epsilon_{ijk} \\ i = 1, \dots, p \\ j = 1, \dots, p \\ k = 1, \dots, p \]

tbl = matrix(data$prov, 5)
colnames (tbl)= unique (data$genotipo)
rownames (tbl) = unique (data$lote)
tbl

      genotA genotB genotC genotD genotE
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"   

HIPÓTESIS

\[H_0 : \mu_{B_{g_1}} = \mu_{B_{g_2}} = \mu_{B_{g_3}} = \mu_{B_{g_4}} = \mu_{B_{g_5}}\]

mod <- lm(biom ~ lote + genotipo + prov,
          data)
anova(mod)

Analysis of Variance Table

Response: biom
          Df Sum Sq Mean Sq F value   Pr(>F)    
lote       4  17.76   4.440  0.7967 0.549839    
genotipo   4 109.36  27.340  4.9055 0.014105 *  
prov       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

Analisis del comportamiento de los genotipos teniendo en cuenta el origen de las semillas (el proveedor)

bwplot(biom ~ genotipo | prov,
       data)

interaction.plot(genotipo,
                 prov,
                 biom,
                 lwd = 2)

plot(factor(genotipo), biom, col = factor(prov))

ggplot(data) +
  aes(genotipo,
      biom,
      fill = prov)+
  geom_col(
    position = 'dodge'
  )

Se rechaza la hipótesis nula H0 porque no todos los genotipos son iguales, si se quisiera escoger un proveedor de semillas se deberían tener como candidatos el proveedor B y el C (favorito). Además no se recomendaría el proveedor de semillas que vendió la A.

REVISIÓN DE SUPUESTOS

res_mod = mod$residuals

# 1. Normalidad
shapiro.test(res_mod)

    Shapiro-Wilk normality test

data:  res_mod
W = 0.97691, p-value = 0.8178

# 2. Igualdad de varianzas
bartlett.test(res_mod,
              genotipo)

    Bartlett test of homogeneity of variances

data:  res_mod and genotipo
Bartlett's K-squared = 5.9223, df = 4, p-value = 0.205

Se cumple el supuesto de las varianzas iguales.

library(TukeyC)

#Test de Tukey
tt = TukeyC (mod, 'genotipo')
plot(tt)

Al analizar el gráfico generado por el test de tukey (TukeyC) podemos determinar que: los genotipos A y E tienen los peores resultados; mientras que el genotipo C sobresale por su alto rendimiento.