library(readxl)
library(vegan)
## Loading required package: permute
## Loading required package: lattice
## This is vegan 2.5-6
datos <- read_excel("D:/X semestre/Fitomejoramiento/ejercicio/BASE DE DATOS EJERCICIO INTERACCCION GENOTIPO X AMBIENTE 2019 BBBBBBB.xlsx", col_types = c("text", "text", "text", "text", "numeric", "text"))
datos<-data.frame(datos)
(me.e<-tapply(datos$Rendimiento,list(datos$Localidad,datos$Semestre),mean))
## 1 2
## CARLOSAMA 32.16718 26.30423
## CUMBAL 36.63754 51.72437
(IA<-c(me.e-mean(datos$Rendimiento)))
## [1] -4.54115266 -0.07078478 -10.40409906 15.01603650
(d<-tapply(datos$Rendimiento, list(datos$Genotipo,datos$Localidad,datos$Semestre), mean))
## , , 1
##
## CARLOSAMA CUMBAL
## 1 26.77523 35.78620
## 2 31.17950 34.84241
## 4 34.67899 40.52165
## 50 31.25199 37.57723
## 51 27.62723 35.41900
## 52 33.56948 39.31775
## 59 37.71264 34.42398
## 63 34.50494 39.92124
## 64 33.45739 32.12657
## 9 30.91437 36.43942
##
## , , 2
##
## CARLOSAMA CUMBAL
## 1 31.90504 47.77180
## 2 24.97811 50.04622
## 4 24.89551 53.95180
## 50 23.82474 48.73239
## 51 24.46142 49.22324
## 52 28.76213 51.89171
## 59 25.87723 54.51174
## 63 31.78116 56.44512
## 64 24.37496 54.09870
## 9 22.18199 50.57094
betas<-c()
for (i in 1:10) {
betas[i]<-sum(c(d[i,,])*IA)/sum(IA**2)
}
betas
## [1] 0.7373321 0.9808388 1.1027849 0.9575532 1.0065432 0.9164193 1.0600299
## [8] 1.0086237 1.1416257 1.0882491
IAA<-c(rep(IA[1],40),rep(IA[2],40),rep(IA[3],40),rep(IA[4],40))
rend<-c(datos$Rendimiento)
dff<-data.frame("genotipo"=datos$Genotipo,IAA,rend)
genotipos<-c(1,2,4,50,51,52,59,63,64,9)
lll<-list()
plot(dff$IAA,dff$rend,col=1,xlab="IA",ylab="ton/ha",main="IGE")
s2<-c()
R2<-c()
beta0<-c()
miu<-c()
CME<-c()
for (i in 1:10) {
pos<-which(dff$genotipo==genotipos[i])
m<-lm(dff$rend[pos]~dff$IAA[pos])
abline(m,col=i)
lll[[i]]<-summary(m)
R2[i]<-lll[[i]]$r.squared
X<-matrix(c(rep(1,16),dff$IAA[pos]),16,2)
Y<-matrix(dff$rend[pos])
beta<-solve(t(X)%*%X)%*%(t(X)%*%Y)
beta0[i]<-beta[1,1]
miu[i]<-mean(c(d[i,,]))
CME[i] <- ((t(Y)%*%Y)-(t(beta)%*%t(X)%*%Y))/14
predichos<-function(x){ m$coefficients[1]+(m$coefficients[2]*x)}
s2[i]<-((sum(dff$rend[pos]**2)-((sum(dff$rend[pos])**2)/16)-((sum(dff$rend[pos]*dff$IAA[pos])**2)/(sum(dff$IAA[pos]**2))))/2)-35
}
legend(-10, 70, genotipos, cex=1, col=1:10, lty=1,bty="n",ncol = 2)

names(lll)<-c(1,2,4,50,51,52,59,63,64,9)
res<-data.frame("Genotipo"=levels(factor(datos$Genotipo)),"miu"=miu,"B0"=beta0,"Bi"=betas,"R2"=R2,s2,CME)
data.frame("Genotipo"=res[,1] ,round(res[,-1],2))
## Genotipo miu B0 Bi R2 s2 CME
## 1 1 35.56 35.56 0.74 0.38 590.48 89.35
## 2 2 35.26 35.26 0.98 0.84 97.21 18.89
## 3 4 38.51 38.51 1.10 0.83 142.81 25.40
## 4 50 35.35 35.35 0.96 0.71 226.75 37.39
## 5 51 34.18 34.18 1.01 0.78 171.91 29.56
## 6 52 38.39 38.39 0.92 0.75 165.61 28.66
## 7 59 38.13 38.13 1.06 0.69 318.48 50.50
## 8 63 40.66 40.66 1.01 0.81 138.65 24.81
## 9 64 36.01 36.01 1.14 0.84 134.62 24.23
## 10 9 35.03 35.03 1.09 0.81 161.67 28.10
m1<-aov(Rendimiento ~ Localidad*Semestre*Genotipo + Bloque,datos)
summary(m1)
## Df Sum Sq Mean Sq F value Pr(>F)
## Localidad 1 8934 8934 257.922 < 2e-16 ***
## Semestre 1 851 851 24.561 2.45e-06 ***
## Genotipo 9 619 69 1.985 0.0469 *
## Bloque 3 368 123 3.545 0.0168 *
## Localidad:Semestre 1 4389 4389 126.701 < 2e-16 ***
## Localidad:Genotipo 9 101 11 0.323 0.9661
## Semestre:Genotipo 9 178 20 0.570 0.8193
## Localidad:Semestre:Genotipo 9 467 52 1.499 0.1563
## Residuals 117 4053 35
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
library(stability)
df<-data.frame("Rendimiento"=datos$Rendimiento,"Bloque"=factor(datos$Bloque),"Genotipo"=factor(datos$Genotipo),"Env"=factor(datos$En))
er_anova(.data = df,.y = Rendimiento,.rep = Bloque,.gen = Genotipo,.env = Env)
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## [[1]]
## Analysis of Variance Table
##
## Response: .data[[Y]]
## Df Sum Sq Mean Sq F value Pr(>F)
## Env 3 14174.1 4724.7 37.0843 2.391e-06 ***
## Rep(Env) 12 1528.9 127.4 4.7571 3.316e-06 ***
## Gen 9 619.0 68.8 2.5680 0.01022 *
## Gen:Env 27 745.5 27.6 1.0310 0.43594
## Residuals 108 2892.5 26.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## $er_anova
## Df Sum Sq Mean Sq F value Pr(>F)
## Total 39 4112.1 105.4
## Gen 9 382.2 42.5 23.6322 9.058e-09 ***
## Env + (Gen x Env) 30 3729.9 124.3
## Env (linear) 1 3543.5 3543.5
## Gen x Env(linear) 9 150.4 16.7 9.3020 1.984e-05 ***
## Pooled deviation 20 35.9 1.8
## 1 2 11.8 5.9 0.9763 0.3797
## 2 2 0.1 0.0 0.0056 0.9944
## 4 2 2.9 1.4 0.2403 0.7868
## 50 2 2.2 1.1 0.1818 0.8340
## 51 2 1.6 0.8 0.1290 0.8791
## 52 2 0.4 0.2 0.0310 0.9695
## 59 2 8.6 4.3 0.7100 0.4937
## 63 2 1.5 0.7 0.1233 0.8841
## 64 2 5.6 2.8 0.4634 0.6303
## 9 2 1.5 0.7 0.1216 0.8856
## Pooled error 120 723.1 6.0
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
stab_reg(.data = df,.y = Rendimiento,.rep = Bloque,.gen = Genotipo,.env = Env)
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## Warning: Unknown or uninitialised column: '(weights)'.
## Warning: Unknown or uninitialised column: '(offset)'.
## $StabIndvReg
## # A tibble: 10 x 9
## Genotipo Mean Slope LCI UCI R.Sqr RMSE SSE Delta
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 35.6 0.737 -0.371 1.85 0.804 4.85 47.1 11.8
## 2 2 35.3 0.981 0.897 1.06 0.999 0.368 0.270 0.0675
## 3 4 38.5 1.10 0.553 1.65 0.974 2.41 11.6 2.90
## 4 50 35.3 0.958 0.479 1.44 0.974 2.09 8.76 2.19
## 5 51 34.2 1.01 0.604 1.41 0.983 1.76 6.22 1.55
## 6 52 38.4 0.916 0.719 1.11 0.995 0.865 1.50 0.374
## 7 59 38.1 1.06 0.114 2.01 0.921 4.14 34.2 8.56
## 8 63 40.7 1.01 0.615 1.40 0.984 1.72 5.94 1.49
## 9 64 36.0 1.14 0.378 1.91 0.954 3.34 22.3 5.58
## 10 9 35.0 1.09 0.697 1.48 0.986 1.71 5.86 1.47
##
## $MeanSlopePlot

stab_measures(.data = df,.y = Rendimiento,.gen = Genotipo,.env = Env)
## $StabMeasures
## # A tibble: 10 x 7
## Genotipo Mean GenSS Var CV Ecov ShuklaVar
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 35.6 240. 79.9 25.1 71.5 28.9
## 2 2 35.3 341. 114. 30.2 0.400 -0.696
## 3 4 38.5 443. 148. 31.5 15.3 5.52
## 4 50 35.3 334. 111. 29.8 9.40 3.06
## 5 51 34.2 365. 122. 32.3 6.23 1.73
## 6 52 38.4 299. 99.7 26.0 3.97 0.792
## 7 59 38.1 432. 144. 31.5 35.5 13.9
## 8 63 40.7 366. 122. 27.2 5.97 1.62
## 9 64 36.0 484. 161. 35.3 29.4 11.4
## 10 9 35.0 426. 142. 34.0 8.62 2.73
##
## $MeanVarPlot

##
## $MeanEcovPlot

##
## $MeanShuklaVarPlot

ammi(.data = df,.y = Rendimiento,.rep = Bloque,.gen = Genotipo,.env = Env)
## $anova
## Analysis of Variance Table
##
## Response: .data[[Y]]
## Df Sum Sq Mean Sq F value Pr(>F)
## Env 3 14174.1 4724.7 37.084 2.391e-06 ***
## Rep(Env) 12 1528.9 127.4
## Gen 9 619.0 68.8 2.568 0.01022 *
## Gen:Env 27 745.5 27.6 1.031 0.43594
## Residuals 108 2892.5 26.8
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## $pc.anova
## # A tibble: 4 x 9
## PC SingVal Percent accumPerc Df SS Mean.Sq F.value Pr..F.
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 PC1 1.12e+ 1 6.74e+ 1 67.4 11 5.02e+ 2 4.57e+ 1 1.70e+ 0 0.0816
## 2 PC2 7.11e+ 0 2.71e+ 1 94.5 9 2.02e+ 2 2.25e+ 1 8.39e- 1 0.582
## 3 PC3 3.20e+ 0 5.51e+ 0 100. 7 4.11e+ 1 5.87e+ 0 2.19e- 1 0.980
## 4 PC4 3.48e-15 6.48e-30 100. 5 4.83e-29 9.66e-30 3.61e-31 1
ammi_biplot(.data = df,.y = Rendimiento,.rep = Bloque,.gen = Genotipo,.env = Env)
## $aami.biplot

##
## $MeanPC1Plot
