Ejercicio 1 Cuadrado Latino

#LIBRERIAS
library(readxl)
library(collapsibleTree)
library(TukeyC)
library(ggplot2)
#IMPORTAR DATOS
data1 <- read_excel("C:/Users/fcecursos/Desktop/parcial d1/data1.xlsx")
head(data1)
#DIFINIR LOS DATOS
#FACTOR
TRAT = data1$TRAT
data1$TRAT = as.factor(data1$TRAT)
TRAT
[1] "x" "y" "z" "z" "x" "y" "y" "z" "x"
#RESPUESTA
DANO = data1$DANO
DANO
[1] 23.0 10.2  3.5  1.0 22.5 10.5  9.3  2.5 18.0
#BLOQUE1
SUELO = data1$SUELO
SUELO
[1] "a" "a" "a" "b" "b" "b" "c" "c" "c"
#BLOQUE2
PEND = data1$PEND
PEND
[1] "baja"  "media" "alta"  "baja"  "media" "alta"  "baja"  "media" "alta" 

Analisis descriptivo

collapsibleTree::collapsibleTreeSummary(data1, c('TRAT','SUELO','PEND','DANO'),collapsed = FALSE)

Modelo

\[Y_{ijk} = \mu + \tau_i + \beta_j + \delta_k + \epsilon_{ijk}\] # Anova

mod1 = aov(DANO ~ SUELO + PEND + TRAT)
summary(mod1)
            Df Sum Sq Mean Sq F value Pr(>F)  
SUELO        2    8.1    4.03   0.864  0.536  
PEND         2    1.7    0.86   0.185  0.844  
TRAT         2  538.2  269.08  57.702  0.017 *
Residuals    2    9.3    4.66                 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
mod11 = lm(DANO ~ SUELO + TRAT + PEND)
anova(mod11)
Analysis of Variance Table

Response: DANO
          Df Sum Sq Mean Sq F value  Pr(>F)  
SUELO      2   8.06   4.030  0.8642 0.53643  
TRAT       2 538.17 269.083 57.7019 0.01704 *
PEND       2   1.73   0.863  0.1851 0.84379  
Residuals  2   9.33   4.663                  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Comparación de medias

tt1 = TukeyHSD(mod1, 'TRAT')
plot(tt1)

Ananlisis inferencial

box1 = ggplot(data1)+
  aes(group = TRAT, DANO, fill = TRAT)+
  geom_boxplot()
box1 + coord_flip()

Supuestos

#EXTRAER LOS RESIDUALES
res1 = mod1$residuals
# 1 NORMALIDAD DE LOS RESIDUOS
# TEST DE SHAPIRO
shapiro.test(res1)

    Shapiro-Wilk normality test

data:  res1
W = 0.68008, p-value = 0.0008303
# 2 PRUEBA DE HOMOCEDASTICIDAD
# TEST DE BARTLETT
bartlett.test(res1, TRAT)

    Bartlett test of homogeneity of variances

data:  res1 and TRAT
Bartlett's K-squared = 0, df = 2, p-value = 1
# PATRON DE LOS RESIDUALES
plot(data1$DANO, res1,
     pch = 16)

PARTE 2

set.seed(1000376863)
#RESPUESTAS
DANO1 = c(sort(rnorm(36,20,1.5)), sort(rnorm(36, 23, 1)))
#TRATAMIENTOS 
TRAT1 = gl(2, 36, length = 72,
   labels = c('escala', 'imajej'))
#COVARIABLE LONGITUD DE MAZORCA (LM)
LM = sort(c(rnorm(36,23.2,3), rnorm(36,23,2.4)))
#COVARIABLE ANCO DE MAZORCA (AM)
AM = c(rnorm(36,5.3,0.9),rnorm(36,5.0,0.8))

DANO1
 [1] 16.90645 17.18907 17.57377 17.88499 18.06394 18.45620 19.00331 19.01152 19.03168 19.24060
[11] 19.40200 19.45601 19.73312 19.76302 19.79616 19.84349 19.85400 19.89060 19.97668 20.00975
[21] 20.09054 20.09372 20.28022 20.40372 20.51284 20.55002 20.85390 20.95356 21.06349 21.15525
[31] 21.33539 21.40012 21.46449 21.80193 22.41124 23.59525 21.10965 21.26589 21.43638 21.65363
[41] 21.73098 21.79104 21.84697 21.89647 22.18390 22.36127 22.36459 22.52511 22.53405 22.56440
[51] 22.57556 22.72192 22.75832 22.77363 22.79892 22.81129 22.84814 22.95920 22.96970 22.98833
[61] 23.25369 23.34899 23.48638 23.59685 24.08829 24.15372 24.17987 24.20047 24.48056 24.55516
[71] 24.84267 25.10624
TRAT1
 [1] escala escala escala escala escala escala escala escala escala escala escala escala escala
[14] escala escala escala escala escala escala escala escala escala escala escala escala escala
[27] escala escala escala escala escala escala escala escala escala escala imajej imajej imajej
[40] imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej
[53] imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej imajej
[66] imajej imajej imajej imajej imajej imajej imajej
Levels: escala imajej
LM
 [1] 18.18999 18.27855 19.06596 19.44305 19.47528 19.75116 20.08748 20.13840 20.71673 20.88087
[11] 20.93013 21.19421 21.22496 21.40770 21.41346 21.46994 21.50354 21.60317 21.67206 21.84720
[21] 22.03741 22.09048 22.16890 22.22518 22.49723 22.73454 22.84896 23.06265 23.29937 23.42876
[31] 23.43239 23.43493 23.70583 23.73007 23.76622 23.78748 23.79785 23.86921 23.91712 23.94353
[41] 24.03610 24.08706 24.16656 24.35829 24.40805 24.49644 24.53337 24.59359 24.65960 24.67551
[51] 24.68634 24.71215 24.79486 24.84078 24.97763 25.18297 25.21356 25.30456 25.58368 25.86059
[61] 25.87300 25.88923 25.98260 26.11436 26.18677 26.21054 26.65747 27.78576 27.97844 28.00144
[71] 28.52673 29.01677
AM
 [1] 4.734053 3.876173 5.604854 5.758704 6.234798 4.802851 5.628869 4.284840 4.848861 5.240143
[11] 5.183898 6.525337 4.455902 4.937696 5.243716 3.853739 5.857912 5.646687 6.515846 4.741956
[21] 4.391564 5.254573 6.133448 4.911663 6.948299 4.878169 5.859539 4.889391 5.088792 5.826345
[31] 5.733378 4.475372 4.171138 5.743161 6.111511 4.592012 5.229131 4.434187 3.506507 5.806833
[41] 4.361978 4.748114 5.003699 4.480295 6.192011 5.822222 5.238183 5.325285 5.581942 5.217173
[51] 3.795454 5.614982 4.768451 4.155159 4.485246 4.876772 7.001240 1.938305 3.961506 4.098557
[61] 4.355071 4.624148 4.169517 4.300596 6.009869 6.308430 5.211710 6.062764 6.582610 4.168642
[71] 5.379792 4.567800
datos = data.frame(DANO1, TRAT1, LM, AM)
View(datos)

Analisis descriptivo

#BOXPLOT
box2 = ggplot(datos)+
aes(group = TRAT1, DANO1, fill = TRAT1)+
  geom_boxplot()

box2 + coord_flip()

#VIOLIN
#VIOLIN
ggplot(datos)+
aes(TRAT1, DANO1, fill = TRAT1)+
  geom_violin()

#BARRAS
ggplot(datos) +
  aes(TRAT1, DANO1, fill = TRAT1)+
  geom_col(position = 'dodge')

Hipótesis

\[H_0 : \mu D_{escala} = \mu D_{imajej}\]

\[H_a : H_0 \text{ es falso}\] # Supuesto de una sola pendiente

supLM = ggplot(datos)+
  aes(DANO1, LM, color = TRAT1)+
  geom_point()+
  geom_smooth(method = 'lm', formula = 'y~x',
              se= F)+
  geom_smooth(method = 'lm', formula = 'y~x' ,
              se = F, col = 'black')

supLM

supAM = ggplot(datos)+
  aes(DANO1, AM, color = TRAT1)+
  geom_point()+
  geom_smooth(method = 'lm', formula = 'y~x',
              se= F)+
  geom_smooth(method = 'lm', formula = 'y~x' ,
              se = F, col = 'black')

supAM

ANOVA

mod2 = lm(DANO1 ~ LM + TRAT1,
          data = datos)
anova(mod2)
Analysis of Variance Table

Response: DANO1
          Df  Sum Sq Mean Sq   F value Pr(>F)    
LM         1 257.515 257.515 1986.6586 <2e-16 ***
TRAT1      1   0.036   0.036    0.2782 0.5996    
Residuals 69   8.944   0.130                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Supuestos

#EXTRAER RESIDUOS
res2 = mod2$residuals
# 1 NORMALIDAD DE LOS RESIDUOS
# TEST DE SHAPIRO
shapiro.test(res2)

    Shapiro-Wilk normality test

data:  res2
W = 0.84322, p-value = 3.057e-07
# 2 PRUEBA DE HOMOCEDASTICIDAD
# TEST DE BARTLETT
bartlett.test(res2, TRAT1)

    Bartlett test of homogeneity of variances

data:  res2 and TRAT1
Bartlett's K-squared = 0.84934, df = 1, p-value = 0.3567
# PATRON DE LOS RESIDUALES
plot(datos$DANO1, res2,
     pch = 16)

Modelo

\[Y_{ijk} = \mu + \tau_i + \beta_j + \delta_k + \epsilon_{ijk}\]

mLM = tapply(DANO1, TRAT1, mean)

mLM
  escala   imajej 
19.94589 22.91006 
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KIyBFamVyY2ljaW8gMSBDdWFkcmFkbyBMYXRpbm8NCmBgYHtyfQ0KI0xJQlJFUklBUw0KbGlicmFyeShyZWFkeGwpDQpsaWJyYXJ5KGNvbGxhcHNpYmxlVHJlZSkNCmxpYnJhcnkoVHVrZXlDKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KDQpgYGANCmBgYHtyfQ0KI0lNUE9SVEFSIERBVE9TDQpkYXRhMSA8LSByZWFkX2V4Y2VsKCJDOi9Vc2Vycy9mY2VjdXJzb3MvRGVza3RvcC9wYXJjaWFsIGQxL2RhdGExLnhsc3giKQ0KaGVhZChkYXRhMSkNCmBgYA0KDQpgYGB7cn0NCiNESUZJTklSIExPUyBEQVRPUw0KI0ZBQ1RPUg0KVFJBVCA9IGRhdGExJFRSQVQNCmRhdGExJFRSQVQgPSBhcy5mYWN0b3IoZGF0YTEkVFJBVCkNClRSQVQNCg0KI1JFU1BVRVNUQQ0KREFOTyA9IGRhdGExJERBTk8NCkRBTk8NCg0KI0JMT1FVRTENClNVRUxPID0gZGF0YTEkU1VFTE8NClNVRUxPDQoNCiNCTE9RVUUyDQpQRU5EID0gZGF0YTEkUEVORA0KUEVORA0KYGBgDQojIEFuYWxpc2lzIGRlc2NyaXB0aXZvDQpgYGB7cn0NCmNvbGxhcHNpYmxlVHJlZTo6Y29sbGFwc2libGVUcmVlU3VtbWFyeShkYXRhMSwgYygnVFJBVCcsJ1NVRUxPJywnUEVORCcsJ0RBTk8nKSxjb2xsYXBzZWQgPSBGQUxTRSkNCmBgYA0KIyBNb2RlbG8NCg0KJCRZX3tpamt9ID0gXG11ICsgXHRhdV9pICsgXGJldGFfaiArIFxkZWx0YV9rICsgXGVwc2lsb25fe2lqa30kJA0KIyBBbm92YQ0KYGBge3J9DQptb2QxID0gYW92KERBTk8gfiBTVUVMTyArIFBFTkQgKyBUUkFUKQ0Kc3VtbWFyeShtb2QxKQ0KYGBgDQpgYGB7cn0NCm1vZDExID0gbG0oREFOTyB+IFNVRUxPICsgVFJBVCArIFBFTkQpDQphbm92YShtb2QxMSkNCmBgYA0KDQojIENvbXBhcmFjacOzbiBkZSBtZWRpYXMNCg0KYGBge3J9DQp0dDEgPSBUdWtleUhTRChtb2QxLCAnVFJBVCcpDQpwbG90KHR0MSkNCmBgYA0KIyBBbmFubGlzaXMgaW5mZXJlbmNpYWwNCg0KYGBge3J9DQpib3gxID0gZ2dwbG90KGRhdGExKSsNCiAgYWVzKGdyb3VwID0gVFJBVCwgREFOTywgZmlsbCA9IFRSQVQpKw0KICBnZW9tX2JveHBsb3QoKQ0KYm94MSArIGNvb3JkX2ZsaXAoKQ0KYGBgDQoNCiMgU3VwdWVzdG9zDQpgYGB7cn0NCiNFWFRSQUVSIExPUyBSRVNJRFVBTEVTDQpyZXMxID0gbW9kMSRyZXNpZHVhbHMNCmBgYA0KDQoNCmBgYHtyfQ0KIyAxIE5PUk1BTElEQUQgREUgTE9TIFJFU0lEVU9TDQojIFRFU1QgREUgU0hBUElSTw0Kc2hhcGlyby50ZXN0KHJlczEpDQpgYGANCmBgYHtyfQ0KIyAyIFBSVUVCQSBERSBIT01PQ0VEQVNUSUNJREFEDQojIFRFU1QgREUgQkFSVExFVFQNCmJhcnRsZXR0LnRlc3QocmVzMSwgVFJBVCkNCmBgYA0KYGBge3J9DQojIFBBVFJPTiBERSBMT1MgUkVTSURVQUxFUw0KcGxvdChkYXRhMSREQU5PLCByZXMxLA0KICAgICBwY2ggPSAxNikNCmBgYA0KDQojIFBBUlRFIDINCg0KYGBge3J9DQpzZXQuc2VlZCgxMDAwMzc2ODYzKQ0KI1JFU1BVRVNUQVMNCkRBTk8xID0gYyhzb3J0KHJub3JtKDM2LDIwLDEuNSkpLCBzb3J0KHJub3JtKDM2LCAyMywgMSkpKQ0KI1RSQVRBTUlFTlRPUyANClRSQVQxID0gZ2woMiwgMzYsIGxlbmd0aCA9IDcyLA0KICAgbGFiZWxzID0gYygnZXNjYWxhJywgJ2ltYWplaicpKQ0KI0NPVkFSSUFCTEUgTE9OR0lUVUQgREUgTUFaT1JDQSAoTE0pDQpMTSA9IHNvcnQoYyhybm9ybSgzNiwyMy4yLDMpLCBybm9ybSgzNiwyMywyLjQpKSkNCiNDT1ZBUklBQkxFIEFOQ08gREUgTUFaT1JDQSAoQU0pDQpBTSA9IGMocm5vcm0oMzYsNS4zLDAuOSkscm5vcm0oMzYsNS4wLDAuOCkpDQoNCkRBTk8xDQpUUkFUMQ0KTE0NCkFNDQpgYGANCmBgYHtyfQ0KZGF0b3MgPSBkYXRhLmZyYW1lKERBTk8xLCBUUkFUMSwgTE0sIEFNKQ0KVmlldyhkYXRvcykNCmBgYA0KDQojIEFuYWxpc2lzIGRlc2NyaXB0aXZvDQpgYGB7cn0NCiNCT1hQTE9UDQpib3gyID0gZ2dwbG90KGRhdG9zKSsNCmFlcyhncm91cCA9IFRSQVQxLCBEQU5PMSwgZmlsbCA9IFRSQVQxKSsNCiAgZ2VvbV9ib3hwbG90KCkNCg0KYm94MiArIGNvb3JkX2ZsaXAoKQ0KYGBgDQpgYGB7cn0NCiNWSU9MSU4NCiNWSU9MSU4NCmdncGxvdChkYXRvcykrDQphZXMoVFJBVDEsIERBTk8xLCBmaWxsID0gVFJBVDEpKw0KICBnZW9tX3Zpb2xpbigpDQpgYGANCmBgYHtyfQ0KI0JBUlJBUw0KZ2dwbG90KGRhdG9zKSArDQogIGFlcyhUUkFUMSwgREFOTzEsIGZpbGwgPSBUUkFUMSkrDQogIGdlb21fY29sKHBvc2l0aW9uID0gJ2RvZGdlJykNCmBgYA0KIyBIaXDDs3Rlc2lzDQoNCiQkSF8wIDogXG11IERfe2VzY2FsYX0gPSBcbXUgRF97aW1hamVqfSQkDQoNCiQkSF9hIDogSF8wIFx0ZXh0eyBlcyBmYWxzb30kJA0KIyBTdXB1ZXN0byBkZSB1bmEgc29sYSBwZW5kaWVudGUNCg0KYGBge3J9DQpzdXBMTSA9IGdncGxvdChkYXRvcykrDQogIGFlcyhEQU5PMSwgTE0sIGNvbG9yID0gVFJBVDEpKw0KICBnZW9tX3BvaW50KCkrDQogIGdlb21fc21vb3RoKG1ldGhvZCA9ICdsbScsIGZvcm11bGEgPSAneX54JywNCiAgICAgICAgICAgICAgc2U9IEYpKw0KICBnZW9tX3Ntb290aChtZXRob2QgPSAnbG0nLCBmb3JtdWxhID0gJ3l+eCcgLA0KICAgICAgICAgICAgICBzZSA9IEYsIGNvbCA9ICdibGFjaycpDQoNCnN1cExNDQpgYGANCg0KYGBge3J9DQpzdXBBTSA9IGdncGxvdChkYXRvcykrDQogIGFlcyhEQU5PMSwgQU0sIGNvbG9yID0gVFJBVDEpKw0KICBnZW9tX3BvaW50KCkrDQogIGdlb21fc21vb3RoKG1ldGhvZCA9ICdsbScsIGZvcm11bGEgPSAneX54JywNCiAgICAgICAgICAgICAgc2U9IEYpKw0KICBnZW9tX3Ntb290aChtZXRob2QgPSAnbG0nLCBmb3JtdWxhID0gJ3l+eCcgLA0KICAgICAgICAgICAgICBzZSA9IEYsIGNvbCA9ICdibGFjaycpDQoNCnN1cEFNDQpgYGANCg0KIyBBTk9WQQ0KYGBge3J9DQptb2QyID0gbG0oREFOTzEgfiBMTSArIFRSQVQxLA0KICAgICAgICAgIGRhdGEgPSBkYXRvcykNCmFub3ZhKG1vZDIpDQpgYGANCiMgU3VwdWVzdG9zDQpgYGB7cn0NCiNFWFRSQUVSIFJFU0lEVU9TDQpyZXMyID0gbW9kMiRyZXNpZHVhbHMNCg0KYGBgDQoNCmBgYHtyfQ0KIyAxIE5PUk1BTElEQUQgREUgTE9TIFJFU0lEVU9TDQojIFRFU1QgREUgU0hBUElSTw0Kc2hhcGlyby50ZXN0KHJlczIpDQpgYGANCmBgYHtyfQ0KIyAyIFBSVUVCQSBERSBIT01PQ0VEQVNUSUNJREFEDQojIFRFU1QgREUgQkFSVExFVFQNCmJhcnRsZXR0LnRlc3QocmVzMiwgVFJBVDEpDQpgYGANCmBgYHtyfQ0KIyBQQVRST04gREUgTE9TIFJFU0lEVUFMRVMNCnBsb3QoZGF0b3MkREFOTzEsIHJlczIsDQogICAgIHBjaCA9IDE2KQ0KYGBgDQoNCiMgTW9kZWxvDQoNCiQkWV97aWprfSA9IFxtdSArIFx0YXVfaSArIFxiZXRhX2ogKyBcZGVsdGFfayArIFxlcHNpbG9uX3tpamt9JCQNCg0KYGBge3J9DQptTE0gPSB0YXBwbHkoREFOTzEsIFRSQVQxLCBtZWFuKQ0KDQptTE0NCg0KYGBgDQoNCg==