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