#librerias
library(car)

Diseño Factorial Simple Completamente Aleatorizado

Datos, inicialmente balanceados

set.seed(123)
#VARIABLE RESPUESTA % DE GERMINACIÓN
porc_germ = c(
  rnorm(40, 60, 6),
  rnorm(40, 70, 7),
  rnorm(40, 80, 8)
)

# ÚNICO FACTOR ESCARIFICACIÓN DE LAS SEMILLAS, 3 CONCENTRACIONES DE ÁCIDO
acido = gl(3, 40, 120, c('c0', 'c1', 'c2'))

datos = data.frame(acido, porc_germ)
head(datos)

Eliminar datos para desbalancear


table(datos$acido)
datos_des = datos[-c(50, 111, 120), ]
table(datos_des$acido)

Analisis de varianza cuando está balanceado

mod1 = aov(porc_germ ~ acido, datos)
summary(mod1)

Analisis inferencial cuando los datos están balanceados

boxplot(datos$porc_germ ~ datos$acido)

Analisis de varianza AOV cuando los datos están desbalanceados

mod2 = aov(porc_germ ~ acido, datos_des)
summary(mod2)

Los diseños desbalanceados requieren un tratamiento especial, es un error hacer el analisis de varianza con AOV.

mod3 = lm(porc_germ ~ acido, datos_des)
mod3_res = Anova(mod3, type = 'II')
mod3_res

Cuando el diseño es de un (1) solo factor ambas formas de analisis de varianza funcionan y dan valores iguales

DISEÑO FACTORIAL SIMPLE CON BLOQUES AL AZAR

set.seed(123)
#VARIABLE RESPUESTA % DE GERMINACIÓN
porc_germb = c(
  rnorm(40, 60, 6),
  rnorm(40, 70, 7),
  rnorm(40, 80, 8)
)

# ÚNICO FACTOR ESCARIFICACIÓN DE LAS SEMILLAS, 4 CONCENTRACIONES DE ÁCIDO

#BLOQUES
bloq = gl(3, 40, 120, c('B0', 'B1', 'B2'))

#FACTOR 4 NIVELES
acidob = gl(4, 10, 120, c('c0', 'c1', 'c2', 'c3'))

datosb = data.frame(acidob, bloq, porc_germb)
head(datosb)

table(datosb$bloq, datosb$acidob)
#datos_desb = datos[-c(50, 111, 120), ]
datos_desb = datosb[-sample(120, 5), ]
table(datos_desb$bloq, datos_desb$acidob)

Analisis de varianza AOV

modb1 = aov(porc_germb ~ bloq * acidob,
            datos_desb)
summary(modb1)

Analisis de Varianza ANOVA type II

modb2 = lm(porc_germb ~ bloq * acidob,
           datos_desb)

modb2_res = Anova(modb2, type = 'II')
modb2_res

A pesar de que los niveles del factor tienen diferentes repeticiones (es un diseño DESBALANCEADO) los valores obtenidos al calcular la varianza con dos métodos diferentes son los mismos, no hay una diferencia significativa.

Haciendo el analisis de varianza para datos desbalanceados poniendo los datos en diferentes ordenes

modb31 = lm(porc_germb ~ bloq + acidob + bloq:acidob, datos_desb)
Anova(modb31, type = 'II')

modb32 = lm(porc_germb ~ acidob + bloq + bloq:acidob, datos_desb)
Anova(modb32, type = 'II')

modb33 = lm(porc_germb ~ bloq:acidob + acidob + bloq, datos_desb)
Anova(modb33, type = 'II')

modb34 = lm(porc_germb ~ bloq:acidob + bloq + acidob, datos_desb)
Anova(modb34, type = 'II')

No importa el orden en el cual se meten los datos, gracias a la forma en la que se analiza la varianza, la función Anova de la libreria CAR el type = ‘II’ hace el ajuste para el analisis y por eso los valores en las diferentes tablas son los mismos.

DISEÑO FACTORIAL SIMPLE CON BLOQUES COMPLETOS GENERALIZADOS AL AZAR (CON COVARIABLE diametro medio de la semilla)

MARTES QUIZ de este diseño

1: Factorial simple = 1 solo factor

2: Bloques Completos = 3 bloques

3: Bloques Generalizados = hay repeticiones en los bloques

4: Desbalanceado = no hay el mismo número de datos en los niveles del factor

5: Analisis de covarianza = ANCOVA

set.seed(123)
#VARIABLE RESPUESTA % DE GERMINACIÓN
porc_germc = c(
  rnorm(40, 60, 6),
  rnorm(40, 70, 7),
  rnorm(40, 80, 8)
)

#COVARIABLE
# el diametro medio de la semilla 
diam_med = sort(rnorm(120, 12, 1.3))

#BLOQUES
bloqc = gl(3, 40, 120, c('B0', 'B1', 'B2'))
# ÚNICO FACTOR ESCARIFICACIÓN DE LAS SEMILLAS, 4 CONCENTRACIONES DE ÁCIDO
#FACTOR 4 NIVELES
acidoc = gl(4, 10, 120, c('c0', 'c1', 'c2', 'c3'))

datosc = data.frame(acidoc, bloqc, porc_germc, diam_med)
head(datosc)

table(datosc$bloqc, datosc$acidoc)
#datos_desb = datos[-c(50, 111, 120), ]
datos_desc = datosc[-sample(120, 5), ]
table(datos_desc$bloqc, datos_desc$acidoc)

Analisis de varianza ANOVA type II

modc1 = lm(porc_germc ~ diam_med + bloqc + acidoc + bloqc:acidoc, datos_desc)
Anova(modc1, type = 'II')

AVERIGUAR QUE PASA CON EL ANALISIS DE VARIANZA CUANDO DENTRO DE LOS DATOS APARECE UN NA SIN NECESIDAD DE BORRAR LA FILA, qué hacer y cómo

set.seed(123)
#VARIABLE RESPUESTA % DE GERMINACIÓN
porc_germd = c(
  rnorm(40, 60, 6),
  rnorm(40, 70, 7),
  rnorm(40, 80, 8)
)
#COVARIABLE
# el diametro medio de la semilla
diam_medd = sort(rnorm(120, 12, 1.3))
#BLOQUES
bloqd = gl(3, 40, 120, c('B0','B1','B2'))
#FACTOR ÚNICO CON 4 NIVELES
acidod = gl(4, 10, 120, c('C0','C1','C2','C3'))

datosd = data.frame(acidod, bloqd,
                   porc_germd, diam_medd)

`

datos_desd = datosd
datos_desd[sample(120, 5), 'porc_germd'] = NA
table(datos_desd$bloqd, datos_desd$acidod)
tapply(datos_desd$porc_germd,
       datos_desd$acidod,
       mean)
tapply(datos_desd$porc_germd,
       datos_desd$acidod,
       mean, na.rm=TRUE)
modna1 = lm(porc_germd ~ diam_medd + bloqd + acidod + bloqd:acidod, datos_desd)
Anova(modna1, type = 'II')
LS0tDQp0aXRsZTogIkRFIHZpZXJuZXMgMjYgbWF5byINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KZGF0ZTogMjYvMDUvMjAyMw0KQXV0aG9yOiAiQW5kcsOpcyBGZWxpcGUgSGluY2FwacOpIENhc3Rhw7FlZGEiDQpDbGFzczogIkFOw4FMSVNJUyBERSBWQVJJQU5aQSBDVUFORE8gTE9TIERJU0XDkU9TIFNPTiBERVNCQUxBTkNFQURPUyINCg0KLS0tDQogDQpgYGB7cn0NCiNsaWJyZXJpYXMNCmxpYnJhcnkoY2FyKQ0KYGBgDQoNCg0KIyAqRGlzZcOxbyBGYWN0b3JpYWwgU2ltcGxlIENvbXBsZXRhbWVudGUgQWxlYXRvcml6YWRvKg0KIyBEYXRvcywgaW5pY2lhbG1lbnRlIGJhbGFuY2VhZG9zDQoNCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0KI1ZBUklBQkxFIFJFU1BVRVNUQSAlIERFIEdFUk1JTkFDScOTTg0KcG9yY19nZXJtID0gYygNCiAgcm5vcm0oNDAsIDYwLCA2KSwNCiAgcm5vcm0oNDAsIDcwLCA3KSwNCiAgcm5vcm0oNDAsIDgwLCA4KQ0KKQ0KDQojIMOaTklDTyBGQUNUT1IgRVNDQVJJRklDQUNJw5NOIERFIExBUyBTRU1JTExBUywgMyBDT05DRU5UUkFDSU9ORVMgREUgw4FDSURPDQphY2lkbyA9IGdsKDMsIDQwLCAxMjAsIGMoJ2MwJywgJ2MxJywgJ2MyJykpDQoNCmRhdG9zID0gZGF0YS5mcmFtZShhY2lkbywgcG9yY19nZXJtKQ0KaGVhZChkYXRvcykNCmBgYA0KDQojIEVsaW1pbmFyIGRhdG9zIHBhcmEgZGVzYmFsYW5jZWFyDQoNCg0KYGBge3J9DQoNCnRhYmxlKGRhdG9zJGFjaWRvKQ0KZGF0b3NfZGVzID0gZGF0b3NbLWMoNTAsIDExMSwgMTIwKSwgXQ0KdGFibGUoZGF0b3NfZGVzJGFjaWRvKQ0KDQpgYGANCiMgQW5hbGlzaXMgZGUgdmFyaWFuemEgY3VhbmRvIGVzdMOhIGJhbGFuY2VhZG8NCg0KYGBge3J9DQptb2QxID0gYW92KHBvcmNfZ2VybSB+IGFjaWRvLCBkYXRvcykNCnN1bW1hcnkobW9kMSkNCmBgYA0KIyBBbmFsaXNpcyBpbmZlcmVuY2lhbCBjdWFuZG8gbG9zIGRhdG9zIGVzdMOhbiBiYWxhbmNlYWRvcw0KDQpgYGB7cn0NCmJveHBsb3QoZGF0b3MkcG9yY19nZXJtIH4gZGF0b3MkYWNpZG8pDQpgYGANCg0KIyBBbmFsaXNpcyBkZSB2YXJpYW56YSBBT1YgY3VhbmRvIGxvcyBkYXRvcyBlc3TDoW4gZGVzYmFsYW5jZWFkb3MNCg0KYGBge3J9DQptb2QyID0gYW92KHBvcmNfZ2VybSB+IGFjaWRvLCBkYXRvc19kZXMpDQpzdW1tYXJ5KG1vZDIpDQpgYGANCkxvcyBkaXNlw7FvcyBkZXNiYWxhbmNlYWRvcyByZXF1aWVyZW4gdW4gdHJhdGFtaWVudG8gZXNwZWNpYWwsIGVzIHVuIGVycm9yIGhhY2VyIGVsIGFuYWxpc2lzIGRlIHZhcmlhbnphIGNvbiBBT1YuDQoNCmBgYHtyfQ0KbW9kMyA9IGxtKHBvcmNfZ2VybSB+IGFjaWRvLCBkYXRvc19kZXMpDQptb2QzX3JlcyA9IEFub3ZhKG1vZDMsIHR5cGUgPSAnSUknKQ0KbW9kM19yZXMNCmBgYA0KQ3VhbmRvIGVsIGRpc2XDsW8gZXMgZGUgKnVuICgxKSBzb2xvIGZhY3RvciogYW1iYXMgZm9ybWFzIGRlIGFuYWxpc2lzIGRlIHZhcmlhbnphIGZ1bmNpb25hbiB5IGRhbiB2YWxvcmVzIGlndWFsZXMNCg0KDQojICpESVNFw5FPIEZBQ1RPUklBTCBTSU1QTEUgQ09OIEJMT1FVRVMgQUwgQVpBUioNCg0KYGBge3J9DQpzZXQuc2VlZCgxMjMpDQojVkFSSUFCTEUgUkVTUFVFU1RBICUgREUgR0VSTUlOQUNJw5NODQpwb3JjX2dlcm1iID0gYygNCiAgcm5vcm0oNDAsIDYwLCA2KSwNCiAgcm5vcm0oNDAsIDcwLCA3KSwNCiAgcm5vcm0oNDAsIDgwLCA4KQ0KKQ0KDQojIMOaTklDTyBGQUNUT1IgRVNDQVJJRklDQUNJw5NOIERFIExBUyBTRU1JTExBUywgNCBDT05DRU5UUkFDSU9ORVMgREUgw4FDSURPDQoNCiNCTE9RVUVTDQpibG9xID0gZ2woMywgNDAsIDEyMCwgYygnQjAnLCAnQjEnLCAnQjInKSkNCg0KI0ZBQ1RPUiA0IE5JVkVMRVMNCmFjaWRvYiA9IGdsKDQsIDEwLCAxMjAsIGMoJ2MwJywgJ2MxJywgJ2MyJywgJ2MzJykpDQoNCmRhdG9zYiA9IGRhdGEuZnJhbWUoYWNpZG9iLCBibG9xLCBwb3JjX2dlcm1iKQ0KaGVhZChkYXRvc2IpDQoNCnRhYmxlKGRhdG9zYiRibG9xLCBkYXRvc2IkYWNpZG9iKQ0KI2RhdG9zX2Rlc2IgPSBkYXRvc1stYyg1MCwgMTExLCAxMjApLCBdDQpkYXRvc19kZXNiID0gZGF0b3NiWy1zYW1wbGUoMTIwLCA1KSwgXQ0KdGFibGUoZGF0b3NfZGVzYiRibG9xLCBkYXRvc19kZXNiJGFjaWRvYikNCmBgYA0KDQoNCg0KIyBBbmFsaXNpcyBkZSB2YXJpYW56YSBBT1YNCmBgYHtyfQ0KbW9kYjEgPSBhb3YocG9yY19nZXJtYiB+IGJsb3EgKiBhY2lkb2IsDQogICAgICAgICAgICBkYXRvc19kZXNiKQ0Kc3VtbWFyeShtb2RiMSkNCmBgYA0KIyBBbmFsaXNpcyBkZSBWYXJpYW56YSBBTk9WQSB0eXBlIElJDQpgYGB7cn0NCm1vZGIyID0gbG0ocG9yY19nZXJtYiB+IGJsb3EgKiBhY2lkb2IsDQogICAgICAgICAgIGRhdG9zX2Rlc2IpDQoNCm1vZGIyX3JlcyA9IEFub3ZhKG1vZGIyLCB0eXBlID0gJ0lJJykNCm1vZGIyX3Jlcw0KYGBgDQpBIHBlc2FyIGRlIHF1ZSBsb3Mgbml2ZWxlcyBkZWwgZmFjdG9yIHRpZW5lbiBkaWZlcmVudGVzIHJlcGV0aWNpb25lcyAoZXMgdW4gZGlzZcOxbyBERVNCQUxBTkNFQURPKSBsb3MgdmFsb3JlcyBvYnRlbmlkb3MgYWwgY2FsY3VsYXIgIGxhIHZhcmlhbnphIGNvbiBkb3MgbcOpdG9kb3MgZGlmZXJlbnRlcyBzb24gbG9zIG1pc21vcywgbm8gaGF5IHVuYSBkaWZlcmVuY2lhIHNpZ25pZmljYXRpdmEuDQoNCiMgSGFjaWVuZG8gZWwgYW5hbGlzaXMgZGUgdmFyaWFuemEgcGFyYSBkYXRvcyBkZXNiYWxhbmNlYWRvcyBwb25pZW5kbyBsb3MgZGF0b3MgZW4gZGlmZXJlbnRlcyBvcmRlbmVzDQoNCmBgYHtyfQ0KbW9kYjMxID0gbG0ocG9yY19nZXJtYiB+IGJsb3EgKyBhY2lkb2IgKyBibG9xOmFjaWRvYiwgZGF0b3NfZGVzYikNCkFub3ZhKG1vZGIzMSwgdHlwZSA9ICdJSScpDQoNCm1vZGIzMiA9IGxtKHBvcmNfZ2VybWIgfiBhY2lkb2IgKyBibG9xICsgYmxvcTphY2lkb2IsIGRhdG9zX2Rlc2IpDQpBbm92YShtb2RiMzIsIHR5cGUgPSAnSUknKQ0KDQptb2RiMzMgPSBsbShwb3JjX2dlcm1iIH4gYmxvcTphY2lkb2IgKyBhY2lkb2IgKyBibG9xLCBkYXRvc19kZXNiKQ0KQW5vdmEobW9kYjMzLCB0eXBlID0gJ0lJJykNCg0KbW9kYjM0ID0gbG0ocG9yY19nZXJtYiB+IGJsb3E6YWNpZG9iICsgYmxvcSArIGFjaWRvYiwgZGF0b3NfZGVzYikNCkFub3ZhKG1vZGIzNCwgdHlwZSA9ICdJSScpDQpgYGANCk5vIGltcG9ydGEgZWwgb3JkZW4gZW4gZWwgY3VhbCBzZSBtZXRlbiBsb3MgZGF0b3MsIGdyYWNpYXMgYSBsYSBmb3JtYSBlbiBsYSBxdWUgc2UgYW5hbGl6YSBsYSB2YXJpYW56YSwgbGEgZnVuY2nDs24gQW5vdmEgZGUgbGEgbGlicmVyaWEgQ0FSIGVsIHR5cGUgPSAnSUknIGhhY2UgZWwgYWp1c3RlIHBhcmEgZWwgYW5hbGlzaXMgeSBwb3IgZXNvIGxvcyB2YWxvcmVzIGVuIGxhcyBkaWZlcmVudGVzIHRhYmxhcyBzb24gbG9zIG1pc21vcy4gDQoNCiMgKkRJU0XDkU8gRkFDVE9SSUFMIFNJTVBMRSBDT04gQkxPUVVFUyBDT01QTEVUT1MgR0VORVJBTElaQURPUyBBTCBBWkFSIChDT04gQ09WQVJJQUJMRSBkaWFtZXRybyBtZWRpbyBkZSBsYSBzZW1pbGxhKSoNCg0KKk1BUlRFUyBRVUlaIGRlIGVzdGUgZGlzZcOxbyoNCg0KMTogRmFjdG9yaWFsIHNpbXBsZSA9IDEgc29sbyBmYWN0b3INCg0KMjogQmxvcXVlcyBDb21wbGV0b3MgPSAzIGJsb3F1ZXMNCg0KMzogQmxvcXVlcyBHZW5lcmFsaXphZG9zID0gaGF5IHJlcGV0aWNpb25lcyBlbiBsb3MgYmxvcXVlcw0KDQo0OiBEZXNiYWxhbmNlYWRvID0gbm8gaGF5IGVsIG1pc21vIG7Dum1lcm8gZGUgZGF0b3MgZW4gbG9zIG5pdmVsZXMgZGVsIGZhY3Rvcg0KDQo1OiBBbmFsaXNpcyBkZSBjb3ZhcmlhbnphID0gQU5DT1ZBDQoNCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0KI1ZBUklBQkxFIFJFU1BVRVNUQSAlIERFIEdFUk1JTkFDScOTTg0KcG9yY19nZXJtYyA9IGMoDQogIHJub3JtKDQwLCA2MCwgNiksDQogIHJub3JtKDQwLCA3MCwgNyksDQogIHJub3JtKDQwLCA4MCwgOCkNCikNCg0KI0NPVkFSSUFCTEUNCiMgZWwgZGlhbWV0cm8gbWVkaW8gZGUgbGEgc2VtaWxsYSANCmRpYW1fbWVkID0gc29ydChybm9ybSgxMjAsIDEyLCAxLjMpKQ0KDQojQkxPUVVFUw0KYmxvcWMgPSBnbCgzLCA0MCwgMTIwLCBjKCdCMCcsICdCMScsICdCMicpKQ0KIyDDmk5JQ08gRkFDVE9SIEVTQ0FSSUZJQ0FDScOTTiBERSBMQVMgU0VNSUxMQVMsIDQgQ09OQ0VOVFJBQ0lPTkVTIERFIMOBQ0lETw0KI0ZBQ1RPUiA0IE5JVkVMRVMNCmFjaWRvYyA9IGdsKDQsIDEwLCAxMjAsIGMoJ2MwJywgJ2MxJywgJ2MyJywgJ2MzJykpDQoNCmRhdG9zYyA9IGRhdGEuZnJhbWUoYWNpZG9jLCBibG9xYywgcG9yY19nZXJtYywgZGlhbV9tZWQpDQpoZWFkKGRhdG9zYykNCg0KdGFibGUoZGF0b3NjJGJsb3FjLCBkYXRvc2MkYWNpZG9jKQ0KI2RhdG9zX2Rlc2IgPSBkYXRvc1stYyg1MCwgMTExLCAxMjApLCBdDQpkYXRvc19kZXNjID0gZGF0b3NjWy1zYW1wbGUoMTIwLCA1KSwgXQ0KdGFibGUoZGF0b3NfZGVzYyRibG9xYywgZGF0b3NfZGVzYyRhY2lkb2MpDQpgYGANCg0KDQojIEFuYWxpc2lzIGRlIHZhcmlhbnphIEFOT1ZBIHR5cGUgSUkNCg0KYGBge3J9DQptb2RjMSA9IGxtKHBvcmNfZ2VybWMgfiBkaWFtX21lZCArIGJsb3FjICsgYWNpZG9jICsgYmxvcWM6YWNpZG9jLCBkYXRvc19kZXNjKQ0KQW5vdmEobW9kYzEsIHR5cGUgPSAnSUknKQ0KYGBgDQoNCiMgQVZFUklHVUFSIFFVRSBQQVNBIENPTiBFTCBBTkFMSVNJUyBERSBWQVJJQU5aQSBDVUFORE8gREVOVFJPIERFIExPUyBEQVRPUyBBUEFSRUNFIFVOIE5BIFNJTiBORUNFU0lEQUQgREUgQk9SUkFSIExBIEZJTEEsICBxdcOpIGhhY2VyIHkgY8OzbW8NCg0KDQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCiNWQVJJQUJMRSBSRVNQVUVTVEEgJSBERSBHRVJNSU5BQ0nDk04NCnBvcmNfZ2VybWQgPSBjKA0KICBybm9ybSg0MCwgNjAsIDYpLA0KICBybm9ybSg0MCwgNzAsIDcpLA0KICBybm9ybSg0MCwgODAsIDgpDQopDQojQ09WQVJJQUJMRQ0KIyBlbCBkaWFtZXRybyBtZWRpbyBkZSBsYSBzZW1pbGxhDQpkaWFtX21lZGQgPSBzb3J0KHJub3JtKDEyMCwgMTIsIDEuMykpDQojQkxPUVVFUw0KYmxvcWQgPSBnbCgzLCA0MCwgMTIwLCBjKCdCMCcsJ0IxJywnQjInKSkNCiNGQUNUT1Igw5pOSUNPIENPTiA0IE5JVkVMRVMNCmFjaWRvZCA9IGdsKDQsIDEwLCAxMjAsIGMoJ0MwJywnQzEnLCdDMicsJ0MzJykpDQoNCmRhdG9zZCA9IGRhdGEuZnJhbWUoYWNpZG9kLCBibG9xZCwNCiAgICAgICAgICAgICAgICAgICBwb3JjX2dlcm1kLCBkaWFtX21lZGQpDQpgYGANCg0KYA0KYGBge3J9DQpkYXRvc19kZXNkID0gZGF0b3NkDQpkYXRvc19kZXNkW3NhbXBsZSgxMjAsIDUpLCAncG9yY19nZXJtZCddID0gTkENCnRhYmxlKGRhdG9zX2Rlc2QkYmxvcWQsIGRhdG9zX2Rlc2QkYWNpZG9kKQ0KYGBgDQoNCmBgYHtyfQ0KdGFwcGx5KGRhdG9zX2Rlc2QkcG9yY19nZXJtZCwNCiAgICAgICBkYXRvc19kZXNkJGFjaWRvZCwNCiAgICAgICBtZWFuKQ0KYGBgDQoNCmBgYHtyfQ0KdGFwcGx5KGRhdG9zX2Rlc2QkcG9yY19nZXJtZCwNCiAgICAgICBkYXRvc19kZXNkJGFjaWRvZCwNCiAgICAgICBtZWFuLCBuYS5ybT1UUlVFKQ0KYGBgDQpgYGB7cn0NCm1vZG5hMSA9IGxtKHBvcmNfZ2VybWQgfiBkaWFtX21lZGQgKyBibG9xZCArIGFjaWRvZCArIGJsb3FkOmFjaWRvZCwgZGF0b3NfZGVzZCkNCkFub3ZhKG1vZG5hMSwgdHlwZSA9ICdJSScpDQpgYGANCg0KDQo=