set.seed(123)

# Respuesta
diam_geom = c(
  rnorm(4, 1.8, 0.1),
  rnorm(4, 2.0, 0.12),
  rnorm(4, 1.9, 0.09)
)
# Factor
gen = gl(3, 4, 12, paste0('g_', 1:3))
# Bloqueo
procedencia = gl(4, 1, 12, paste0('l', 1:4))

data = data.frame(gen, procedencia, diam_geom)
head(data)
library(collapsibleTree)
collapsibleTree::collapsibleTreeSummary(data,
                      c('procedencia',
                        'gen',
                        'diam_geom'),
                      collapsed = FALSE)

Análisis descriptivo

library(ggplot2)
ggplot(data)+
  aes(gen, diam_geom)+
  geom_point(size=7,
             color='green')+
  facet_wrap(~procedencia)+
  theme_dark()

Análisis inferencial

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

mod1 = aov(diam_geom ~ procedencia + gen,
          data)
summary(mod1)
            Df  Sum Sq Mean Sq F value Pr(>F)  
procedencia  3 0.04373 0.01458   1.334 0.3483  
gen          2 0.08908 0.04454   4.078 0.0762 .
Residuals    6 0.06554 0.01092                 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

ADVERTENCIAS

No interpretar el p-value respecto a los bloques, únicamente se interpretan los resultados correspondientes a los factores. En este caso el p-value de los genotipos > 5% (7,62%) se rechaza la hipótesis nula, por lo tanto, podemos asumir estadisticamente que los genotipos no son iguales.

Eficiencia de bloqueo

Esto permite responder la pregunta ¿Valió la pena hacer los bloques (teniendo en cuenta la procedencia de la semilla)? (TENER EN CUENTA LA PROCEDENCIA = BLOQUES) H = 1.334 (f-value de los bloques)

Es el f de los bloques, cuando H > 1 suguiere que valió la pena realizar el bloqueo.

#Correr anova para demostrar que los bloques tienen efecto (demostración)
mod2 = aov(diam_geom ~  gen,
          data)
summary(mod2)
            Df  Sum Sq Mean Sq F value Pr(>F)  
gen          2 0.08908 0.04454   3.669 0.0684 .
Residuals    9 0.10927 0.01214                 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Revisión de supuestos

#1. extraer residuales del modelo con bloques (el que está hecho correctamente)

res_mod1 = mod1$residuals
res_mod1
          1           2           3           4           5           6           7 
-0.02211959 -0.07076653  0.04856616  0.04431997  0.03920036  0.14781687 -0.06223687 
          8           9          10          11          12 
-0.12478036 -0.01708076 -0.07705034  0.01367071  0.08046039 
#2. Prueba de nomalidad de los residuales (SHAPIRO.TEST)
shapiro.test(res_mod1)

    Shapiro-Wilk normality test

data:  res_mod1
W = 0.97765, p-value = 0.9725

97% significa que los residuos son normales

#3. Probando la homoceasticidad (varianzas iguales) (BARLETT.TEST)
bartlett.test(res_mod1, data$gen)

    Bartlett test of homogeneity of variances

data:  res_mod1 and data$gen
Bartlett's K-squared = 1.709, df = 2, p-value = 0.4255

MAYOR al 5% se cumple, en este caso fue de 42,55%

En ambos casos los p-value de las pruebas fueron >5% por lo cual se cumplen los supuestos.

# TERCER SUPUESTO QUE USUALMENTE SE OMITE.
# PATRÓN DE LOS RESIDUALES.
plot(data$diam_geom,
     res_mod1,
     pch=16)

Cuando los residuales tienene un patrón identificable significa que están AUTOCORRELACIONADOS, suelen causar problemas a la hora de calcular y analizar la varianza.

CONCLUSIÓN AGRONÓMICA DEL PROBLEMA

  1. Valio la pena hacer el bloqueo.
  2. Estadisticamente no difieren los genotipos
  3. Se cumplen los supuestos del anova

NOTA Para el curso de diseños de experimentos se toma para las pruebas de hipótesis un pvalor >5%, en el ambito profesional estos valores pueden cambiar(según la institución)

BLOQUE GENERALIZADOS Y AL AZAR (TIPO DE EXPERIMENTO 3)

set.seed(123)

diam_geom = c(
  rnorm(20, 1.8, 0.1),
  rnorm(20, 2.0, 0.12),
  rnorm(20, 1.9, 0.09)
)

gen = gl(3, 20, 60, paste0('g_', 1:3))

procedencia = gl(4, 5, 60, paste0('l_',1:4))

data = data.frame(gen, procedencia, diam_geom)
head(data)
library(collapsibleTree)
collapsibleTree::collapsibleTreeSummary(data,
                      c('procedencia',
                        'gen',
                        'diam_geom'),
                      collapsed = FALSE)
library(lattice)
bwplot(diam_geom ~ gen | procedencia, 
       data)

mod3 = aov(diam_geom ~ procedencia * gen, 
           data)
summary(mod3)
                Df Sum Sq Mean Sq F value   Pr(>F)    
procedencia      3 0.0310 0.01034   1.135    0.344    
gen              2 0.3233 0.16164  17.732 1.71e-06 ***
procedencia:gen  6 0.0407 0.00678   0.744    0.617    
Residuals       48 0.4376 0.00912                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Conclusión final

El diseño 3 (factorial simple con bloques generalizados al azar) permite hacer la media de la interacción entre gen y lote gracias a las repeticiones.

LS0tDQp0aXRsZTogIkRFIHZpZXJuZXMgMjEgYWJyaWwgMjAyMyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KQXV0aG9yOiAiQW5kcsOpcyBGZWxpcGUgSGluY2FwacOpIENhc3Rhw7FlZGEiDQpEYXRlOiAyMS8wNC8yMDIzDQpDbGFzczogIkFOw4FMSVNJUyBERVNDUklQVElWTyAzIERpc2XDsW9zIGRlIEV4cGVyaW1lbnRvczogMSBkaXNlw7FvIGZhY3RvcmlhbCBzaW1wbGUsIDIgZmFjdG9yaWFsIHNpbXBsZSBjb24gYmxvcXVlcyBhbCBhemFyIHkgMyBmYWN0b3JpYWwgc2ltcGxlIGNvbiBibG9xdWVzIGdlbmVyYWxpemFkb3MgYWwgYXphciINCg0KLS0tDQoNCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0KDQojIFJlc3B1ZXN0YQ0KZGlhbV9nZW9tID0gYygNCiAgcm5vcm0oNCwgMS44LCAwLjEpLA0KICBybm9ybSg0LCAyLjAsIDAuMTIpLA0KICBybm9ybSg0LCAxLjksIDAuMDkpDQopDQojIEZhY3Rvcg0KZ2VuID0gZ2woMywgNCwgMTIsIHBhc3RlMCgnZ18nLCAxOjMpKQ0KIyBCbG9xdWVvDQpwcm9jZWRlbmNpYSA9IGdsKDQsIDEsIDEyLCBwYXN0ZTAoJ2wnLCAxOjQpKQ0KDQpkYXRhID0gZGF0YS5mcmFtZShnZW4sIHByb2NlZGVuY2lhLCBkaWFtX2dlb20pDQpoZWFkKGRhdGEpDQpgYGANCmBgYHtyfQ0KbGlicmFyeShjb2xsYXBzaWJsZVRyZWUpDQpgYGANCg0KYGBge3J9DQpjb2xsYXBzaWJsZVRyZWU6OmNvbGxhcHNpYmxlVHJlZVN1bW1hcnkoZGF0YSwNCiAgICAgICAgICAgICAgICAgICAgICBjKCdwcm9jZWRlbmNpYScsDQogICAgICAgICAgICAgICAgICAgICAgICAnZ2VuJywNCiAgICAgICAgICAgICAgICAgICAgICAgICdkaWFtX2dlb20nKSwNCiAgICAgICAgICAgICAgICAgICAgICBjb2xsYXBzZWQgPSBGQUxTRSkNCmBgYA0KIyMjIEFuw6FsaXNpcyBkZXNjcmlwdGl2byAjIyMNCmBgYHtyfQ0KbGlicmFyeShnZ3Bsb3QyKQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEpKw0KICBhZXMoZ2VuLCBkaWFtX2dlb20pKw0KICBnZW9tX3BvaW50KHNpemU9NywNCiAgICAgICAgICAgICBjb2xvcj0nZ3JlZW4nKSsNCiAgZmFjZXRfd3JhcCh+cHJvY2VkZW5jaWEpKw0KICB0aGVtZV9kYXJrKCkNCmBgYA0KDQojIyMgQW7DoWxpc2lzIGluZmVyZW5jaWFsICMjIw0KDQokJEhfMDogXG11X3tnXzF9PVxtdV97Z18yfT1cbXVfe2dfM30kJA0KYGBge3J9DQptb2QxID0gYW92KGRpYW1fZ2VvbSB+IHByb2NlZGVuY2lhICsgZ2VuLA0KICAgICAgICAgIGRhdGEpDQpzdW1tYXJ5KG1vZDEpDQpgYGANCiMjIyBBRFZFUlRFTkNJQVMgIyMjDQoNCk5vIGludGVycHJldGFyIGVsIHAtdmFsdWUgcmVzcGVjdG8gYSBsb3MgYmxvcXVlcywgw7puaWNhbWVudGUgc2UgaW50ZXJwcmV0YW4gbG9zIHJlc3VsdGFkb3MgY29ycmVzcG9uZGllbnRlcyBhIGxvcyBmYWN0b3Jlcy4NCkVuIGVzdGUgY2FzbyBlbCBwLXZhbHVlIGRlIGxvcyBnZW5vdGlwb3MgPiA1JSAoNyw2MiUpIHNlIHJlY2hhemEgbGEgaGlww7N0ZXNpcyBudWxhLCBwb3IgbG8gdGFudG8sIHBvZGVtb3MgYXN1bWlyIGVzdGFkaXN0aWNhbWVudGUgcXVlIGxvcyBnZW5vdGlwb3Mgbm8gc29uIGlndWFsZXMuDQoNCg0KDQojIyMjIEVmaWNpZW5jaWEgZGUgYmxvcXVlbyAjIyMNCg0KRXN0byBwZXJtaXRlIHJlc3BvbmRlciBsYSBwcmVndW50YSDCv1ZhbGnDsyBsYSBwZW5hIGhhY2VyIGxvcyBibG9xdWVzICh0ZW5pZW5kbyBlbiBjdWVudGEgbGEgcHJvY2VkZW5jaWEgZGUgbGEgc2VtaWxsYSk/DQooVEVORVIgRU4gQ1VFTlRBIExBIFBST0NFREVOQ0lBID0gQkxPUVVFUykNCkggPSAxLjMzNCAoZi12YWx1ZSBkZSBsb3MgYmxvcXVlcykNCg0KRXMgZWwgZiBkZSBsb3MgYmxvcXVlcywgY3VhbmRvIEggPiAxIHN1Z3VpZXJlIHF1ZSB2YWxpw7MgbGEgcGVuYSByZWFsaXphciBlbCBibG9xdWVvLg0KDQpgYGB7cn0NCiNDb3JyZXIgYW5vdmEgcGFyYSBkZW1vc3RyYXIgcXVlIGxvcyBibG9xdWVzIHRpZW5lbiBlZmVjdG8gKGRlbW9zdHJhY2nDs24pDQptb2QyID0gYW92KGRpYW1fZ2VvbSB+ICBnZW4sDQogICAgICAgICAgZGF0YSkNCnN1bW1hcnkobW9kMikNCmBgYA0KDQojIyMgUmV2aXNpw7NuIGRlIHN1cHVlc3RvcyAjIyMNCmBgYHtyfQ0KIzEuIGV4dHJhZXIgcmVzaWR1YWxlcyBkZWwgbW9kZWxvIGNvbiBibG9xdWVzIChlbCBxdWUgZXN0w6EgaGVjaG8gY29ycmVjdGFtZW50ZSkNCg0KcmVzX21vZDEgPSBtb2QxJHJlc2lkdWFscw0KcmVzX21vZDENCmBgYA0KDQoNCmBgYHtyfQ0KIzIuIFBydWViYSBkZSBub21hbGlkYWQgZGUgbG9zIHJlc2lkdWFsZXMgKFNIQVBJUk8uVEVTVCkNCnNoYXBpcm8udGVzdChyZXNfbW9kMSkNCmBgYA0KKjk3JSBzaWduaWZpY2EgcXVlIGxvcyByZXNpZHVvcyBzb24gbm9ybWFsZXMqDQoNCmBgYHtyfQ0KIzMuIFByb2JhbmRvIGxhIGhvbW9jZWFzdGljaWRhZCAodmFyaWFuemFzIGlndWFsZXMpIChCQVJMRVRULlRFU1QpDQpiYXJ0bGV0dC50ZXN0KHJlc19tb2QxLCBkYXRhJGdlbikNCmBgYA0KKk1BWU9SIGFsIDUlIHNlIGN1bXBsZSwgZW4gZXN0ZSBjYXNvIGZ1ZSBkZSA0Miw1NSUqDQoNCiMjIyMgRW4gYW1ib3MgY2Fzb3MgbG9zIHAtdmFsdWUgZGUgbGFzIHBydWViYXMgZnVlcm9uID41JSBwb3IgbG8gY3VhbCBzZSBjdW1wbGVuIGxvcyBzdXB1ZXN0b3MuIyMjDQoNCmBgYHtyfQ0KIyBURVJDRVIgU1VQVUVTVE8gUVVFIFVTVUFMTUVOVEUgU0UgT01JVEUuDQojIFBBVFLDk04gREUgTE9TIFJFU0lEVUFMRVMuDQpwbG90KGRhdGEkZGlhbV9nZW9tLA0KICAgICByZXNfbW9kMSwNCiAgICAgcGNoPTE2KQ0KYGBgDQoNCipDdWFuZG8gbG9zIHJlc2lkdWFsZXMgdGllbmVuZSB1biBwYXRyw7NuIGlkZW50aWZpY2FibGUgc2lnbmlmaWNhIHF1ZSBlc3TDoW4gQVVUT0NPUlJFTEFDSU9OQURPUywgc3VlbGVuIGNhdXNhciBwcm9ibGVtYXMgYSBsYSBob3JhIGRlIGNhbGN1bGFyIHkgYW5hbGl6YXIgbGEgdmFyaWFuemEuKg0KDQoNCg0KIyMjIENPTkNMVVNJw5NOIEFHUk9Ow5NNSUNBIERFTCBQUk9CTEVNQSMjIw0KMS4gVmFsaW8gbGEgcGVuYSBoYWNlciBlbCBibG9xdWVvLg0KMi4gRXN0YWRpc3RpY2FtZW50ZSBubyBkaWZpZXJlbiBsb3MgZ2Vub3RpcG9zDQozLiBTZSBjdW1wbGVuIGxvcyBzdXB1ZXN0b3MgZGVsIGFub3ZhDQoNCipOT1RBKg0KUGFyYSBlbCBjdXJzbyBkZSBkaXNlw7FvcyBkZSBleHBlcmltZW50b3Mgc2UgdG9tYSBwYXJhIGxhcyBwcnVlYmFzIGRlIGhpcMOzdGVzaXMgdW4gcHZhbG9yID41JSwgZW4gZWwgYW1iaXRvIHByb2Zlc2lvbmFsIGVzdG9zIHZhbG9yZXMgcHVlZGVuIGNhbWJpYXIoc2Vnw7puIGxhIGluc3RpdHVjacOzbikNCg0KDQojIyMgQkxPUVVFIEdFTkVSQUxJWkFET1MgWSBBTCBBWkFSIChUSVBPIERFIEVYUEVSSU1FTlRPIDMpIyMjDQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCg0KZGlhbV9nZW9tID0gYygNCiAgcm5vcm0oMjAsIDEuOCwgMC4xKSwNCiAgcm5vcm0oMjAsIDIuMCwgMC4xMiksDQogIHJub3JtKDIwLCAxLjksIDAuMDkpDQopDQoNCmdlbiA9IGdsKDMsIDIwLCA2MCwgcGFzdGUwKCdnXycsIDE6MykpDQoNCnByb2NlZGVuY2lhID0gZ2woNCwgNSwgNjAsIHBhc3RlMCgnbF8nLDE6NCkpDQoNCmRhdGEgPSBkYXRhLmZyYW1lKGdlbiwgcHJvY2VkZW5jaWEsIGRpYW1fZ2VvbSkNCmhlYWQoZGF0YSkNCmBgYA0KYGBge3J9DQpsaWJyYXJ5KGNvbGxhcHNpYmxlVHJlZSkNCmNvbGxhcHNpYmxlVHJlZTo6Y29sbGFwc2libGVUcmVlU3VtbWFyeShkYXRhLA0KICAgICAgICAgICAgICAgICAgICAgIGMoJ3Byb2NlZGVuY2lhJywNCiAgICAgICAgICAgICAgICAgICAgICAgICdnZW4nLA0KICAgICAgICAgICAgICAgICAgICAgICAgJ2RpYW1fZ2VvbScpLA0KICAgICAgICAgICAgICAgICAgICAgIGNvbGxhcHNlZCA9IEZBTFNFKQ0KYGBgDQpgYGB7cn0NCmxpYnJhcnkobGF0dGljZSkNCmBgYA0KDQpgYGB7cn0NCmJ3cGxvdChkaWFtX2dlb20gfiBnZW4gfCBwcm9jZWRlbmNpYSwgDQogICAgICAgZGF0YSkNCmBgYA0KYGBge3J9DQptb2QzID0gYW92KGRpYW1fZ2VvbSB+IHByb2NlZGVuY2lhICogZ2VuLCANCiAgICAgICAgICAgZGF0YSkNCnN1bW1hcnkobW9kMykNCmBgYA0KIyMjIENvbmNsdXNpw7NuIGZpbmFsICMjIw0KRWwgZGlzZcOxbyAzIChmYWN0b3JpYWwgc2ltcGxlIGNvbiBibG9xdWVzIGdlbmVyYWxpemFkb3MgYWwgYXphcikgIHBlcm1pdGUgaGFjZXIgbGEgbWVkaWEgZGUgbGEgaW50ZXJhY2Npw7NuIGVudHJlIGdlbiB5IGxvdGUgZ3JhY2lhcyBhIGxhcyByZXBldGljaW9uZXMuIA0K