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
- Valio la pena hacer el bloqueo.
- Estadisticamente no difieren los genotipos
- 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