DISEÑO FACTORIAL COMPLETO (2 factores) EN ARREGLO COMPLETAMENTE AL AZAR (FCCA)

Cultivo tomate

2 Factores

Con aporque y sin aporque

3 variedades diferentes (v1, v2, v3)

6 tratamientos en total

20 repeticiones

#FACTOR 1 APORQUE
set.seed(123)
aporque <- gl(2, 60, 120, c('con_A' , 'sin_A')) 

#FACTOR 2 VARIEDAD

variedad <- gl(3, 20, 120, c('v1','v2', 'v3'))

#RESPUESTA PESO FRESCO DE LOS FRUTOS

peso_fresco <- rnorm(n = 120, mean = 3, sd = 0.3)
df = data.frame(aporque, variedad, peso_fresco)
df

df$peso_fresco[1] = 3.5
df$peso_fresco[81] = 2.5
library(collapsibleTree)
collapsibleTreeSummary(df = df, c('variedad', 'aporque', 'peso_fresco'), collapsed = F, fontSize = 16)

ANALISIS DESCRIPTIVO

library(lattice)
#PESO FRESCO EN FUNCIÓN DE LA VARIEDAD
bwplot(peso_fresco ~ variedad, df, panel = function(...){panel.bwplot(..., groups=df$variedad, fill = c('red', 'blue', 'green'))})

#PESO FRESCO EN FUNCIÓN DEL APORQUE
bwplot(peso_fresco ~ aporque, df, panel = function(...){panel.bwplot(..., groups = df$aporque , fill = c('red', 'blue'))})

bwplot(peso_fresco ~ aporque|variedad, df)

tb = tapply(df$peso_fresco, list(df$aporque, df$variedad), mean)
addmargins(tb, FUN = mean)
Margins computed over dimensions
in the following order:
1: 
2: 
            v1       v2       v3     mean
con_A 3.075894 2.984623 3.031946 3.030821
sin_A 2.964025 3.087442 2.892186 2.981218
mean  3.019960 3.036032 2.962066 3.006019

INTERPRETACIÓN DE LA TABLA

Mirando los margenes

Mirar mean en la tabla

Aparentemente es mejor aporcar.(3.030821)

Y la mejor variedad es la V2. (3.036032)

De la manera correcta

Los datos correctos están en el contenido de la tabla y no en las margenes, por lo que lo mejor agronómicamente es la variedad 1 con aporte (3.075894) y la variedad 2 sin aporque (3.087442).

ANALISIS INFERENCIAL

\[H_0 : \mu_1 = \mu_2 = \mu_3 \\ H_2 : \mu_{aporque} = \mu_{sinaporque} \\ H_3 : \text{No hay interacción entre aporque y variedad}\]

MODELO DEL DISEÑO

\[y_{ijk} =\mu + \tau_i + \delta_j + (\tau\delta)_{ij} + \epsilon_{ijk} \\ i = 1, 2. 3 \\ j = 1, 2 \\ k = 1, 2, 3, ... , 20 \\ n = \text{120 datos}\]

HIPÓTESIS DE EFECTOS

\[ H_{01} : \tau_{v1} = \tau_{v2} = \tau_{v3} = 0 \\ H_{02} : \delta_{aporque} = \delta_{sinaporque} = 0 \\ H_{03} : (\tau\delta)_{ij} = 0 ; \forall_{i,j}\]

FCCA FACTORIAL COMPLETO COMPLETAMENTE AL AZAR

# anova, el * representa la interacción 

mod1 = aov(peso_fresco ~ variedad + aporque + variedad*aporque, df)
summary(mod1)
                  Df Sum Sq Mean Sq F value Pr(>F)  
variedad           2  0.121 0.06054   0.813 0.4461  
aporque            1  0.074 0.07381   0.991 0.3216  
variedad:aporque   2  0.352 0.17619   2.366 0.0985 .
Residuals        114  8.491 0.07448                 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

INTERPRETACIÓN DEL ANOVA

Solo se tiene que interpretar la interacción entre la variedad y el aporque. (variedad:aporque 0.0985) p > 5% no se rechaza la hipótesis, la interacción es nula.

Solo se miran los demás p values cuando se concluye que no hay interacción entre los factores (En este caso vamos a interpretar las hipótesis de variedad y de aporque)

hipótesis de aporque p = 0.3216 >5% NO se rechaza la hipótesis del aporque, el efecto del aporque es nulo. No existe diferencia estadistica en la respuesta (peso fresco promedio) entre aporcar y no aporcar.

hipótesis de variedad p = 0.4461 > 5% NO se rechaza la hipótesis, el efecto de la variedad es nulo. No hay diferencia estadistica en el peso fresco promedio de las tres variedades utilizadas en este experimento.

NO HAY DIFERENCIAS ESTADISTICAS ENTRE EL APORQUE

NO HAY DIFERENCIAS ESTADISTICAS ENTRE LAS 3 VARIEDADES

DATOS CON INTERACCIÓN

#FACTOR 1 APORQUE
set.seed(123)
aporque2<- gl(2, 60, 120, c('con_A' , 'sin_A')) 

#FACTOR 2 VARIEDAD

variedad2<- gl(3, 20, 120, c('v1','v2', 'v3'))

#RESPUESTA PESO FRESCO DE LOS FRUTOS

peso_fresco2 <- c(rnorm(n = 40, mean = 3, sd = 0.3),
rnorm(n = 80, mean = 4,sd= 0.4))

df2 = data.frame(aporque2,variedad2,peso_fresco2)
df2

df2$peso_fresco2[1]= 3.5
df2$peso_fresco2[2.5] = 2.5
mod2 = aov(peso_fresco2 ~ variedad2 + aporque2 + variedad2*aporque2, df2)
summary(mod2)
                    Df Sum Sq Mean Sq F value   Pr(>F)    
variedad2            2  4.656   2.328   21.25 1.43e-08 ***
aporque2             1 11.741  11.741  107.18  < 2e-16 ***
variedad2:aporque2   2 10.247   5.123   46.77 1.47e-15 ***
Residuals          114 12.488   0.110                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
library(ggplot2)
ggplot(df2, 
       aes(variedad2, peso_fresco2, 
           colour = aporque2, group = aporque2))+
  stat_summary(fun = mean, geom = 'point', size = 4)+
  stat_summary(fun = mean, geom = 'line', linetype = 2, size = 2)+
  theme_bw()

LS0tDQp0aXRsZTogIkRFIG1hcnRlcyAwOSBkZSBtYXlvIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQphdXRob3I6ICJBbmRyw6lzIEZlbGlwZSBIaW5jYXBpw6kgQ2FzdGHDsWVkYSINCmRhdGU6ICIwOS8wNS8yMDIzIg0KQ2xhc3M6ICJEaXNlw7FvIGZhY3RvcmlhbCBjb21scGxldG8gZW4gYXJyZWdsbyBjb21wbGV0YW1lbnRlIGFsIEF6YXIiDQotLS0NCg0KIyBESVNFw5FPIEZBQ1RPUklBTCBDT01QTEVUTyAoMiBmYWN0b3JlcykgRU4gQVJSRUdMTyBDT01QTEVUQU1FTlRFIEFMIEFaQVIgKEZDQ0EpDQoNCkN1bHRpdm8gdG9tYXRlDQoNCjIgRmFjdG9yZXMNCg0KQ29uIGFwb3JxdWUgeSBzaW4gYXBvcnF1ZQ0KDQozIHZhcmllZGFkZXMgZGlmZXJlbnRlcyAodjEsIHYyLCB2MykNCg0KNiB0cmF0YW1pZW50b3MgZW4gdG90YWwNCg0KMjAgcmVwZXRpY2lvbmVzDQoNCmBgYHtyfQ0KI0ZBQ1RPUiAxIEFQT1JRVUUNCnNldC5zZWVkKDEyMykNCmFwb3JxdWUgPC0gZ2woMiwgNjAsIDEyMCwgYygnY29uX0EnICwgJ3Npbl9BJykpIA0KDQojRkFDVE9SIDIgVkFSSUVEQUQNCg0KdmFyaWVkYWQgPC0gZ2woMywgMjAsIDEyMCwgYygndjEnLCd2MicsICd2MycpKQ0KDQojUkVTUFVFU1RBIFBFU08gRlJFU0NPIERFIExPUyBGUlVUT1MNCg0KcGVzb19mcmVzY28gPC0gcm5vcm0obiA9IDEyMCwgbWVhbiA9IDMsIHNkID0gMC4zKQ0KZGYgPSBkYXRhLmZyYW1lKGFwb3JxdWUsIHZhcmllZGFkLCBwZXNvX2ZyZXNjbykNCmRmDQoNCmRmJHBlc29fZnJlc2NvWzFdID0gMy41DQpkZiRwZXNvX2ZyZXNjb1s4MV0gPSAyLjUNCmBgYA0KDQpgYGB7cn0NCmxpYnJhcnkoY29sbGFwc2libGVUcmVlKQ0KYGBgDQpgYGB7cn0NCmNvbGxhcHNpYmxlVHJlZVN1bW1hcnkoZGYgPSBkZiwgYygndmFyaWVkYWQnLCAnYXBvcnF1ZScsICdwZXNvX2ZyZXNjbycpLCBjb2xsYXBzZWQgPSBGLCBmb250U2l6ZSA9IDE2KQ0KYGBgDQoNCiMgQU5BTElTSVMgREVTQ1JJUFRJVk8gDQoNCmBgYHtyfQ0KbGlicmFyeShsYXR0aWNlKQ0KYGBgDQpgYGB7cn0NCiNQRVNPIEZSRVNDTyBFTiBGVU5DScOTTiBERSBMQSBWQVJJRURBRA0KYndwbG90KHBlc29fZnJlc2NvIH4gdmFyaWVkYWQsIGRmLCBwYW5lbCA9IGZ1bmN0aW9uKC4uLil7cGFuZWwuYndwbG90KC4uLiwgZ3JvdXBzPWRmJHZhcmllZGFkLCBmaWxsID0gYygncmVkJywgJ2JsdWUnLCAnZ3JlZW4nKSl9KQ0KYGBgDQpgYGB7cn0NCiNQRVNPIEZSRVNDTyBFTiBGVU5DScOTTiBERUwgQVBPUlFVRQ0KYndwbG90KHBlc29fZnJlc2NvIH4gYXBvcnF1ZSwgZGYsIHBhbmVsID0gZnVuY3Rpb24oLi4uKXtwYW5lbC5id3Bsb3QoLi4uLCBncm91cHMgPSBkZiRhcG9ycXVlICwgZmlsbCA9IGMoJ3JlZCcsICdibHVlJykpfSkNCmBgYA0KYGBge3J9DQpid3Bsb3QocGVzb19mcmVzY28gfiBhcG9ycXVlfHZhcmllZGFkLCBkZikNCmBgYA0KYGBge3J9DQp0YiA9IHRhcHBseShkZiRwZXNvX2ZyZXNjbywgbGlzdChkZiRhcG9ycXVlLCBkZiR2YXJpZWRhZCksIG1lYW4pDQphZGRtYXJnaW5zKHRiLCBGVU4gPSBtZWFuKQ0KYGBgDQojIElOVEVSUFJFVEFDScOTTiBERSBMQSBUQUJMQQ0KDQoqTWlyYW5kbyBsb3MgbWFyZ2VuZXMqDQoNCk1pcmFyIG1lYW4gZW4gbGEgdGFibGENCg0KQXBhcmVudGVtZW50ZSBlcyBtZWpvciBhcG9yY2FyLigzLjAzMDgyMSkNCg0KWSBsYSBtZWpvciB2YXJpZWRhZCBlcyBsYSBWMi4gKDMuMDM2MDMyKQ0KDQoNCipEZSBsYSBtYW5lcmEgY29ycmVjdGEqDQoNCkxvcyBkYXRvcyBjb3JyZWN0b3MgZXN0w6FuIGVuIGVsIGNvbnRlbmlkbyBkZSBsYSB0YWJsYSB5IG5vIGVuIGxhcyBtYXJnZW5lcywgcG9yIGxvIHF1ZSBsbyBtZWpvciBhZ3JvbsOzbWljYW1lbnRlIGVzIGxhIHZhcmllZGFkIDEgY29uIGFwb3J0ZSAoMy4wNzU4OTQpIHkgbGEgdmFyaWVkYWQgMiBzaW4gYXBvcnF1ZSAoMy4wODc0NDIpLiANCg0KDQojIEFOQUxJU0lTIElORkVSRU5DSUFMDQoNCiQkSF8wIDogXG11XzEgPSBcbXVfMiA9IFxtdV8zIFxcDQpIXzIgOiBcbXVfe2Fwb3JxdWV9ID0gXG11X3tzaW5hcG9ycXVlfSBcXA0KSF8zIDogXHRleHR7Tm8gaGF5IGludGVyYWNjacOzbiBlbnRyZSBhcG9ycXVlIHkgdmFyaWVkYWR9JCQNCg0KDQoNCiMgTU9ERUxPIERFTCBESVNFw5FPDQoNCiQkeV97aWprfSA9XG11ICsgXHRhdV9pICsgXGRlbHRhX2ogKyAoXHRhdVxkZWx0YSlfe2lqfSArIFxlcHNpbG9uX3tpamt9IFxcDQppID0gMSwgMi4gMyBcXA0KaiA9IDEsIDIgXFwNCmsgPSAxLCAyLCAzLCAuLi4gLCAyMCBcXA0KbiA9IFx0ZXh0ezEyMCBkYXRvc30kJA0KDQojIEhJUMOTVEVTSVMgREUgRUZFQ1RPUw0KDQokJCBIX3swMX0gOiBcdGF1X3t2MX0gPSBcdGF1X3t2Mn0gPSBcdGF1X3t2M30gPSAwIFxcDQpIX3swMn0gOiBcZGVsdGFfe2Fwb3JxdWV9ID0gXGRlbHRhX3tzaW5hcG9ycXVlfSA9IDAgXFwNCkhfezAzfSA6IChcdGF1XGRlbHRhKV97aWp9ID0gMCA7IFxmb3JhbGxfe2ksan0kJA0KDQoNCiMgRkNDQSBGQUNUT1JJQUwgQ09NUExFVE8gQ09NUExFVEFNRU5URSBBTCBBWkFSDQpgYGB7cn0NCiMgYW5vdmEsIGVsICogcmVwcmVzZW50YSBsYSBpbnRlcmFjY2nDs24gDQoNCm1vZDEgPSBhb3YocGVzb19mcmVzY28gfiB2YXJpZWRhZCArIGFwb3JxdWUgKyB2YXJpZWRhZCphcG9ycXVlLCBkZikNCnN1bW1hcnkobW9kMSkNCg0KYGBgDQojIElOVEVSUFJFVEFDScOTTiBERUwgQU5PVkEgDQoNClNvbG8gc2UgdGllbmUgcXVlIGludGVycHJldGFyIGxhIGludGVyYWNjacOzbiBlbnRyZSBsYSB2YXJpZWRhZCB5IGVsIGFwb3JxdWUuICh2YXJpZWRhZDphcG9ycXVlICAwLjA5ODUpDQoqcCA+IDUlIG5vIHNlIHJlY2hhemEgbGEgaGlww7N0ZXNpcywgbGEgaW50ZXJhY2Npw7NuIGVzIG51bGEqLg0KDQpTb2xvIHNlIG1pcmFuIGxvcyBkZW3DoXMgcCB2YWx1ZXMgY3VhbmRvIHNlIGNvbmNsdXllIHF1ZSBubyBoYXkgaW50ZXJhY2Npw7NuIGVudHJlIGxvcyBmYWN0b3JlcyAoRW4gZXN0ZSBjYXNvIHZhbW9zIGEgaW50ZXJwcmV0YXIgbGFzIGhpcMOzdGVzaXMgZGUgdmFyaWVkYWQgeSBkZSBhcG9ycXVlKQ0KDQoqaGlww7N0ZXNpcyBkZSBhcG9ycXVlIHAgPSAwLjMyMTYgPjUlKg0KTk8gc2UgcmVjaGF6YSBsYSBoaXDDs3Rlc2lzIGRlbCBhcG9ycXVlLCBlbCBlZmVjdG8gZGVsIGFwb3JxdWUgZXMgbnVsby4NCk5vIGV4aXN0ZSBkaWZlcmVuY2lhIGVzdGFkaXN0aWNhIGVuIGxhIHJlc3B1ZXN0YSAocGVzbyBmcmVzY28gcHJvbWVkaW8pIGVudHJlIGFwb3JjYXIgeSBubyBhcG9yY2FyLg0KDQoqaGlww7N0ZXNpcyBkZSB2YXJpZWRhZCBwID0gMC40NDYxID4gNSUqDQpOTyBzZSByZWNoYXphIGxhIGhpcMOzdGVzaXMsIGVsIGVmZWN0byBkZSBsYSB2YXJpZWRhZCBlcyBudWxvLiANCk5vIGhheSBkaWZlcmVuY2lhIGVzdGFkaXN0aWNhIGVuIGVsIHBlc28gZnJlc2NvIHByb21lZGlvIGRlIGxhcyB0cmVzIHZhcmllZGFkZXMgdXRpbGl6YWRhcyBlbiBlc3RlIGV4cGVyaW1lbnRvLiANCg0KIyBOTyBIQVkgRElGRVJFTkNJQVMgRVNUQURJU1RJQ0FTIEVOVFJFIEVMIEFQT1JRVUUgDQojIE5PIEhBWSBESUZFUkVOQ0lBUyBFU1RBRElTVElDQVMgRU5UUkUgTEFTIDMgVkFSSUVEQURFUw0KDQoNCg0KIyBEQVRPUyBDT04gSU5URVJBQ0NJw5NODQoNCmBgYHtyfQ0KI0ZBQ1RPUiAxIEFQT1JRVUUNCnNldC5zZWVkKDEyMykNCmFwb3JxdWUyPC0gZ2woMiwgNjAsIDEyMCwgYygnY29uX0EnICwgJ3Npbl9BJykpIA0KDQojRkFDVE9SIDIgVkFSSUVEQUQNCg0KdmFyaWVkYWQyPC0gZ2woMywgMjAsIDEyMCwgYygndjEnLCd2MicsICd2MycpKQ0KDQojUkVTUFVFU1RBIFBFU08gRlJFU0NPIERFIExPUyBGUlVUT1MNCg0KcGVzb19mcmVzY28yIDwtIGMocm5vcm0obiA9IDQwLCBtZWFuID0gMywgc2QgPSAwLjMpLA0Kcm5vcm0obiA9IDgwLCBtZWFuID0gNCxzZD0gMC40KSkNCg0KZGYyID0gZGF0YS5mcmFtZShhcG9ycXVlMix2YXJpZWRhZDIscGVzb19mcmVzY28yKQ0KZGYyDQoNCmRmMiRwZXNvX2ZyZXNjbzJbMV09IDMuNQ0KZGYyJHBlc29fZnJlc2NvMlsyLjVdID0gMi41DQpgYGANCg0KYGBge3J9DQptb2QyID0gYW92KHBlc29fZnJlc2NvMiB+IHZhcmllZGFkMiArIGFwb3JxdWUyICsgdmFyaWVkYWQyKmFwb3JxdWUyLCBkZjIpDQpzdW1tYXJ5KG1vZDIpDQpgYGANCmBgYHtyfQ0KbGlicmFyeShnZ3Bsb3QyKQ0KYGBgDQpgYGB7cn0NCmdncGxvdChkZjIsIA0KICAgICAgIGFlcyh2YXJpZWRhZDIsIHBlc29fZnJlc2NvMiwgDQogICAgICAgICAgIGNvbG91ciA9IGFwb3JxdWUyLCBncm91cCA9IGFwb3JxdWUyKSkrDQogIHN0YXRfc3VtbWFyeShmdW4gPSBtZWFuLCBnZW9tID0gJ3BvaW50Jywgc2l6ZSA9IDQpKw0KICBzdGF0X3N1bW1hcnkoZnVuID0gbWVhbiwgZ2VvbSA9ICdsaW5lJywgbGluZXR5cGUgPSAyLCBzaXplID0gMikrDQogIHRoZW1lX2J3KCkNCmBgYA0KDQoNCg==