1 Definições da sessão

#-----------------------------------------------------------------------
#                                            Prof. Dr. Walmes M. Zeviani
#                                leg.ufpr.br/~walmes · github.com/walmes
#                                        walmes@ufpr.br · @walmeszeviani
#                      Laboratory of Statistics and Geoinformation (LEG)
#                Department of Statistics · Federal University of Paraná
#                                       2021-fev-25 · Curitiba/PR/Brazil
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# Pacotes.

rm(list = objects())

library(emmeans)
library(tidyverse)
library(readxl)

2 Importação e preparo

#-----------------------------------------------------------------------
# Importação.

# Importação de tipagem das variáveis.
tb <- read_excel("teca raiz.xlsx",
                 skip = 1) %>%
    mutate(gen = factor(gen),
           block = factor(block),
           enraz = factor(enraz, levels = c("I", "II", "III", "IV")))
str(tb)
## tibble [111 × 13] (S3: tbl_df/tbl/data.frame)
##  $ index  : num [1:111] 1 2 3 4 5 6 7 8 9 10 ...
##  $ gen    : Factor w/ 37 levels "1101","1102",..: 12 7 22 37 6 35 32 8 34 24 ...
##  $ block  : Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 1 1 1 1 ...
##  $ altini : num [1:111] 6.5 6.5 11 9.5 4 7.5 7.5 10.5 17 9 ...
##  $ alt    : num [1:111] 85 109 105 52 59 42 149 59 101 155 ...
##  $ diamini: num [1:111] 6.95 3.9 4.58 7.33 4.97 ...
##  $ diam   : num [1:111] 27.4 20.8 25.2 11.9 17.1 ...
##  $ mffol  : num [1:111] 456 231 272 161 172 ...
##  $ mfcau  : num [1:111] 434.8 199.8 276.1 56.5 126.2 ...
##  $ msfol  : num [1:111] 193 96 120.8 61 55.5 ...
##  $ mscau  : num [1:111] 206 73.6 131.6 26.3 54.9 ...
##  $ msraiz : num [1:111] NA 87.3 104.8 37.9 82.3 ...
##  $ enraz  : Factor w/ 4 levels "I","II","III",..: 4 2 3 1 2 1 2 3 3 2 ...
# Cruzamento com níveis da variável resposta qualitativa.
xtabs(~gen + enraz, data = tb) %>%
    addmargins()
##            enraz
## gen           I  II III  IV Sum
##   1101        0   1   1   1   3
##   1102        1   2   0   0   3
##   1106        3   0   0   0   3
##   1114        0   2   1   0   3
##   1328        1   1   1   0   3
##   1507        0   2   0   1   3
##   2011        2   1   0   0   3
##   3105        0   2   1   0   3
##   3408        3   0   0   0   3
##   4008        3   0   0   0   3
##   4010        0   1   1   0   2
##   4013        0   1   1   1   3
##   4015        0   0   1   2   3
##   4016        2   0   1   0   3
##   4017        0   2   0   1   3
##   4018        2   1   0   0   3
##   BT 86       0   2   1   0   3
##   BT 93       0   3   0   0   3
##   BT21        1   0   1   1   3
##   BT27        3   0   0   0   3
##   BT61        0   1   0   1   2
##   Bt62        0   1   1   0   2
##   BT63        0   0   0   2   2
##   BT64        0   3   0   0   3
##   BT68        0   0   3   0   3
##   BT70        3   0   0   0   3
##   BT72        0   2   1   0   3
##   BT82        2   1   0   0   3
##   BT83        2   0   1   0   3
##   BT85        0   1   1   1   3
##   BT85 PLUS   0   3   0   0   3
##   BT90        0   2   0   1   3
##   BT96        0   3   0   0   3
##   BT98        0   0   2   1   3
##   FV03        2   1   0   0   3
##   FV05        0   1   1   1   3
##   FV10        3   0   0   0   3
##   Sum        33  40  20  14 107
tb_means <- list()

3 Altura de planta (cm)

#-----------------------------------------------------------------------

# Declaração do modelo de ANCOVA.
m0 <- lm(alt ~ altini + block + gen, data = tb)

# Avaliação dos pressupostos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de anova.
anova(m0)
## Analysis of Variance Table
## 
## Response: alt
##           Df Sum Sq Mean Sq F value   Pr(>F)   
## altini     1    160  159.64  0.2107 0.647633   
## block      2   3246 1622.83  2.1417 0.124979   
## gen       36  60314 1675.39  2.2111 0.002205 **
## Residuals 71  53798  757.72                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen       emmean   SE df lower.CL upper.CL .group
##  BT82        54.3 15.9 71     1.37      107  a    
##  3105        55.6 15.9 71     2.69      109  a    
##  1114        59.0 15.9 71     6.04      112  ab   
##  FV03        68.1 16.5 71    13.11      123  ab   
##  3408        71.1 16.7 71    15.42      127  ab   
##  1328        72.9 16.1 71    19.31      126  ab   
##  FV10        73.9 15.9 71    21.01      127  ab   
##  BT61        75.7 16.5 71    20.98      131  ab   
##  BT21        78.3 15.9 71    25.26      131  ab   
##  4018        78.9 15.9 71    26.04      132  ab   
##  4015        79.0 16.0 71    25.60      132  ab   
##  1507        80.7 17.4 71    22.87      139  ab   
##  4017        81.3 16.0 71    28.18      134  ab   
##  1102        81.6 15.9 71    28.66      135  ab   
##  4016        83.9 16.0 71    30.72      137  ab   
##  FV05        85.0 16.3 71    30.76      139  ab   
##  BT68        87.5 16.3 71    33.39      142  ab   
##  4008        90.5 16.4 71    36.04      145  ab   
##  4010        91.0 16.1 71    37.50      145  ab   
##  BT72        91.6 15.9 71    38.64      145  ab   
##  BT85        94.0 16.0 71    40.60      147  ab   
##  BT85 PLUS   96.0 16.0 71    42.60      149  ab   
##  BT70        99.6 16.0 71    46.30      153  ab   
##  BT98       100.5 17.4 71    42.73      158  ab   
##  4013       104.9 15.9 71    52.01      158  ab   
##  BT83       108.3 15.9 71    55.34      161  ab   
##  BT96       109.3 15.9 71    56.38      162  ab   
##  BT27       111.9 15.9 71    58.97      165  ab   
##  1101       112.7 16.4 71    58.16      167  ab   
##  Bt62       122.7 16.0 71    69.44      176  ab   
##  1106       124.4 16.3 71    70.00      179  ab   
##  BT63       125.1 16.4 71    70.49      180  ab   
##  BT90       126.5 16.5 71    71.65      181  ab   
##  BT 93      133.6 16.8 71    77.88      189  ab   
##  2011       134.1 16.5 71    79.21      189  ab   
##  BT64       141.6 15.9 71    88.70      195   b   
##  BT 86      142.7 16.2 71    88.79      197   b   
## 
## Results are averaged over the levels of: block 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means$alt <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.0f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "Altura de plantas (cm)")

#-----------------------------------------------------------------------

4 Diâmetro do caule (mm)

#-----------------------------------------------------------------------

# Declaração do modelo de ANCOVA.
m0 <- lm(diam ~ diamini + block + gen, data = tb)

# Avaliação dos pressupostos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de anova.
anova(m0)
## Analysis of Variance Table
## 
## Response: diam
##           Df  Sum Sq Mean Sq F value   Pr(>F)   
## diamini    1   72.91  72.908  4.3637 0.040298 * 
## block      2  170.30  85.151  5.0965 0.008546 **
## gen       36  896.93  24.915  1.4912 0.076076 . 
## Residuals 71 1186.26  16.708                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen       emmean   SE df lower.CL upper.CL .group
##  FV10        13.3 2.41 71     5.32     21.4  a    
##  3105        13.6 2.46 71     5.38     21.8  a    
##  BT82        13.6 2.48 71     5.38     21.9  a    
##  4016        15.6 2.43 71     7.49     23.7  a    
##  4015        15.8 2.54 71     7.37     24.3  a    
##  BT70        16.9 2.36 71     9.05     24.8  a    
##  1101        17.6 2.36 71     9.71     25.4  a    
##  4008        17.9 2.37 71     9.96     25.8  a    
##  BT72        18.0 2.36 71    10.08     25.8  a    
##  4017        18.0 2.36 71    10.12     25.8  a    
##  4010        18.7 2.43 71    10.63     26.8  a    
##  BT96        19.2 2.41 71    11.14     27.2  a    
##  3408        19.3 2.37 71    11.37     27.1  a    
##  4018        19.4 2.36 71    11.53     27.2  a    
##  1114        20.0 2.38 71    12.13     28.0  a    
##  BT21        20.4 2.37 71    12.48     28.2  a    
##  1106        20.5 2.37 71    12.55     28.4  a    
##  BT63        20.5 2.37 71    12.58     28.3  a    
##  BT98        20.8 2.36 71    12.91     28.6  a    
##  BT61        20.9 2.36 71    13.04     28.8  a    
##  FV05        21.3 2.36 71    13.44     29.2  a    
##  BT85 PLUS   21.6 2.44 71    13.43     29.7  a    
##  1102        21.8 2.38 71    13.84     29.7  a    
##  1507        21.8 2.38 71    13.87     29.7  a    
##  BT85        21.8 2.53 71    13.41     30.2  a    
##  BT83        21.9 2.36 71    14.04     29.8  a    
##  BT68        22.0 2.36 71    14.14     29.9  a    
##  FV03        22.0 2.38 71    14.10     29.9  a    
##  BT 93       22.1 2.38 71    14.15     30.0  a    
##  BT27        22.3 2.46 71    14.08     30.5  a    
##  BT90        22.6 2.52 71    14.18     31.0  a    
##  BT 86       22.8 2.36 71    14.98     30.7  a    
##  1328        22.9 2.37 71    15.02     30.8  a    
##  BT64        23.9 2.43 71    15.78     32.0  a    
##  4013        24.0 2.45 71    15.84     32.2  a    
##  2011        24.5 2.42 71    16.43     32.5  a    
##  Bt62        25.0 2.40 71    17.03     33.0  a    
## 
## Results are averaged over the levels of: block 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means$diam <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.0f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "Diâmetro do caule (mm)")

#-----------------------------------------------------------------------

5 Massa fresca de folhas (g)

#-----------------------------------------------------------------------

# Declaração do modelo de ANCOVA.
m0 <- lm(mffol ~ block + gen, data = tb)
MASS::boxcox(m0)

m0 <- update(m0, formula = log(.) ~ .)

# Avaliação dos pressupostos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de anova.
anova(m0)
## Analysis of Variance Table
## 
## Response: log(mffol)
##           Df Sum Sq Mean Sq F value Pr(>F)  
## block      2 0.3013 0.15066  1.3401 0.2683  
## gen       36 6.1748 0.17152  1.5256 0.0645 .
## Residuals 72 8.0948 0.11243                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen       emmean    SE df lower.CL upper.CL .group
##  4016        4.79 0.194 72     4.14     5.43  a    
##  BT82        4.81 0.194 72     4.16     5.45  a    
##  1328        4.89 0.194 72     4.25     5.53  a    
##  4010        4.93 0.194 72     4.29     5.58  a    
##  BT21        5.00 0.194 72     4.35     5.64  a    
##  1102        5.03 0.194 72     4.39     5.67  a    
##  4015        5.06 0.194 72     4.41     5.70  a    
##  3105        5.07 0.194 72     4.42     5.71  a    
##  4018        5.08 0.194 72     4.44     5.72  a    
##  1114        5.11 0.194 72     4.47     5.76  a    
##  BT96        5.12 0.194 72     4.48     5.77  a    
##  BT70        5.13 0.194 72     4.49     5.77  a    
##  BT68        5.15 0.194 72     4.51     5.80  a    
##  FV10        5.18 0.194 72     4.54     5.83  a    
##  BT72        5.18 0.194 72     4.54     5.83  a    
##  4017        5.21 0.194 72     4.57     5.86  a    
##  1106        5.25 0.194 72     4.61     5.89  a    
##  FV03        5.25 0.194 72     4.61     5.90  a    
##  3408        5.27 0.194 72     4.62     5.91  a    
##  BT 93       5.28 0.194 72     4.64     5.92  a    
##  1507        5.29 0.194 72     4.64     5.93  a    
##  BT98        5.29 0.194 72     4.65     5.94  a    
##  1101        5.31 0.194 72     4.67     5.96  a    
##  BT85        5.38 0.194 72     4.74     6.03  a    
##  BT 86       5.40 0.194 72     4.75     6.04  a    
##  BT64        5.40 0.194 72     4.76     6.04  a    
##  4008        5.46 0.194 72     4.82     6.11  a    
##  Bt62        5.47 0.194 72     4.82     6.11  a    
##  BT27        5.50 0.194 72     4.86     6.15  a    
##  BT85 PLUS   5.50 0.194 72     4.86     6.15  a    
##  BT63        5.51 0.194 72     4.86     6.15  a    
##  2011        5.51 0.194 72     4.86     6.15  a    
##  BT61        5.54 0.194 72     4.90     6.19  a    
##  BT83        5.59 0.194 72     4.94     6.23  a    
##  BT90        5.66 0.194 72     5.01     6.30  a    
##  4013        5.66 0.194 72     5.01     6.30  a    
##  FV05        5.69 0.194 72     5.05     6.34  a    
## 
## Results are averaged over the levels of: block 
## Results are given on the log (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means$log_mffol <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.0f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "log da massa fresca de folhas (g)")

#-----------------------------------------------------------------------

6 Massa fresca de caules (g)

#-----------------------------------------------------------------------

# Declaração do modelo de ANCOVA.
m0 <- lm(mfcau ~ block + gen, data = tb)
MASS::boxcox(m0)

m0 <- update(m0, formula = log(.) ~ .)

# Avaliação dos pressupostos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de anova.
anova(m0)
## Analysis of Variance Table
## 
## Response: log(mfcau)
##           Df  Sum Sq  Mean Sq F value  Pr(>F)  
## block      2  0.0574 0.028707  0.1641 0.84895  
## gen       36 11.2631 0.312863  1.7888 0.01832 *
## Residuals 72 12.5932 0.174906                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen       emmean    SE df lower.CL upper.CL .group
##  BT82        4.35 0.241 72     3.55     5.15  a    
##  FV10        4.36 0.241 72     3.55     5.16  a    
##  3105        4.41 0.241 72     3.61     5.21  a    
##  4016        4.79 0.241 72     3.99     5.59  a    
##  4017        4.86 0.241 72     4.05     5.66  a    
##  4015        4.89 0.241 72     4.09     5.70  a    
##  3408        4.90 0.241 72     4.09     5.70  a    
##  1114        4.92 0.241 72     4.11     5.72  a    
##  4008        4.95 0.241 72     4.14     5.75  a    
##  4018        4.95 0.241 72     4.14     5.75  a    
##  1101        4.96 0.241 72     4.16     5.77  a    
##  BT21        4.98 0.241 72     4.18     5.78  a    
##  4010        5.02 0.241 72     4.21     5.82  a    
##  BT70        5.09 0.241 72     4.29     5.90  a    
##  BT98        5.11 0.241 72     4.31     5.91  a    
##  BT68        5.12 0.241 72     4.31     5.92  a    
##  BT85 PLUS   5.16 0.241 72     4.36     5.97  a    
##  BT96        5.20 0.241 72     4.40     6.01  a    
##  1102        5.21 0.241 72     4.41     6.01  a    
##  1106        5.21 0.241 72     4.41     6.02  a    
##  1328        5.22 0.241 72     4.41     6.02  a    
##  FV03        5.23 0.241 72     4.43     6.04  a    
##  1507        5.26 0.241 72     4.46     6.06  a    
##  BT 93       5.26 0.241 72     4.46     6.07  a    
##  BT27        5.26 0.241 72     4.46     6.07  a    
##  BT72        5.29 0.241 72     4.49     6.09  a    
##  BT61        5.37 0.241 72     4.57     6.17  a    
##  FV05        5.40 0.241 72     4.60     6.20  a    
##  BT90        5.40 0.241 72     4.60     6.21  a    
##  BT83        5.40 0.241 72     4.60     6.21  a    
##  BT64        5.44 0.241 72     4.64     6.24  a    
##  BT85        5.46 0.241 72     4.65     6.26  a    
##  4013        5.53 0.241 72     4.73     6.33  a    
##  Bt62        5.55 0.241 72     4.75     6.35  a    
##  BT63        5.56 0.241 72     4.75     6.36  a    
##  2011        5.59 0.241 72     4.78     6.39  a    
##  BT 86       5.61 0.241 72     4.80     6.41  a    
## 
## Results are averaged over the levels of: block 
## Results are given on the log (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means$log_mfcau <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.0f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "log da massa fresca de caules (g)")

#-----------------------------------------------------------------------

7 Massa seca de folhas (g)

#-----------------------------------------------------------------------

# Declaração do modelo de ANCOVA.
m0 <- lm(msfol ~ block + gen, data = tb)
MASS::boxcox(m0)

m0 <- update(m0, formula = log(.) ~ .)

# Avaliação dos pressupostos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de anova.
anova(m0)
## Analysis of Variance Table
## 
## Response: log(msfol)
##           Df Sum Sq Mean Sq F value  Pr(>F)  
## block      2 0.4683 0.23417  1.8659 0.16216  
## gen       36 8.0170 0.22270  1.7745 0.01966 *
## Residuals 72 9.0357 0.12549                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen       emmean    SE df lower.CL upper.CL .group
##  4016        3.78 0.205 72     3.10     4.46  a    
##  BT82        3.80 0.205 72     3.12     4.48  a    
##  3105        3.99 0.205 72     3.31     4.67  a    
##  1102        4.02 0.205 72     3.34     4.70  a    
##  4015        4.16 0.205 72     3.48     4.84  a    
##  4018        4.16 0.205 72     3.48     4.84  a    
##  FV10        4.18 0.205 72     3.50     4.86  a    
##  1328        4.18 0.205 72     3.50     4.86  a    
##  BT21        4.19 0.205 72     3.51     4.87  a    
##  4017        4.24 0.205 72     3.56     4.92  a    
##  1114        4.24 0.205 72     3.56     4.92  a    
##  3408        4.29 0.205 72     3.61     4.97  a    
##  BT96        4.29 0.205 72     3.61     4.98  a    
##  BT68        4.30 0.205 72     3.62     4.98  a    
##  1101        4.32 0.205 72     3.64     5.00  a    
##  4010        4.34 0.205 72     3.66     5.02  a    
##  BT85        4.37 0.205 72     3.69     5.05  a    
##  BT72        4.39 0.205 72     3.71     5.07  a    
##  1106        4.40 0.205 72     3.72     5.08  a    
##  BT70        4.40 0.205 72     3.72     5.08  a    
##  BT98        4.42 0.205 72     3.74     5.10  a    
##  1507        4.42 0.205 72     3.74     5.10  a    
##  FV03        4.43 0.205 72     3.74     5.11  a    
##  4008        4.47 0.205 72     3.79     5.15  a    
##  BT 86       4.53 0.205 72     3.85     5.21  a    
##  BT61        4.58 0.205 72     3.90     5.26  a    
##  BT90        4.61 0.205 72     3.93     5.29  a    
##  BT 93       4.65 0.205 72     3.97     5.33  a    
##  BT63        4.65 0.205 72     3.97     5.33  a    
##  BT83        4.67 0.205 72     3.99     5.35  a    
##  BT85 PLUS   4.69 0.205 72     4.01     5.37  a    
##  Bt62        4.69 0.205 72     4.01     5.37  a    
##  BT27        4.74 0.205 72     4.06     5.42  a    
##  BT64        4.74 0.205 72     4.06     5.42  a    
##  2011        4.81 0.205 72     4.13     5.49  a    
##  4013        4.84 0.205 72     4.16     5.52  a    
##  FV05        4.84 0.205 72     4.16     5.52  a    
## 
## Results are averaged over the levels of: block 
## Results are given on the log (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means$log_msfol <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.0f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "log da seca de folhas (g)")

#-----------------------------------------------------------------------

8 Massa seca de caules (g)

#-----------------------------------------------------------------------

# Declaração do modelo de ANCOVA.
m0 <- lm(mscau ~ block + gen, data = tb)
MASS::boxcox(m0)

m0 <- update(m0, formula = log(.) ~ .)

# Avaliação dos pressupostos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de anova.
anova(m0)
## Analysis of Variance Table
## 
## Response: log(mscau)
##           Df  Sum Sq Mean Sq F value   Pr(>F)   
## block      2  0.1292 0.06462  0.3698 0.692179   
## gen       36 12.4827 0.34674  1.9843 0.006857 **
## Residuals 72 12.5814 0.17474                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen       emmean    SE df lower.CL upper.CL .group
##  FV10        3.48 0.241 72     2.68     4.28  a    
##  BT82        3.50 0.241 72     2.69     4.30  ab   
##  3105        3.50 0.241 72     2.70     4.31  ab   
##  4016        3.91 0.241 72     3.11     4.71  ab   
##  1114        3.93 0.241 72     3.13     4.73  ab   
##  4017        4.01 0.241 72     3.21     4.81  ab   
##  4015        4.02 0.241 72     3.22     4.83  ab   
##  1106        4.04 0.241 72     3.23     4.84  ab   
##  4018        4.07 0.241 72     3.27     4.87  ab   
##  3408        4.09 0.241 72     3.29     4.89  ab   
##  4008        4.12 0.241 72     3.32     4.93  ab   
##  BT21        4.15 0.241 72     3.35     4.95  ab   
##  BT70        4.20 0.241 72     3.39     5.00  ab   
##  4010        4.21 0.241 72     3.40     5.01  ab   
##  1102        4.21 0.241 72     3.40     5.01  ab   
##  1328        4.21 0.241 72     3.41     5.01  ab   
##  1101        4.23 0.241 72     3.43     5.03  ab   
##  BT98        4.26 0.241 72     3.46     5.06  ab   
##  BT85 PLUS   4.28 0.241 72     3.47     5.08  ab   
##  FV03        4.29 0.241 72     3.48     5.09  ab   
##  BT72        4.31 0.241 72     3.51     5.12  ab   
##  BT68        4.36 0.241 72     3.56     5.16  ab   
##  BT96        4.39 0.241 72     3.59     5.20  ab   
##  BT27        4.40 0.241 72     3.60     5.21  ab   
##  1507        4.45 0.241 72     3.64     5.25  ab   
##  BT61        4.51 0.241 72     3.71     5.31  ab   
##  BT 93       4.53 0.241 72     3.73     5.33  ab   
##  BT83        4.53 0.241 72     3.73     5.33  ab   
##  BT85        4.54 0.241 72     3.74     5.34  ab   
##  FV05        4.54 0.241 72     3.74     5.34  ab   
##  BT90        4.55 0.241 72     3.74     5.35  ab   
##  2011        4.68 0.241 72     3.87     5.48  ab   
##  BT63        4.70 0.241 72     3.90     5.51  ab   
##  4013        4.74 0.241 72     3.93     5.54  ab   
##  BT 86       4.74 0.241 72     3.94     5.54  ab   
##  BT64        4.78 0.241 72     3.97     5.58   b   
##  Bt62        4.78 0.241 72     3.97     5.58   b   
## 
## Results are averaged over the levels of: block 
## Results are given on the log (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means$log_mscau <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.0f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "log da seca de caules (g)")

#-----------------------------------------------------------------------

9 Massa seca de raizes (g)

#-----------------------------------------------------------------------

# Declaração do modelo de ANCOVA.
m0 <- lm(msraiz ~ block + gen, data = tb)
MASS::boxcox(m0)

m0 <- update(m0, formula = log(.) ~ .)

# Avaliação dos pressupostos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de anova.
anova(m0)
## Analysis of Variance Table
## 
## Response: log(msraiz)
##           Df Sum Sq  Mean Sq F value    Pr(>F)    
## block      2 0.3177 0.158873  1.7371 0.1834354    
## gen       36 7.8000 0.216667  2.3689 0.0009788 ***
## Residuals 71 6.4938 0.091461                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen       emmean    SE df lower.CL upper.CL .group
##  FV10        3.70 0.175 71     3.12     4.29  a    
##  3105        3.81 0.175 71     3.23     4.39  a    
##  BT82        3.93 0.175 71     3.35     4.51  ab   
##  3408        4.04 0.175 71     3.46     4.63  abc  
##  4016        4.05 0.175 71     3.47     4.63  abc  
##  4008        4.07 0.175 71     3.48     4.65  abc  
##  BT90        4.11 0.175 71     3.53     4.69  abc  
##  BT70        4.14 0.175 71     3.56     4.73  abc  
##  1101        4.20 0.175 71     3.62     4.78  abc  
##  4015        4.24 0.175 71     3.66     4.82  abc  
##  4017        4.25 0.175 71     3.67     4.83  abc  
##  4013        4.30 0.215 71     3.59     5.02  abc  
##  BT85 PLUS   4.31 0.175 71     3.73     4.90  abc  
##  BT72        4.32 0.175 71     3.74     4.90  abc  
##  1507        4.32 0.175 71     3.74     4.90  abc  
##  1102        4.33 0.175 71     3.74     4.91  abc  
##  BT61        4.33 0.175 71     3.75     4.91  abc  
##  1114        4.35 0.175 71     3.77     4.94  abc  
##  BT98        4.38 0.175 71     3.79     4.96  abc  
##  4018        4.38 0.175 71     3.80     4.96  abc  
##  BT96        4.40 0.175 71     3.82     4.98  abc  
##  1106        4.40 0.175 71     3.82     4.98  abc  
##  BT21        4.42 0.175 71     3.84     5.00  abc  
##  1328        4.42 0.175 71     3.84     5.01  abc  
##  2011        4.43 0.175 71     3.85     5.01  abc  
##  BT27        4.52 0.175 71     3.93     5.10  abc  
##  BT83        4.54 0.175 71     3.96     5.12  abc  
##  BT 93       4.56 0.175 71     3.98     5.14  abc  
##  Bt62        4.56 0.175 71     3.98     5.15  abc  
##  BT68        4.57 0.175 71     3.99     5.15  abc  
##  FV03        4.59 0.175 71     4.01     5.17  abc  
##  BT 86       4.61 0.175 71     4.03     5.19  abc  
##  BT85        4.62 0.175 71     4.04     5.20  abc  
##  4010        4.62 0.175 71     4.04     5.21  abc  
##  FV05        4.84 0.175 71     4.26     5.42   bc  
##  BT63        4.87 0.175 71     4.29     5.45    c  
##  BT64        4.89 0.175 71     4.31     5.47    c  
## 
## Results are averaged over the levels of: block 
## Results are given on the log (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means$log_msraiz <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.0f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "log da massa fresca de raizes (g)")

#-----------------------------------------------------------------------

10 Grau de enraizamento

10.1 Análise com ordinal logistic regression

#-----------------------------------------------------------------------

library(MASS)

# Determina os genótipos que não tem variação.
g <- tb %>%
    group_by(gen) %>%
    summarise(a = diff(range(as.integer(enraz))),
              b = all(enraz == "I") | all(enraz == "IV")) %>%
    ungroup() %>%
    filter(!b) %>%
    pull(gen)

# filter(tb, !is.element(gen, g)) %>%
#     arrange(gen, block, enraz) %>%
#     dplyr::select(gen, block, enraz)

# Genótipos que todas as repetições e uma das classes extremas.
filter(tb, !is.element(gen, g)) %>%
    distinct(gen, enraz)
## # A tibble: 8 x 2
##   gen   enraz
##   <fct> <fct>
## 1 FV10  I    
## 2 BT70  I    
## 3 BT63  IV   
## 4 BT27  I    
## 5 3408  I    
## 6 4008  I    
## 7 1106  I    
## 8 BT63  <NA>
# Regressão logística ordinal.
m0 <- polr(enraz ~ block + gen,
           data = droplevels(filter(tb, is.element(gen, g))),
           # data = tb,
           Hess = TRUE)
m_null <- update(m0, formula = . ~ block)

# class(m0)
# methods(class = "polr")

# Teste para o efeito dos genótipos.
anova(m0, m_null)
## Likelihood ratio tests of ordinal regression models
## 
## Response: enraz
##         Model Resid. df Resid. Dev   Test    Df LR stat.     Pr(Chi)
## 1       block        82   220.5416                                  
## 2 block + gen        53   162.4829 1 vs 2    29  58.0587 0.001070333
# Resumo do modelo.
summary(m0)
## Call:
## polr(formula = enraz ~ block + gen, data = droplevels(filter(tb, 
##     is.element(gen, g))), Hess = TRUE)
## 
## Coefficients:
##                   Value Std. Error    t value
## block2        1.079e-01     0.5233  2.061e-01
## block3        6.413e-01     0.5601  1.145e+00
## gen1102      -4.085e+00     1.7098 -2.389e+00
## gen1114      -1.662e+00     1.5864 -1.047e+00
## gen1328      -2.939e+00     1.8526 -1.587e+00
## gen1507      -1.019e+00     1.6602 -6.136e-01
## gen2011      -5.364e+00     1.7972 -2.985e+00
## gen3105      -1.638e+00     1.6133 -1.015e+00
## gen4010      -9.468e-01     1.7200 -5.505e-01
## gen4013       5.022e-05     1.6207  3.099e-05
## gen4015       1.701e+00     1.6642  1.022e+00
## gen4016      -4.542e+00     1.8673 -2.432e+00
## gen4017      -1.019e+00     1.6602 -6.136e-01
## gen4018      -5.366e+00     1.7962 -2.988e+00
## genBT 86     -1.662e+00     1.5864 -1.047e+00
## genBT 93     -2.809e+00     1.6852 -1.667e+00
## genBT21      -5.272e-01     1.7243 -3.058e-01
## genBT61       1.668e-01     1.9460  8.571e-02
## genBt62      -9.468e-01     1.7200 -5.505e-01
## genBT64      -2.809e+00     1.6852 -1.667e+00
## genBT68      -5.182e-02     1.4653 -3.536e-02
## genBT72      -1.662e+00     1.5864 -1.047e+00
## genBT82      -5.364e+00     1.7972 -2.985e+00
## genBT83      -4.542e+00     1.8673 -2.432e+00
## genBT85      -1.379e-01     1.6028 -8.606e-02
## genBT85 PLUS -2.809e+00     1.6852 -1.667e+00
## genBT90      -1.140e+00     1.7158 -6.646e-01
## genBT96      -2.809e+00     1.6852 -1.667e+00
## genBT98       6.302e-01     1.5308  4.117e-01
## genFV03      -5.366e+00     1.7962 -2.988e+00
## genFV05       3.026e-02     1.6227  1.865e-02
## 
## Intercepts:
##        Value   Std. Error t value
## I|II   -4.3947  1.3457    -3.2658
## II|III -0.7227  1.2169    -0.5939
## III|IV  1.1175  1.2134     0.9209
## 
## Residual Deviance: 162.4829 
## AIC: 230.4829 
## (3 observations deleted due to missingness)
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen        emmean    SE  df asymp.LCL asymp.UCL .group
##  FV03      -3.7831 1.297 Inf    -7.853     0.287  a    
##  4018      -3.7831 1.297 Inf    -7.853     0.287  a    
##  2011      -3.7815 1.298 Inf    -7.854     0.291  a    
##  BT82      -3.7815 1.298 Inf    -7.854     0.291  a    
##  BT83      -2.9588 1.408 Inf    -7.375     1.457  ab   
##  4016      -2.9588 1.408 Inf    -7.375     1.457  ab   
##  1102      -2.5019 1.187 Inf    -6.225     1.221  ab   
##  1328      -1.3565 1.413 Inf    -5.790     3.077  ab   
##  BT 93     -1.2261 1.190 Inf    -4.958     2.506  ab   
##  BT64      -1.2261 1.190 Inf    -4.958     2.506  ab   
##  BT85 PLUS -1.2261 1.190 Inf    -4.958     2.506  ab   
##  BT96      -1.2261 1.190 Inf    -4.958     2.506  ab   
##  BT 86     -0.0785 1.088 Inf    -3.492     3.335  ab   
##  BT72      -0.0785 1.088 Inf    -3.492     3.335  ab   
##  1114      -0.0785 1.088 Inf    -3.492     3.335  ab   
##  3105      -0.0547 1.131 Inf    -3.601     3.492  ab   
##  BT90       0.4427 1.269 Inf    -3.537     4.423  ab   
##  1507       0.5644 1.205 Inf    -3.217     4.345  ab   
##  4017       0.5644 1.205 Inf    -3.217     4.345  ab   
##  4010       0.6362 1.294 Inf    -3.424     4.696  ab   
##  Bt62       0.6362 1.294 Inf    -3.424     4.696  ab   
##  BT21       1.0558 1.309 Inf    -3.052     5.163  ab   
##  BT85       1.4451 1.130 Inf    -2.100     4.990  ab   
##  BT68       1.5312 0.933 Inf    -1.394     4.456  ab   
##  1101       1.5830 1.169 Inf    -2.084     5.250  ab   
##  4013       1.5831 1.169 Inf    -2.084     5.250  ab   
##  FV05       1.6133 1.163 Inf    -2.035     5.262  ab   
##  BT61       1.7498 1.591 Inf    -3.240     6.739  ab   
##  BT98       2.2132 1.034 Inf    -1.030     5.457  ab   
##  4015       3.2844 1.230 Inf    -0.574     7.143   b   
## 
## Results are averaged over the levels of: block 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 30 estimates 
## P value adjustment: tukey method for comparing a family of 30 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean),
           .group = str_trim(.group))
tb_emm
##          gen      emmean        SE  df asymp.LCL asymp.UCL .group
## 29      FV03 -3.78309031 1.2973931 Inf -7.852688 0.2865077      a
## 13      4018 -3.78309031 1.2973931 Inf -7.852688 0.2865077      a
## 6       2011 -3.78146496 1.2982471 Inf -7.853742 0.2908120      a
## 22      BT82 -3.78146496 1.2982471 Inf -7.853742 0.2908120      a
## 23      BT83 -2.95881903 1.4078387 Inf -7.374857 1.4572194     ab
## 11      4016 -2.95881903 1.4078387 Inf -7.374857 1.4572194     ab
## 2       1102 -2.50189317 1.1870032 Inf -6.225226 1.2214396     ab
## 4       1328 -1.35646685 1.4133808 Inf -5.789889 3.0769558     ab
## 15     BT 93 -1.22606139 1.1898310 Inf -4.958264 2.5061414     ab
## 19      BT64 -1.22606139 1.1898310 Inf -4.958264 2.5061414     ab
## 25 BT85 PLUS -1.22606139 1.1898310 Inf -4.958264 2.5061414     ab
## 27      BT96 -1.22606139 1.1898310 Inf -4.958264 2.5061414     ab
## 14     BT 86 -0.07853765 1.0881929 Inf -3.491927 3.3348519     ab
## 21      BT72 -0.07853765 1.0881929 Inf -3.491927 3.3348519     ab
## 3       1114 -0.07853765 1.0881929 Inf -3.491927 3.3348519     ab
## 7       3105 -0.05467011 1.1305275 Inf -3.600852 3.4915123     ab
## 26      BT90  0.44267769 1.2687762 Inf -3.537156 4.4225119     ab
## 5       1507  0.56435548 1.2054098 Inf -3.216714 4.3454250     ab
## 12      4017  0.56435548 1.2054098 Inf -3.216714 4.3454250     ab
## 8       4010  0.63617901 1.2943932 Inf -3.424009 4.6963671     ab
## 18      Bt62  0.63617901 1.2943932 Inf -3.424009 4.6963671     ab
## 16      BT21  1.05577442 1.3094974 Inf -3.051792 5.1633407     ab
## 24      BT85  1.44507699 1.1300572 Inf -2.099630 4.9897843     ab
## 20      BT68  1.53119237 0.9325331 Inf -1.393931 4.4563157     ab
## 1       1101  1.58301295 1.1691678 Inf -2.084374 5.2504003     ab
## 9       4013  1.58306317 1.1691682 Inf -2.084326 5.2504519     ab
## 30      FV05  1.61327295 1.1630598 Inf -2.034955 5.2615010     ab
## 17      BT61  1.74979613 1.5906748 Inf -3.239753 6.7393457     ab
## 28      BT98  2.21319217 1.0339823 Inf -1.030152 5.4565365     ab
## 10      4015  3.28440738 1.2301079 Inf -0.574134 7.1429487      b
tb_means$enraz <- tb_emm

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = asymp.LCL,
                     xmax = asymp.UCL,
                     label = sprintf("%0.2f %s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "Grau de enraizamento")

#-----------------------------------------------------------------------

11 Análise de componentes principais com valores individuais

#-----------------------------------------------------------------------

str(tb)
## tibble [111 × 13] (S3: tbl_df/tbl/data.frame)
##  $ index  : num [1:111] 1 2 3 4 5 6 7 8 9 10 ...
##  $ gen    : Factor w/ 37 levels "1101","1102",..: 12 7 22 37 6 35 32 8 34 24 ...
##  $ block  : Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 1 1 1 1 ...
##  $ altini : num [1:111] 6.5 6.5 11 9.5 4 7.5 7.5 10.5 17 9 ...
##  $ alt    : num [1:111] 85 109 105 52 59 42 149 59 101 155 ...
##  $ diamini: num [1:111] 6.95 3.9 4.58 7.33 4.97 ...
##  $ diam   : num [1:111] 27.4 20.8 25.2 11.9 17.1 ...
##  $ mffol  : num [1:111] 456 231 272 161 172 ...
##  $ mfcau  : num [1:111] 434.8 199.8 276.1 56.5 126.2 ...
##  $ msfol  : num [1:111] 193 96 120.8 61 55.5 ...
##  $ mscau  : num [1:111] 206 73.6 131.6 26.3 54.9 ...
##  $ msraiz : num [1:111] NA 87.3 104.8 37.9 82.3 ...
##  $ enraz  : Factor w/ 4 levels "I","II","III",..: 4 2 3 1 2 1 2 3 3 2 ...
# Fórmulas para ajustar os modelos.
formulas <- list(alt = alt ~ altini + block + gen,
                 diam = diam ~ diamini + block + gen,
                 mffol = log(mffol) ~ block + gen,
                 mfcau = log(mfcau) ~ block + gen,
                 msfol = log(msfol) ~ block + gen,
                 mscau = log(mscau) ~ block + gen,
                 msraiz = log(msraiz) ~ block + gen)

# m0 <- lm(formulas[[7]],
#          data = tb,
#          contrasts = list(block = "contr.sum"))
# m0

# Ajusta o modelo para ajustar para o efeito de covariáveis e blocos.
tb_fit <-
    imap(formulas,
         function(f, nm) {
             # Ajuste do modelo aos dados.
             m0 <- lm(f,
                      data = tb,
                      contrasts = list(block = "contr.sum"))
             # Matriz do modelo para predição.
             X <- model.matrix(formula(m0)[-2], data = tb)
             # Faz média de termos para obter médias marginais.
             a <- range(m0$assign)
             i <- !(m0$assign %in% a)
             X[, i] <- apply(X[, i],
                             MARGIN = 2,
                             FUN = function(x) rep(mean(x), length(x)))
             # Médias ajustadas para covariáveis e blocos.
             fit <- X %*% coef(m0)
             tb_fit <- cbind(tb[, c("gen", "block"), drop = FALSE],
                             fit = fit)
             # Soma resíduos e médias para retornas observações
             # ajustadas.
             tb_fit <- left_join(tb_fit,
                                 cbind(m0$model[, c("gen", "block")],
                                       res = residuals(m0)),
                                 by = c("gen", "block")) %>%
                 replace_na(list(res = 0)) %>%
                 mutate(fit = fit + res,
                        res = NULL)
             names(tb_fit)[3] <- nm
             return(tb_fit)
         }) %>%
    reduce(left_join)

# Confere.
# anova(lm(alt ~ block + gen, data = tb_fit))
# anova(lm(alt ~ altini + block + gen, data = tb))

#------------------------------------------------------------------------
# Análise de componentes principais.

X <- dplyr::select(tb_fit, -gen, -block)
rownames(X) <- with(tb_fit, sprintf("%s-%s", gen, block))

lattice::splom(X,
               auto.key = TRUE,
               cex = 0.4,
               col = "black",
               as.matrix = TRUE)

# Análise de componentes principais.
acp <- princomp(X, cor = TRUE)

# Importância dos componentes e variância explicada.
summary(acp)
## Importance of components:
##                           Comp.1     Comp.2    Comp.3     Comp.4
## Standard deviation     2.2399318 0.82526012 0.7953390 0.58202883
## Proportion of Variance 0.7167564 0.09729347 0.0903663 0.04839394
## Cumulative Proportion  0.7167564 0.81404983 0.9044161 0.95281007
##                            Comp.5     Comp.6      Comp.7
## Standard deviation     0.42055733 0.31813428 0.228586185
## Proportion of Variance 0.02526692 0.01445849 0.007464521
## Cumulative Proportion  0.97807699 0.99253548 1.000000000
# Screeplot.
plot(acp, type = "l")

# screeplot(acp, type = "l")

# Carregamentos.
print(acp)
## Call:
## princomp(x = X, cor = TRUE)
## 
## Standard deviations:
##    Comp.1    Comp.2    Comp.3    Comp.4    Comp.5    Comp.6    Comp.7 
## 2.2399318 0.8252601 0.7953390 0.5820288 0.4205573 0.3181343 0.2285862 
## 
##  7  variables and  111 observations.
# Gráfico de biplot.
biplot(acp)
abline(v = 0, h = 0, lty = 2)

# Os componentes ou escores.
head(acp$scores)
##            Comp.1      Comp.2       Comp.3     Comp.4      Comp.5
## 4013-1  3.7273531  1.19379413 -1.505833339 -0.8713683 -0.88814969
## 2011-1  0.4055854  0.22430132  0.193520858  0.3153508 -0.02234785
## Bt62-1  2.2211729 -0.01744098 -0.003946862 -0.1924202 -0.15583537
## FV10-1 -4.4692922  1.49406059 -0.423757110  0.5674485  0.45085666
## 1507-1 -2.0475050 -0.57181187 -0.489079673  0.1162954 -0.51007943
## FV03-1 -0.2655243 -0.44851195 -1.639958487 -0.4071202  0.19929455
##             Comp.6      Comp.7
## 4013-1 -0.19563829 -0.11662529
## 2011-1  0.07174615  0.23074318
## Bt62-1 -0.05739745 -0.14044731
## FV10-1 -0.19972343 -0.03951118
## 1507-1  0.24096648 -0.18219640
## FV03-1 -0.02193009 -0.03212463
# lattice::splom(acp$scores,
#                auto.key = TRUE,
#                cex = 0.4,
#                col = "black",
#                as.matrix = TRUE)

# Carregamentos.
acp$loadings
## 
## Loadings:
##        Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## alt     0.315  0.228  0.817  0.273  0.306  0.111       
## diam    0.390 -0.193 -0.149 -0.611  0.609  0.207       
## mffol   0.366  0.431 -0.441  0.362         0.565 -0.182
## mfcau   0.421         0.112 -0.261 -0.545  0.180  0.641
## msfol   0.403  0.284 -0.285  0.193  0.216 -0.721  0.269
## mscau   0.424         0.125 -0.244 -0.435 -0.271 -0.695
## msraiz  0.307 -0.801         0.506                     
## 
##                Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## SS loadings     1.000  1.000  1.000  1.000  1.000  1.000  1.000
## Proportion Var  0.143  0.143  0.143  0.143  0.143  0.143  0.143
## Cumulative Var  0.143  0.286  0.429  0.571  0.714  0.857  1.000
# print(acp$loadings, cutoff = 0.4)
# print(acp$loadings, cutoff = 0.3)
# print(acp$loadings, cutoff = 0.2)

# head(acp$scores)   # Escores dos indivíduos usados no ajuste.
# head(predict(acp)) # Idem.

# predict(acp, newdata = tail(X)) # Pode usar em uma nova amostra.

# NOTE: os resultados da `princomp()` são melhor organizados. Ela
# permite passar matrizes de covariância. Ou seja, pode-se usar outros
# estimadores (mais robustos) da matriz de covariância.

tb_means <- list()

#-----------------------------------------------------------------------
# Componente do tamanho.

m0 <- lm(acp$scores[, 1] ~ tb_fit$gen)
anova(m0)
## Analysis of Variance Table
## 
## Response: acp$scores[, 1]
##            Df Sum Sq Mean Sq F value   Pr(>F)   
## tb_fit$gen 36 280.50  7.7918  2.0859 0.003874 **
## Residuals  74 276.42  3.7354                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen        emmean   SE df lower.CL upper.CL .group
##  BT82      -3.8462 1.12 74    -7.55   -0.138  a    
##  3105      -3.4203 1.12 74    -7.13    0.288  ab   
##  FV10      -3.1134 1.12 74    -6.82    0.595  ab   
##  4016      -2.5600 1.12 74    -6.27    1.148  ab   
##  4015      -1.5629 1.12 74    -5.27    2.145  ab   
##  1114      -1.2036 1.12 74    -4.91    2.505  ab   
##  4017      -1.1441 1.12 74    -4.85    2.564  ab   
##  3408      -1.0836 1.12 74    -4.79    2.625  ab   
##  4018      -1.0109 1.12 74    -4.72    2.697  ab   
##  BT21      -0.8450 1.12 74    -4.55    2.863  ab   
##  BT70      -0.6840 1.12 74    -4.39    3.024  ab   
##  1102      -0.6603 1.12 74    -4.37    3.048  ab   
##  4008      -0.5456 1.12 74    -4.25    3.163  ab   
##  4010      -0.5284 1.12 74    -4.24    3.180  ab   
##  1328      -0.5167 1.12 74    -4.22    3.192  ab   
##  1101      -0.4371 1.12 74    -4.15    3.271  ab   
##  BT72      -0.2002 1.12 74    -3.91    3.508  ab   
##  BT96      -0.0133 1.12 74    -3.72    3.695  ab   
##  BT68       0.0975 1.12 74    -3.61    3.806  ab   
##  BT98       0.1184 1.12 74    -3.59    3.827  ab   
##  1106       0.1699 1.12 74    -3.54    3.878  ab   
##  FV03       0.2007 1.12 74    -3.51    3.909  ab   
##  1507       0.2706 1.12 74    -3.44    3.979  ab   
##  BT85 PLUS  0.6461 1.12 74    -3.06    4.354  ab   
##  BT61       0.7321 1.12 74    -2.98    4.440  ab   
##  BT85       0.9593 1.12 74    -2.75    4.668  ab   
##  BT27       1.2884 1.12 74    -2.42    4.997  ab   
##  BT 93      1.3202 1.12 74    -2.39    5.028  ab   
##  BT90       1.3919 1.12 74    -2.32    5.100  ab   
##  BT83       1.5100 1.12 74    -2.20    5.218  ab   
##  FV05       1.7760 1.12 74    -1.93    5.484  ab   
##  4013       2.0005 1.12 74    -1.71    5.709  ab   
##  BT63       2.0106 1.12 74    -1.70    5.719  ab   
##  BT 86      2.0147 1.12 74    -1.69    5.723  ab   
##  Bt62       2.1903 1.12 74    -1.52    5.899   b   
##  2011       2.2496 1.12 74    -1.46    5.958   b   
##  BT64       2.4286 1.12 74    -1.28    6.137   b   
## 
## Results are given on the [ (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## Note: contrasts are still on the [ scale 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means[[1]] <- tb_emm %>%
    dplyr::select(gen, emmean, ends_with("CL")) %>%
    rename_if(is.numeric, ~str_c(., "_1"))

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.2f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "Componente de tamanho")

#-----------------------------------------------------------------------
# Componente de relação parte áerea e radicular.

m0 <- lm(acp$scores[, 2] ~ tb_fit$gen)

# Comparações múltiplas.
emm <- emmeans(m0, specs = ~gen) %>%
    multcomp::cld(Letters = letters, adjust = "tukey", alpha = 0.1)
emm
##  gen        emmean    SE df lower.CL upper.CL .group
##  1328      -1.0364 0.395 74  -2.3497    0.277  a    
##  4010      -0.9901 0.395 74  -2.3034    0.323  a    
##  BT68      -0.8187 0.395 74  -2.1320    0.495  ab   
##  FV03      -0.7975 0.395 74  -2.1108    0.516  ab   
##  BT21      -0.7149 0.395 74  -2.0282    0.598  ab   
##  1102      -0.6553 0.395 74  -1.9686    0.658  abc  
##  BT64      -0.6433 0.395 74  -1.9566    0.670  abc  
##  BT85      -0.5725 0.395 74  -1.8857    0.741  abc  
##  BT63      -0.5156 0.395 74  -1.8288    0.798  abc  
##  4018      -0.5070 0.395 74  -1.8203    0.806  abc  
##  1114      -0.5036 0.395 74  -1.8169    0.810  abc  
##  FV05      -0.3983 0.395 74  -1.7116    0.915  abc  
##  BT96      -0.1996 0.395 74  -1.5128    1.114  abc  
##  4016      -0.1729 0.395 74  -1.4862    1.140  abc  
##  BT 86     -0.1454 0.395 74  -1.4586    1.168  abc  
##  BT 93     -0.0831 0.395 74  -1.3964    1.230  abc  
##  Bt62      -0.0714 0.395 74  -1.3846    1.242  abc  
##  1507      -0.0571 0.395 74  -1.3704    1.256  abc  
##  4015      -0.0560 0.395 74  -1.3693    1.257  abc  
##  BT98       0.0268 0.395 74  -1.2865    1.340  abc  
##  BT72       0.0425 0.395 74  -1.2708    1.356  abc  
##  BT82       0.0702 0.395 74  -1.2431    1.383  abc  
##  1106       0.0846 0.395 74  -1.2287    1.398  abc  
##  4017       0.0928 0.395 74  -1.2205    1.406  abc  
##  BT83       0.1637 0.395 74  -1.1496    1.477  abc  
##  BT27       0.1904 0.395 74  -1.1228    1.504  abc  
##  BT61       0.3378 0.395 74  -0.9755    1.651  abc  
##  2011       0.4584 0.395 74  -0.8548    1.772  abc  
##  BT70       0.4985 0.395 74  -0.8147    1.812  abc  
##  3408       0.5277 0.395 74  -0.7856    1.841  abc  
##  BT85 PLUS  0.5392 0.395 74  -0.7740    1.853  abc  
##  1101       0.6089 0.395 74  -0.7044    1.922  abc  
##  4013       0.7707 0.395 74  -0.5426    2.084  abc  
##  3105       0.7897 0.395 74  -0.5236    2.103  abc  
##  4008       1.0319 0.395 74  -0.2814    2.345  abc  
##  BT90       1.2639 0.395 74  -0.0494    2.577   bc  
##  FV10       1.4411 0.395 74   0.1278    2.754    c  
## 
## Results are given on the [ (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: sidak method for 37 estimates 
## Note: contrasts are still on the [ scale 
## P value adjustment: tukey method for comparing a family of 37 estimates 
## significance level used: alpha = 0.1
tb_emm <- emm %>%
    as.data.frame() %>%
    mutate(gen = fct_reorder(gen, emmean))

tb_means[[2]] <- tb_emm %>%
    dplyr::select(gen, emmean, ends_with("CL")) %>%
    rename_if(is.numeric, ~str_c(., "_2"))

ggplot(data = tb_emm,
       mapping = aes(y = gen,
                     x = emmean,
                     xmin = lower.CL,
                     xmax = upper.CL,
                     label = sprintf("%0.2f%s", emmean, .group))) +
    geom_errorbarh() +
    geom_point() +
    geom_text(nudge_y = 0.25, vjust = 0, size = 3) +
    expand_limits(y = c(NA, nlevels(tb_emm$gen) + 1)) +
    labs(y = "Genótipos", x = "Componente de relação")

#-----------------------------------------------------------------------
# Juntando.

# tb_means <- tb_means %>%
#     reduce(left_join)
#
# ggplot(data = tb_means,
#        mapping = aes(x = emmean_1,
#                      y = emmean_2,
#                      xmin = lower.CL_1,
#                      xmax = upper.CL_1,
#                      ymin = lower.CL_2,
#                      ymax = upper.CL_2,
#                      label = gen)) +
#     geom_vline(xintercept = 0, color = "red") +
#     geom_hline(yintercept = 0, color = "red") +
#     geom_errorbar() +
#     geom_errorbarh() +
#     geom_point() +
#     geom_label() +
#     labs(x = "Componente 1", y = "Componente 2") +
#     coord_equal()

#-----------------------------------------------------------------------