file.choose()
[1] "C:\\Users\\HP\\Downloads\\MARIO.xlsx"
ruta_Ensamble <-"C:\\Users\\HP\\Downloads\\MARIO.xlsx"
excel_sheets(ruta_Ensamble)
[1] "VINOS POR PRUEBA FQ."
casoDBCA1<-read_excel(ruta_Ensamble)
print(casoDBCA1)

#Se crea un objeto tipo factor

VOL<-factor(casoDBCA1$VOLUMEN)
VAR<-factor(casoDBCA1$Variedad)

#Luego el vector TIEM se convierte a un vector ALT1 de tipo numérico

VOL1<-as.numeric(VOL)

#Diagrama de cajas de dispersión (Box plot)

par(mfrow=c(1,1))
boxplot(split(VOL1,VAR),xlab="variedad", ylab="Volumen")

resaov<-aov(VOL1 ~ VAR)
anova(resaov)
Analysis of Variance Table

Response: VOL1
          Df  Sum Sq Mean Sq F value Pr(>F)
VAR        6  339.71  56.619  0.7115 0.6438
Residuals 24 1909.96  79.582               
cv.model(resaov)
[1] 57.37486
euc.lm <- lm(VOL1 ~ VAR)
anova(euc.lm , test="F")
Analysis of Variance Table

Response: VOL1
          Df  Sum Sq Mean Sq F value Pr(>F)
VAR        6  339.71  56.619  0.7115 0.6438
Residuals 24 1909.96  79.582               
 shapiro.test(euc.lm$res)

    Shapiro-Wilk normality test

data:  euc.lm$res
W = 0.96325, p-value = 0.3548
fitb <- fitted(resaov)
res_stb <- rstandard(resaov)
plot(fitb,res_stb,xlab="Valores predichos", ylab="valores estandarizados",abline(h=0))

#Prueba de Levene

leveneTest(VOL1 ~ VAR, center = "median")
Levene's Test for Homogeneity of Variance (center = "median")
      Df F value Pr(>F)
group  6  0.3228 0.9185
      24               

6.- Pruebas de comparación múltiple de medias #Método de la diferencia mínima significativa, Least Significant Difference (LSD)

outLSD <-LSD.test(resaov, "VAR",console=TRUE)

Study: resaov ~ "VAR"

LSD t Test for VOL1 

Mean Square Error:  79.58183 

VAR,  means and individual ( 95 %) CI

Alpha: 0.05 ; DF Error: 24
Critical Value of t: 2.063899 

Groups according to probability of means differences and alpha level( 0.05 )

Treatments with the same letter are not significantly different.
SNK.test(resaov, "VAR",console=TRUE)

Study: resaov ~ "VAR"

Student Newman Keuls Test
for VOL1 

Mean Square Error:  79.58183 

VAR,  means

Groups according to probability of means differences and alpha level( 0.05 )

Means with the same letter are not significantly different.
duncan.test(resaov, "VAR",console=TRUE)

Study: resaov ~ "VAR"

Duncan's new multiple range test
for VOL1 

Mean Square Error:  79.58183 

VAR,  means

Groups according to probability of means differences and alpha level( 0.05 )

Means with the same letter are not significantly different.
LSD.test(resaov, "VAR", p.adj= "bon",console=TRUE)

Study: resaov ~ "VAR"

LSD t Test for VOL1 
P value adjustment method: bonferroni 

Mean Square Error:  79.58183 

VAR,  means and individual ( 95 %) CI

Alpha: 0.05 ; DF Error: 24
Critical Value of t: 3.395988 

Groups according to probability of means differences and alpha level( 0.05 )

Treatments with the same letter are not significantly different.
sk <- SK(resaov, which= "VAR",  dispersion="se", sig.level=0.05)
summary(sk)
Goups of means at sig.level = 0.05 
tukey_result <- TukeyHSD(resaov, "VAR", conf.level = 0.95)
print(tukey_result)
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = VOL1 ~ VAR)

$VAR
                                        diff        lwr      upr     p adj
Cabernet sauvignon-Cabernet Franc -6.6000000 -30.567485 17.36749 0.9715681
Carmenere-Cabernet Franc          -1.6000000 -32.980804 29.78080 0.9999980
Italia-Cabernet Franc             -4.9750000 -21.306088 11.35609 0.9540023
Malbeck-Cabernet Franc             5.0666667 -15.853870 25.98720 0.9850261
Negra Criolla-Cabernet Franc       0.1777778 -15.800546 16.15610 1.0000000
Syrah-Cabernet Franc               1.7333333 -19.187203 22.65387 0.9999639
Carmenere-Cabernet sauvignon       5.0000000 -30.084806 40.08481 0.9991607
Italia-Cabernet sauvignon          1.6250000 -21.022145 24.27214 0.9999845
Malbeck-Cabernet sauvignon        11.6666667 -14.484004 37.81734 0.7793182
Negra Criolla-Cabernet sauvignon   6.7777778 -15.616318 29.17187 0.9553747
Syrah-Cabernet sauvignon           8.3333333 -17.817337 34.48400 0.9434243
Italia-Carmenere                  -3.3750000 -33.759333 27.00933 0.9997993
Malbeck-Carmenere                  6.6666667 -26.411606 39.74494 0.9942844
Negra Criolla-Carmenere            1.7777778 -28.418415 31.97397 0.9999952
Syrah-Carmenere                    3.3333333 -29.744939 36.41161 0.9998861
Malbeck-Italia                    10.0416667  -9.352190 29.43552 0.6454740
Negra Criolla-Italia               5.1527778  -8.766979 19.07254 0.8916290
Syrah-Italia                       6.7083333 -12.685523 26.10219 0.9186204
Negra Criolla-Malbeck             -4.8888889 -23.986638 14.20886 0.9801776
Syrah-Malbeck                     -3.3333333 -26.723204 20.05654 0.9991607
Syrah-Negra Criolla                1.5555556 -17.542194 20.65330 0.9999673
plot(tukey_result)

LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpgYGB7cn0NCmZpbGUuY2hvb3NlKCkNCmBgYA0KYGBge3J9DQpydXRhX0Vuc2FtYmxlIDwtIkM6XFxVc2Vyc1xcSFBcXERvd25sb2Fkc1xcTUFSSU8ueGxzeCINCmBgYA0KDQpgYGB7cn0NCmV4Y2VsX3NoZWV0cyhydXRhX0Vuc2FtYmxlKQ0KYGBgDQpgYGB7cn0NCmNhc29EQkNBMTwtcmVhZF9leGNlbChydXRhX0Vuc2FtYmxlKQ0KYGBgDQoNCmBgYHtyfQ0KcHJpbnQoY2Fzb0RCQ0ExKQ0KYGBgDQojU2UgY3JlYSB1biBvYmpldG8gdGlwbyBmYWN0b3INCmBgYHtyfQ0KVk9MPC1mYWN0b3IoY2Fzb0RCQ0ExJFZPTFVNRU4pDQpgYGANCg0KYGBge3J9DQpWQVI8LWZhY3RvcihjYXNvREJDQTEkVmFyaWVkYWQpDQpgYGANCg0KI0x1ZWdvIGVsIHZlY3RvciBUSUVNIHNlIGNvbnZpZXJ0ZSBhIHVuIHZlY3RvciBBTFQxIGRlIHRpcG8gbnVtw6lyaWNvDQoNCmBgYHtyfQ0KVk9MMTwtYXMubnVtZXJpYyhWT0wpDQpgYGANCg0KI0RpYWdyYW1hIGRlIGNhamFzIGRlIGRpc3BlcnNpw7NuIChCb3ggcGxvdCkNCg0KYGBge3J9DQpwYXIobWZyb3c9YygxLDEpKQ0KYGBgDQoNCmBgYHtyfQ0KYm94cGxvdChzcGxpdChWT0wxLFZBUikseGxhYj0idmFyaWVkYWQiLCB5bGFiPSJWb2x1bWVuIikNCmBgYA0KDQpgYGB7cn0NCnJlc2FvdjwtYW92KFZPTDEgfiBWQVIpDQpgYGANCg0KYGBge3J9DQphbm92YShyZXNhb3YpDQpgYGANCg0KYGBge3J9DQpjdi5tb2RlbChyZXNhb3YpDQpgYGANCmBgYHtyfQ0KZXVjLmxtIDwtIGxtKFZPTDEgfiBWQVIpDQpgYGANCg0KDQpgYGB7cn0NCmFub3ZhKGV1Yy5sbSAsIHRlc3Q9IkYiKQ0KYGBgDQoNCmBgYHtyfQ0KIHNoYXBpcm8udGVzdChldWMubG0kcmVzKQ0KYGBgDQpgYGB7cn0NCmZpdGIgPC0gZml0dGVkKHJlc2FvdikNCmBgYA0KDQpgYGB7cn0NCnJlc19zdGIgPC0gcnN0YW5kYXJkKHJlc2FvdikNCmBgYA0KDQpgYGB7cn0NCnBsb3QoZml0YixyZXNfc3RiLHhsYWI9IlZhbG9yZXMgcHJlZGljaG9zIiwgeWxhYj0idmFsb3JlcyBlc3RhbmRhcml6YWRvcyIsYWJsaW5lKGg9MCkpDQpgYGANCg0KI1BydWViYSBkZSBMZXZlbmUNCg0KYGBge3J9DQpsZXZlbmVUZXN0KFZPTDEgfiBWQVIsIGNlbnRlciA9ICJtZWRpYW4iKQ0KYGBgDQoNCjYuLSBQcnVlYmFzIGRlIGNvbXBhcmFjacOzbiBtw7psdGlwbGUgZGUgbWVkaWFzICNNw6l0b2RvIGRlIGxhIGRpZmVyZW5jaWEgbcOtbmltYSBzaWduaWZpY2F0aXZhLCBMZWFzdCBTaWduaWZpY2FudCBEaWZmZXJlbmNlIChMU0QpDQoNCg0KYGBge3J9DQpvdXRMU0QgPC1MU0QudGVzdChyZXNhb3YsICJWQVIiLGNvbnNvbGU9VFJVRSkNCmBgYA0KDQpgYGB7cn0NClNOSy50ZXN0KHJlc2FvdiwgIlZBUiIsY29uc29sZT1UUlVFKQ0KYGBgDQpgYGB7cn0NCmR1bmNhbi50ZXN0KHJlc2FvdiwgIlZBUiIsY29uc29sZT1UUlVFKQ0KYGBgDQoNCmBgYHtyfQ0KTFNELnRlc3QocmVzYW92LCAiVkFSIiwgcC5hZGo9ICJib24iLGNvbnNvbGU9VFJVRSkNCmBgYA0KDQpgYGB7cn0NCnNrIDwtIFNLKHJlc2Fvdiwgd2hpY2g9ICJWQVIiLCAgZGlzcGVyc2lvbj0ic2UiLCBzaWcubGV2ZWw9MC4wNSkNCmBgYA0KDQpgYGB7cn0NCnN1bW1hcnkoc2spDQpgYGANCg0KYGBge3J9DQp0dWtleV9yZXN1bHQgPC0gVHVrZXlIU0QocmVzYW92LCAiVkFSIiwgY29uZi5sZXZlbCA9IDAuOTUpDQpgYGANCg0KYGBge3J9DQpwcmludCh0dWtleV9yZXN1bHQpDQpgYGANCmBgYHtyfQ0KcGxvdCh0dWtleV9yZXN1bHQpDQpgYGA=