Capítulo 4 Delineamento de Quadrado Latino

4.1 Motivação

Ilustração de um experimento em delineamento quadrado latino 5 \(\times\) 5 para estudar o efeito de 5 tipos de grama no ganho de peso de animais. O quadrado latino está blocando o efeito de animal (linhas) e o efeito ambiental (colunas).

Figura 4.1: Ilustração de um experimento em delineamento quadrado latino 5 \(\times\) 5 para estudar o efeito de 5 tipos de grama no ganho de peso de animais. O quadrado latino está blocando o efeito de animal (linhas) e o efeito ambiental (colunas).

Ilustração de um experimento em delineamento quadrado latino 4 \(\times\) 4 para estudar o efeito de 2 tipos de materiais usandos para construção das hélices (plástico e fibra de carbono) combinado com o número de pás (2 e 3 pás) em relação ao tempo de vôo. O quadrado latino está blocando o efeito de piloto com equipamento (linhas, e.g. experiência, desgaste) e o das condições de vôo (colunas, e.g. vento, visibilidade).

Figura 4.2: Ilustração de um experimento em delineamento quadrado latino 4 \(\times\) 4 para estudar o efeito de 2 tipos de materiais usandos para construção das hélices (plástico e fibra de carbono) combinado com o número de pás (2 e 3 pás) em relação ao tempo de vôo. O quadrado latino está blocando o efeito de piloto com equipamento (linhas, e.g. experiência, desgaste) e o das condições de vôo (colunas, e.g. vento, visibilidade).

# ATTENTION: Limpa espaço de trabalho.
rm(list = objects())

# Carrega pacotes.
library(agricolae) # HSD.test()
library(car)       # linearHypothesis(), Anova()
library(multcomp)  # glht()
library(emmeans)   # emmeans()
library(tidyverse)

# Carrega funções.
source("mpaer_functions.R")

4.2 Variável resposta contínua

da <- labestData::PimentelEg6.2
str(da)
## 'data.frame':    25 obs. of  4 variables:
##  $ linha : Factor w/ 5 levels "1","2","3","4",..: 1 2 3 4 5 1 2 3 4 5 ...
##  $ coluna: Factor w/ 5 levels "1","2","3","4",..: 1 1 1 1 1 2 2 2 2 2 ...
##  $ varied: Factor w/ 5 levels "A","B","C","D",..: 4 3 5 2 1 1 5 2 4 3 ...
##  $ prod  : int  432 724 489 494 515 518 478 384 500 660 ...
# Vendo o quadrado no plano.
reshape2::dcast(da, linha ~ coluna, value.var = "varied")
##   linha 1 2 3 4 5
## 1     1 D A B C E
## 2     2 C E A B D
## 3     3 E B C D A
## 4     4 B D E A C
## 5     5 A C D E B
reshape2::dcast(da, linha ~ coluna, value.var = "prod")
##   linha   1   2   3   4   5
## 1     1 432 518 458 583 331
## 2     2 724 478 524 550 400
## 3     3 489 384 556 297 420
## 4     4 494 500 313 486 501
## 5     5 515 660 438 394 318
# Tem registros perdidos?
sum(is.na(da$prod))
## [1] 0
# Análise exploratória.
ggplot(data = da,
       mapping = aes(x = reorder(varied, prod),
                     y = prod,
                     color = linha,
                     shape = coluna)) +
    geom_point() +
    stat_summary(mapping = aes(group = 1),
                 geom = "line",
                 fun.y = "mean",
                 show.legend = FALSE)

gg1 <-
    ggplot(data = da,
           mapping = aes(x = coluna,
                         y = linha,
                         fill = varied)) +
    geom_tile() +
    geom_text(mapping = aes(label = sprintf("%s\n%d", varied, prod))) +
    coord_equal()

gg2 <-
    ggplot(data = da,
           mapping = aes(x = coluna,
                         y = linha,
                         fill = prod)) +
    geom_tile() +
    geom_text(mapping = aes(label = sprintf("%s\n%d", varied, prod))) +
    scale_fill_distiller(palette = "Greens", direction = 1) +
    coord_equal()

gridExtra::grid.arrange(gg1, gg2, nrow = 1)

gridExtra::grid.arrange(
               ggplot(data = da,
                      mapping = aes(x = linha, y = prod)) +
               geom_col(),
               ggplot(data = da,
                      mapping = aes(x = coluna, y = prod)) +
               geom_col(),
               ggplot(data = da,
                      mapping = aes(x = varied, y = prod)) +
               geom_col(),
               nrow = 1)

O modelo estatístico para esse experimento é \[ \begin{aligned} Y|i, j, k &\sim \text{Normal}(\mu_{ijk}, \sigma^2) \\ \mu_{ijk} &= \mu + \alpha_i + \beta_j + \tau_k \end{aligned} \] em que \(\alpha_i\) é o efeito da linha \(i\), \(\beta_j\) é o efeito da coluna \(j\) e \(\tau_j\) o efeito da variedade \(j\) sobre a variável resposta \(Y\), \(\mu\) é a média de \(Y\) na ausência do efeito dos termos mencionados, \(\mu_{ijk}\) é a média para as observações de procedência \(ijk\) e \(\sigma^2\) é a variância das observações ao redor desse valor médio.

m0 <- lm(prod ~ linha + coluna + varied, data = da)

# Diganóstico dos resíduos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de análise de variância.
# anova(m0)
Anova(m0)
## Anova Table (Type II tests)
## 
## Response: prod
##           Sum Sq Df F value    Pr(>F)    
## linha      30481  4  2.6804 0.0831343 .  
## coluna     55641  4  4.8930 0.0142293 *  
## varied    137488  4 12.0905 0.0003585 ***
## Residuals  34115 12                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Estimativas dos efeitos e medidas de ajuste.
summary(m0)
## 
## Call:
## lm(formula = prod ~ linha + coluna + varied, data = da)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -66.56 -25.16  -1.56  23.24  69.04 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   546.76      38.45  14.220 7.14e-09 ***
## linha2         70.80      33.72   2.100  0.05759 .  
## linha3        -35.20      33.72  -1.044  0.31713    
## linha4         -5.60      33.72  -0.166  0.87087    
## linha5          0.60      33.72   0.018  0.98610    
## coluna2       -22.80      33.72  -0.676  0.51178    
## coluna3       -73.00      33.72  -2.165  0.05127 .  
## coluna4       -68.80      33.72  -2.040  0.06397 .  
## coluna5      -136.80      33.72  -4.057  0.00159 ** 
## variedB       -51.80      33.72  -1.536  0.15045    
## variedC       112.20      33.72   3.327  0.00603 ** 
## variedD       -79.20      33.72  -2.349  0.03680 *  
## variedE       -91.60      33.72  -2.716  0.01873 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 53.32 on 12 degrees of freedom
## Multiple R-squared:  0.8676, Adjusted R-squared:  0.7353 
## F-statistic: 6.555 on 12 and 12 DF,  p-value: 0.001366
# Comparações múltiplas.

# Médias marginais ajustadas.
emm <- emmeans(m0, specs = ~varied)
emm
##  varied emmean   SE df lower.CL upper.CL
##  A         493 23.8 12      441      545
##  B         441 23.8 12      389      493
##  C         605 23.8 12      553      657
##  D         413 23.8 12      361      465
##  E         401 23.8 12      349      453
## 
## Results are averaged over the levels of: linha, coluna 
## Confidence level used: 0.95
grid <- attr(emm, "grid")
L <- attr(emm, "linfct")
rownames(L) <- grid[[1]]

MASS::fractions(L)
##   (Intercept) linha2 linha3 linha4 linha5 coluna2 coluna3 coluna4
## A   1         1/5    1/5    1/5    1/5    1/5     1/5     1/5    
## B   1         1/5    1/5    1/5    1/5    1/5     1/5     1/5    
## C   1         1/5    1/5    1/5    1/5    1/5     1/5     1/5    
## D   1         1/5    1/5    1/5    1/5    1/5     1/5     1/5    
## E   1         1/5    1/5    1/5    1/5    1/5     1/5     1/5    
##   coluna5 variedB variedC variedD variedE
## A 1/5       0       0       0       0    
## B 1/5       1       0       0       0    
## C 1/5       0       1       0       0    
## D 1/5       0       0       1       0    
## E 1/5       0       0       0       1
# Comparações múltiplas, contrastes de Tukey.
# Método de correção de p-valor: single-step.
tk_sgl <- summary(glht(m0, linfct = mcp(varied = "Tukey")),
                  test = adjusted(type = "single-step"))
tk_sgl
## 
##   Simultaneous Tests for General Linear Hypotheses
## 
## Multiple Comparisons of Means: Tukey Contrasts
## 
## 
## Fit: lm(formula = prod ~ linha + coluna + varied, data = da)
## 
## Linear Hypotheses:
##            Estimate Std. Error t value Pr(>|t|)    
## B - A == 0   -51.80      33.72  -1.536  0.56049    
## C - A == 0   112.20      33.72   3.327  0.03937 *  
## D - A == 0   -79.20      33.72  -2.349  0.19550    
## E - A == 0   -91.60      33.72  -2.716  0.10979    
## C - B == 0   164.00      33.72   4.863  0.00295 ** 
## D - B == 0   -27.40      33.72  -0.813  0.92175    
## E - B == 0   -39.80      33.72  -1.180  0.76212    
## D - C == 0  -191.40      33.72  -5.676  < 0.001 ***
## E - C == 0  -203.80      33.72  -6.044  < 0.001 ***
## E - D == 0   -12.40      33.72  -0.368  0.99555    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- single-step method)
# Resumo compacto com letras.
cld(tk_sgl, decreasing = TRUE)
##   A   B   C   D   E 
## "b" "b" "a" "b" "b"
# Teste HSD de Tukey.
tk_hsd <- HSD.test(m0, trt = "varied")

# Detalhes da aplicação do teste HSD de Tukey.
tk_hsd$parameters
##    test name.t ntr StudentizedRange alpha
##   Tukey varied   5          4.50771  0.05
tk_hsd$statistics
##    MSerror Df   Mean       CV      MSD
##   2842.893 12 470.52 11.33189 107.4858
results <- tk_hsd$groups %>%
    rownames_to_column("varied")

results <- inner_join(results,
                      as.data.frame(emm))
## Joining, by = "varied"
results
##   varied  prod groups emmean       SE df lower.CL upper.CL
## 1      C 604.8      a  604.8 23.84489 12 552.8465 656.7535
## 2      A 492.6      b  492.6 23.84489 12 440.6465 544.5535
## 3      B 440.8      b  440.8 23.84489 12 388.8465 492.7535
## 4      D 413.4      b  413.4 23.84489 12 361.4465 465.3535
## 5      E 401.0      b  401.0 23.84489 12 349.0465 452.9535
# Gráfico com estimativas, IC e texto.
ggplot(data = results,
       mapping = aes(x = reorder(varied, prod), y = prod)) +
    geom_point() +
    geom_errorbar(mapping = aes(ymin = lower.CL, ymax = upper.CL),
                  width = 0) +
    geom_label(mapping = aes(label = sprintf("%0.1f %s", prod, groups)),
               nudge_y = 5,
               vjust = 0) +
    labs(x = "Variedade", y = "Produção")

TODO! Colocar teste de Scott Knott.

4.3 Variável resposta de contagem

da <- labestData::ZimmermannTb16.10
str(da)
## 'data.frame':    36 obs. of  5 variables:
##  $ linha : Factor w/ 6 levels "1","2","3","4",..: 1 2 3 4 5 6 1 2 3 4 ...
##  $ coluna: Factor w/ 6 levels "1","2","3","4",..: 1 1 1 1 1 1 2 2 2 2 ...
##  $ trat  : Factor w/ 6 levels "1","2","3","4",..: 5 4 3 1 6 2 2 6 4 5 ...
##  $ colmos: num  20 17 16 8 4 22 5 4 8 14 ...
##  $ posto : num  34 32.5 30.5 15 4 35 7 4 15 29 ...
# Análise exploratória.
ggplot(data = da,
       mapping = aes(x = reorder(trat, colmos),
                     y = colmos,
                     color = linha,
                     shape = coluna)) +
    geom_point() +
    stat_summary(mapping = aes(group = 1),
                 geom = "line",
                 fun.y = "mean",
                 show.legend = FALSE)

gg1 <-
    ggplot(data = da,
           mapping = aes(x = coluna,
                         y = linha,
                         fill = trat)) +
    geom_tile(show.legend = FALSE) +
    geom_text(mapping = aes(label = sprintf("[%s]\n%d",
                                            trat,
                                            colmos)),
              size = 3) +
    coord_equal()

gg2 <-
    ggplot(data = da,
           mapping = aes(x = coluna,
                         y = linha,
                         fill = colmos)) +
    geom_tile(show.legend = FALSE) +
    geom_text(mapping = aes(label = sprintf("[%s]\n%d",
                                            trat,
                                            colmos)),
              size = 3) +
    scale_fill_distiller(palette = "Greens", direction = 1) +
    coord_equal()

gridExtra::grid.arrange(gg1, gg2, nrow = 1)

m0 <- lm(colmos ~ linha + coluna + trat,
         data = da)

# Diganóstico dos resíduos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)
MASS::boxcox(m0)
abline(v = 0, col = "red")

# Análise com modelo linear generalizado.
m0 <- glm(colmos ~ linha + coluna + trat,
          data = da,
          family = quasipoisson)

# Diganóstico dos resíduos.
par(mfrow = c(2, 2))
plot(m0)

layout(1)

# Quadro de análise de variância.
# anova(m0, test = "F")
# drop1(m0, test = "F")
Anova(m0, test.statistic = "F")
## Analysis of Deviance Table (Type II tests)
## 
## Response: colmos
## Error estimate based on Pearson residuals 
## 
##           Sum Sq Df F value  Pr(>F)  
## linha     13.717  5  1.5953 0.20700  
## coluna    31.890  5  3.7089 0.01545 *
## trat      25.095  5  2.9187 0.03882 *
## Residuals 34.393 20                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Estimativas dos efeitos e medidas de ajuste.
summary(m0)
## 
## Call:
## glm(formula = colmos ~ linha + coluna + trat, family = quasipoisson, 
##     data = da)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.88545  -0.59977  -0.02819   0.61018   2.38466  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.71423    0.26116  10.393 1.65e-09 ***
## linha2       0.23219    0.25203   0.921  0.36789    
## linha3       0.09138    0.25699   0.356  0.72587    
## linha4      -0.03471    0.26078  -0.133  0.89543    
## linha5       0.14659    0.25856   0.567  0.57707    
## linha6       0.51768    0.23222   2.229  0.03742 *  
## coluna2     -0.13126    0.20738  -0.633  0.53395    
## coluna3     -0.51876    0.23095  -2.246  0.03614 *  
## coluna4     -0.98911    0.27372  -3.614  0.00173 ** 
## coluna5     -0.52364    0.23017  -2.275  0.03406 *  
## coluna6     -0.42738    0.22410  -1.907  0.07098 .  
## trat2       -0.27135    0.23280  -1.166  0.25748    
## trat3       -0.14607    0.22725  -0.643  0.52766    
## trat4       -0.26224    0.23475  -1.117  0.27720    
## trat5        0.09777    0.21509   0.455  0.65431    
## trat6       -0.84142    0.28385  -2.964  0.00767 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasipoisson family taken to be 1.719689)
## 
##     Null deviance: 105.922  on 35  degrees of freedom
## Residual deviance:  33.373  on 20  degrees of freedom
## AIC: NA
## 
## Number of Fisher Scoring iterations: 4
# Comparações múltiplas.

# Médias marginais ajustadas.
emmeans(m0, specs = ~trat, transform = "response")
##  trat  rate   SE  df asymp.LCL asymp.UCL
##  1    12.27 1.90 Inf      8.56     15.99
##  2     9.36 1.63 Inf      6.16     12.55
##  3    10.60 1.76 Inf      7.16     14.05
##  4     9.44 1.66 Inf      6.19     12.69
##  5    13.53 2.03 Inf      9.56     17.50
##  6     5.29 1.25 Inf      2.83      7.75
## 
## Results are averaged over the levels of: linha, coluna 
## Confidence level used: 0.95
# emmeans(m0, specs = ~trat, transform = "unlink") # Igual.
# emmeans(m0, specs = ~trat, transform = "mu")     # Igual.

emm <- emmeans(m0, specs = ~trat)
emm
##  trat emmean    SE  df asymp.LCL asymp.UCL
##  1      2.44 0.157 Inf      2.13      2.75
##  2      2.17 0.178 Inf      1.82      2.52
##  3      2.30 0.168 Inf      1.97      2.62
##  4      2.18 0.178 Inf      1.83      2.53
##  5      2.54 0.150 Inf      2.25      2.83
##  6      1.60 0.238 Inf      1.13      2.07
## 
## Results are averaged over the levels of: linha, coluna 
## Results are given on the log (not the response) scale. 
## Confidence level used: 0.95
emm %>%
    as.data.frame() %>%
    mutate_at(c("emmean", "asymp.LCL", "asymp.UCL"),
              m0$family$linkinv)
##   trat    emmean        SE  df asymp.LCL asymp.UCL
## 1    1 11.489082 0.1566962 Inf  8.450944 15.619437
## 2    2  8.758667 0.1779058 Inf  6.180226 12.412855
## 3    3  9.927643 0.1680897 Inf  7.141147 13.801437
## 4    4  8.838844 0.1778836 Inf  6.237070 12.525939
## 5    5 12.669178 0.1498617 Inf  9.444652 16.994598
## 6    6  4.952933 0.2376598 Inf  3.108609  7.891488
# DANGER FIXME: o que a `transform = "response"` está fazendo não é
# passar o inverso da função de ligação. O que está sendo feito então?

grid <- attr(emm, "grid")
L <- attr(emm, "linfct")
rownames(L) <- grid[[1]]

MASS::fractions(t(L))
##             1   2   3   4   5   6  
## (Intercept)   1   1   1   1   1   1
## linha2      1/6 1/6 1/6 1/6 1/6 1/6
## linha3      1/6 1/6 1/6 1/6 1/6 1/6
## linha4      1/6 1/6 1/6 1/6 1/6 1/6
## linha5      1/6 1/6 1/6 1/6 1/6 1/6
## linha6      1/6 1/6 1/6 1/6 1/6 1/6
## coluna2     1/6 1/6 1/6 1/6 1/6 1/6
## coluna3     1/6 1/6 1/6 1/6 1/6 1/6
## coluna4     1/6 1/6 1/6 1/6 1/6 1/6
## coluna5     1/6 1/6 1/6 1/6 1/6 1/6
## coluna6     1/6 1/6 1/6 1/6 1/6 1/6
## trat2         0   1   0   0   0   0
## trat3         0   0   1   0   0   0
## trat4         0   0   0   1   0   0
## trat5         0   0   0   0   1   0
## trat6         0   0   0   0   0   1
# Comparações múltiplas, contrastes de Tukey.
# Método de correção de p-valor: single-step.
tk_sgl <- summary(glht(m0, linfct = mcp(trat = "Tukey")),
                  test = adjusted(type = "single-step"))
tk_sgl
## 
##   Simultaneous Tests for General Linear Hypotheses
## 
## Multiple Comparisons of Means: Tukey Contrasts
## 
## 
## Fit: glm(formula = colmos ~ linha + coluna + trat, family = quasipoisson, 
##     data = da)
## 
## Linear Hypotheses:
##             Estimate Std. Error z value Pr(>|z|)  
## 2 - 1 == 0 -0.271353   0.232799  -1.166   0.8512  
## 3 - 1 == 0 -0.146074   0.227249  -0.643   0.9875  
## 4 - 1 == 0 -0.262241   0.234753  -1.117   0.8727  
## 5 - 1 == 0  0.097775   0.215091   0.455   0.9975  
## 6 - 1 == 0 -0.841417   0.283849  -2.964   0.0352 *
## 3 - 2 == 0  0.125279   0.241259   0.519   0.9954  
## 4 - 2 == 0  0.009112   0.248187   0.037   1.0000  
## 5 - 2 == 0  0.369128   0.230062   1.604   0.5919  
## 6 - 2 == 0 -0.570064   0.294950  -1.933   0.3781  
## 4 - 3 == 0 -0.116167   0.241506  -0.481   0.9968  
## 5 - 3 == 0  0.243849   0.224111   1.088   0.8847  
## 6 - 3 == 0 -0.695343   0.288885  -2.407   0.1513  
## 5 - 4 == 0  0.360016   0.231370   1.556   0.6241  
## 6 - 4 == 0 -0.579176   0.294539  -1.966   0.3580  
## 6 - 5 == 0 -0.939192   0.280995  -3.342   0.0106 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- single-step method)
# Resumo compacto com letras.
cld(tk_sgl, decreasing = TRUE)
##    1    2    3    4    5    6 
##  "a" "ab" "ab" "ab"  "a"  "b"
results <- wzRfun::apmc(X = L,
                        model = m0,
                        focus = "trat",
                        test = "single-step") %>%
    mutate_at(c("fit", "lwr", "upr"),
              m0$family$linkinv)

# Gráfico com estimativas, IC e texto.
ggplot(data = results,
       mapping = aes(x = reorder(trat, fit), y = fit)) +
    geom_point() +
    geom_errorbar(mapping = aes(ymin = lwr, ymax = upr),
                  width = 0) +
    geom_label(mapping = aes(label = sprintf("%0.2f %s", fit, cld)),
               nudge_y = 0.25,
               vjust = 0) +
    labs(x = "Tratamento", y = "Número de colmos atacados")

4.4 Variável resposta de proporção amostral

da <- labestData::ZimmermannTb5.11
str(da)
## 'data.frame':    484 obs. of  5 variables:
##  $ linha  : Factor w/ 11 levels "1","2","3","4",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ coluna : Factor w/ 11 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ inset  : Factor w/ 11 levels "1","2","3","4",..: 2 6 3 7 4 11 10 5 1 8 ...
##  $ amostra: int  1 1 1 1 1 1 1 1 1 1 ...
##  $ prop   : num  0.9 0.737 0.918 1 0.862 ...
# Análise exploratória.
ggplot(data = da,
       mapping = aes(x = reorder(inset, prop),
                     y = prop,
                     color = linha,
                     size = coluna)) +
    geom_jitter(width = 0.15, show.legend = FALSE) +
    stat_summary(mapping = aes(group = 1),
                 geom = "line",
                 fun.y = "mean",
                 show.legend = FALSE)

db <- da %>%
    group_by(linha, coluna, inset) %>%
    summarise_at("prop", "mean")

gg1 <-
    ggplot(data = db,
           mapping = aes(x = coluna,
                         y = linha,
                         fill = inset)) +
    geom_tile(show.legend = FALSE) +
    geom_text(mapping = aes(label = sprintf("%s\n%0.2f",
                                            inset,
                                            prop)),
              size = 2) +
    coord_equal()

gg2 <-
    ggplot(data = db,
           mapping = aes(x = coluna,
                         y = linha,
                         fill = prop)) +
    geom_tile(show.legend = FALSE) +
    geom_text(mapping = aes(label = sprintf("%s\n%0.2f",
                                            inset,
                                            prop)),
              size = 2) +
    scale_fill_distiller(palette = "Greens", direction = 1) +
    coord_equal()

gridExtra::grid.arrange(gg1, gg2, nrow = 1)

m0 <- lm(prop ~ linha + coluna + inset,
         data = db)

# Diganóstico dos resíduos.
par(mfrow = c(1, 2))
plot(m0, which = 2:3)

layout(1)

# ATTENTION: Box-Cox não resolve problemas de relação média-variância
# decrescente.

# Modelo para o desfecho complementar.
m0 <- lm(c(1 - prop) ~ linha + coluna + inset,
         data = db)

# Diganóstico dos resíduos.
par(mfrow = c(1, 2))
plot(m0, which = 2:3)

layout(1)

MASS::boxcox(m0)
abline(v = 1/3, col = "red")

# Transformação arco seno da raíz quadrada da proporção amostral.
db$asinsqrt <- asin(sqrt(db$prop))
m0 <- lm(asinsqrt ~ linha + coluna + inset,
         data = db)

# Diganóstico dos resíduos.
par(mfrow = c(1, 2))
plot(m0, which = 2:3)

layout(1)

# DISCUSSION: Pressupostos melhor atendidos.

# ATTENTION FIXME: não sabemos o denominador dessa binomial! E pode ser
# que esse `n` seja variável em função da abundância de hastes em cada
# unidade experimental.

# Análise com modelo linear generalizado.
size <- 1
m0 <- glm(cbind(size * prop, size - size * prop) ~
              linha + coluna + inset,
          data = db,
          family = quasibinomial)

# TIP: as inferências são invariantes ao valor do `size` para
# quasibinomial. O parâmetro de dispersão absorve o `size`.
size <- 100
m0 <- glm(cbind(size * prop, size - size * prop) ~ linha + coluna + inset,
          data = db,
          family = quasibinomial)

# Var(Y|.) = \phi * p * (1 - p).

# Diganóstico dos resíduos.
par(mfrow = c(1, 2))
plot(m0, which = 2:3)

layout(1)

# Quadro de análise de variância.
# anova(m0, test = "F")
# drop1(m0, test = "F")
Anova(m0, test.statistic = "F")
## Analysis of Deviance Table (Type II tests)
## 
## Response: cbind(size * prop, size - size * prop)
## Error estimate based on Pearson residuals 
## 
##            Sum Sq Df F value    Pr(>F)    
## linha     145.289 10  6.5060 1.735e-07 ***
## coluna     32.285 10  1.4457    0.1735    
## inset     158.438 10  7.0949 3.910e-08 ***
## Residuals 200.982 90                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Estimativas dos efeitos e medidas de ajuste.
summary(m0)
## 
## Call:
## glm(formula = cbind(size * prop, size - size * prop) ~ linha + 
##     coluna + inset, family = quasibinomial, data = db)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.1151  -0.6806   0.0222   0.8498   3.9362  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.98666    0.22113   4.462 2.34e-05 ***
## linha2       0.68103    0.19177   3.551 0.000612 ***
## linha3       0.85798    0.20210   4.245 5.30e-05 ***
## linha4       1.14410    0.21680   5.277 9.00e-07 ***
## linha5       1.03704    0.21156   4.902 4.18e-06 ***
## linha6       0.87689    0.20209   4.339 3.73e-05 ***
## linha7       0.55864    0.18714   2.985 0.003649 ** 
## linha8       0.99211    0.20733   4.785 6.65e-06 ***
## linha9       0.97857    0.20648   4.739 7.98e-06 ***
## linha10      0.28127    0.17737   1.586 0.116293    
## linha11      0.34897    0.17919   1.947 0.054596 .  
## coluna2      0.16076    0.20388   0.789 0.432457    
## coluna3      0.42682    0.21766   1.961 0.052978 .  
## coluna4      0.44254    0.21694   2.040 0.044287 *  
## coluna5      0.13662    0.20418   0.669 0.505129    
## coluna6      0.39098    0.21437   1.824 0.071494 .  
## coluna7      0.22780    0.20684   1.101 0.273691    
## coluna8      0.19574    0.20576   0.951 0.343998    
## coluna9     -0.13141    0.19426  -0.676 0.500483    
## coluna10     0.33594    0.21262   1.580 0.117619    
## coluna11     0.14194    0.20361   0.697 0.487503    
## inset2       0.50115    0.20832   2.406 0.018189 *  
## inset3       0.56819    0.21284   2.670 0.009010 ** 
## inset4       0.66213    0.21867   3.028 0.003212 ** 
## inset5       0.05070    0.18983   0.267 0.790019    
## inset6      -0.37568    0.17832  -2.107 0.037918 *  
## inset7       0.50668    0.20921   2.422 0.017445 *  
## inset8       0.48097    0.20716   2.322 0.022506 *  
## inset9       0.93382    0.23402   3.990 0.000134 ***
## inset10      0.01659    0.18972   0.087 0.930501    
## inset11      0.65643    0.21709   3.024 0.003252 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 2.233186)
## 
##     Null deviance: 535.38  on 120  degrees of freedom
## Residual deviance: 207.42  on  90  degrees of freedom
## AIC: NA
## 
## Number of Fisher Scoring iterations: 4
# Comparações múltiplas.

# Médias marginais ajustadas.
# emmeans(m0, specs = ~inset, transform = "response")
# emmeans(m0, specs = ~inset, transform = "unlink") # Igual.
# emmeans(m0, specs = ~inset, transform = "mu")     # Igual.

emm <- emmeans(m0, specs = ~inset)
emm
##  inset emmean    SE  df asymp.LCL asymp.UCL
##  1       1.90 0.134 Inf      1.64      2.17
##  2       2.40 0.161 Inf      2.09      2.72
##  3       2.47 0.166 Inf      2.15      2.80
##  4       2.57 0.173 Inf      2.23      2.91
##  5       1.95 0.136 Inf      1.69      2.22
##  6       1.53 0.118 Inf      1.30      1.76
##  7       2.41 0.162 Inf      2.09      2.73
##  8       2.38 0.160 Inf      2.07      2.70
##  9       2.84 0.193 Inf      2.46      3.22
##  10      1.92 0.135 Inf      1.66      2.18
##  11      2.56 0.172 Inf      2.22      2.90
## 
## Results are averaged over the levels of: linha, coluna 
## Results are given on the logit (not the response) scale. 
## Confidence level used: 0.95
emm %>%
    as.data.frame() %>%
    mutate_at(c("emmean", "asymp.LCL", "asymp.UCL"),
              m0$family$linkinv)
##    inset    emmean        SE  df asymp.LCL asymp.UCL
## 1      1 0.8702785 0.1339443 Inf 0.8376570 0.8971498
## 2      2 0.9171755 0.1610041 Inf 0.8898307 0.9382045
## 3      3 0.9221275 0.1663669 Inf 0.8952510 0.9425505
## 4      4 0.9286118 0.1732817 Inf 0.9025541 0.9481021
## 5      5 0.8758957 0.1363885 Inf 0.8438039 0.9021585
## 6      6 0.8216767 0.1181960 Inf 0.7851760 0.8531356
## 7      7 0.9175946 0.1621100 Inf 0.8901599 0.9386493
## 8      8 0.9156293 0.1600256 Inf 0.8880273 0.9369107
## 9      9 0.9446557 0.1932186 Inf 0.9211841 0.9614300
## 10    10 0.8721402 0.1347464 Inf 0.8396893 0.8988139
## 11    11 0.9282328 0.1720283 Inf 0.9022683 0.9476991
# DANGER FIXME: o que a `transform = "response"` está fazendo não é
# passar o inverso da função de ligação. O que está sendo feito então?

grid <- attr(emm, "grid")
L <- attr(emm, "linfct")
rownames(L) <- grid[[1]]

MASS::fractions(t(L))
##             1    2    3    4    5    6    7    8    9    10   11  
## (Intercept)    1    1    1    1    1    1    1    1    1    1    1
## linha2      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha3      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha4      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha5      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha6      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha7      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha8      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha9      1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha10     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## linha11     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna2     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna3     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna4     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna5     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna6     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna7     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna8     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna9     1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna10    1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## coluna11    1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11 1/11
## inset2         0    1    0    0    0    0    0    0    0    0    0
## inset3         0    0    1    0    0    0    0    0    0    0    0
## inset4         0    0    0    1    0    0    0    0    0    0    0
## inset5         0    0    0    0    1    0    0    0    0    0    0
## inset6         0    0    0    0    0    1    0    0    0    0    0
## inset7         0    0    0    0    0    0    1    0    0    0    0
## inset8         0    0    0    0    0    0    0    1    0    0    0
## inset9         0    0    0    0    0    0    0    0    1    0    0
## inset10        0    0    0    0    0    0    0    0    0    1    0
## inset11        0    0    0    0    0    0    0    0    0    0    1
# Comparações múltiplas, contrastes de Tukey.
# Método de correção de p-valor: false discovery rate.
tk_sgl <- summary(glht(m0, linfct = mcp(inset = "Tukey")),
                  test = adjusted(type = "fdr"))
tk_sgl
## 
##   Simultaneous Tests for General Linear Hypotheses
## 
## Multiple Comparisons of Means: Tukey Contrasts
## 
## 
## Fit: glm(formula = cbind(size * prop, size - size * prop) ~ linha + 
##     coluna + inset, family = quasibinomial, data = db)
## 
## Linear Hypotheses:
##               Estimate Std. Error z value Pr(>|z|)    
## 2 - 1 == 0    0.501151   0.208322   2.406 0.042280 *  
## 3 - 1 == 0    0.568187   0.212838   2.670 0.024571 *  
## 4 - 1 == 0    0.662134   0.218672   3.028 0.011442 *  
## 5 - 1 == 0    0.050701   0.189834   0.267 0.887706    
## 6 - 1 == 0   -0.375675   0.178316  -2.107 0.064415 .  
## 7 - 1 == 0    0.506681   0.209209   2.422 0.042280 *  
## 8 - 1 == 0    0.480968   0.207160   2.322 0.044808 *  
## 9 - 1 == 0    0.933823   0.234020   3.990 0.000454 ***
## 10 - 1 == 0   0.016593   0.189719   0.087 0.965413    
## 11 - 1 == 0   0.656431   0.217091   3.024 0.011442 *  
## 3 - 2 == 0    0.067036   0.230425   0.291 0.887706    
## 4 - 2 == 0    0.160983   0.235756   0.683 0.668633    
## 5 - 2 == 0   -0.450451   0.210007  -2.145 0.060611 .  
## 6 - 2 == 0   -0.876826   0.198714  -4.412 9.37e-05 ***
## 7 - 2 == 0    0.005530   0.226989   0.024 0.981344    
## 8 - 2 == 0   -0.020183   0.225365  -0.090 0.965413    
## 9 - 2 == 0    0.432672   0.249769   1.732 0.138705    
## 10 - 2 == 0  -0.484559   0.208905  -2.320 0.044808 *  
## 11 - 2 == 0   0.155280   0.234084   0.663 0.668633    
## 4 - 3 == 0    0.093947   0.239861   0.392 0.850158    
## 5 - 3 == 0   -0.517486   0.214369  -2.414 0.042280 *  
## 6 - 3 == 0   -0.943862   0.203680  -4.634 4.93e-05 ***
## 7 - 3 == 0   -0.061506   0.231933  -0.265 0.887706    
## 8 - 3 == 0   -0.087219   0.229919  -0.379 0.850158    
## 9 - 3 == 0    0.365636   0.254445   1.437 0.236845    
## 10 - 3 == 0  -0.551594   0.213739  -2.581 0.030129 *  
## 11 - 3 == 0   0.088245   0.238204   0.370 0.850158    
## 5 - 4 == 0   -0.611433   0.219970  -2.780 0.019346 *  
## 6 - 4 == 0   -1.037809   0.209117  -4.963 1.29e-05 ***
## 7 - 4 == 0   -0.155453   0.236280  -0.658 0.668633    
## 8 - 4 == 0   -0.181166   0.235573  -0.769 0.639101    
## 9 - 4 == 0    0.271689   0.258983   1.049 0.437250    
## 10 - 4 == 0  -0.645541   0.219020  -2.947 0.013013 *  
## 11 - 4 == 0  -0.005702   0.243856  -0.023 0.981344    
## 6 - 5 == 0   -0.426376   0.180256  -2.365 0.044808 *  
## 7 - 5 == 0    0.455981   0.211127   2.160 0.060486 .  
## 8 - 5 == 0    0.430268   0.209148   2.057 0.070370 .  
## 9 - 5 == 0    0.883122   0.235800   3.745 0.000991 ***
## 10 - 5 == 0  -0.034108   0.191621  -0.178 0.944598    
## 11 - 5 == 0   0.605731   0.218777   2.769 0.019346 *  
## 7 - 6 == 0    0.882356   0.199809   4.416 9.37e-05 ***
## 8 - 6 == 0    0.856643   0.198282   4.320 0.000122 ***
## 9 - 6 == 0    1.309498   0.226167   5.790 3.87e-07 ***
## 10 - 6 == 0   0.392268   0.178910   2.193 0.057730 .  
## 11 - 6 == 0   1.032107   0.208059   4.961 1.29e-05 ***
## 8 - 7 == 0   -0.025713   0.226926  -0.113 0.965413    
## 9 - 7 == 0    0.427141   0.250757   1.703 0.143148    
## 10 - 7 == 0  -0.490089   0.210133  -2.332 0.044808 *  
## 11 - 7 == 0   0.149750   0.235559   0.636 0.671458    
## 9 - 8 == 0    0.452855   0.249671   1.814 0.119810    
## 10 - 8 == 0  -0.464376   0.208733  -2.225 0.055209 .  
## 11 - 8 == 0   0.175463   0.233913   0.750 0.639101    
## 10 - 9 == 0  -0.917230   0.234588  -3.910 0.000564 ***
## 11 - 9 == 0  -0.277391   0.258171  -1.074 0.431782    
## 11 - 10 == 0  0.639839   0.217844   2.937 0.013013 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- fdr method)
# Resumo compacto com letras.
cld(tk_sgl, decreasing = TRUE)
##     1     2     3     4     5     6     7     8     9    10    11 
##  "de"  "ab"   "a"   "a" "bcd"   "e"  "ab"  "ac"   "a"  "ce"   "a"
results <- wzRfun::apmc(X = L,
                        model = m0,
                        focus = "inset",
                        test = "fdr") %>%
    mutate_at(c("fit", "lwr", "upr"),
              m0$family$linkinv)
results %>%
    arrange(desc(fit))
##    inset       fit       lwr       upr cld
## 1      9 0.9446557 0.9211841 0.9614300   a
## 2      4 0.9286118 0.9025541 0.9481021   a
## 3     11 0.9282328 0.9022683 0.9476991   a
## 4      3 0.9221275 0.8952510 0.9425505   a
## 5      7 0.9175946 0.8901599 0.9386493  ab
## 6      2 0.9171755 0.8898307 0.9382045  ab
## 7      8 0.9156293 0.8880273 0.9369107  ac
## 8      5 0.8758957 0.8438039 0.9021585 bcd
## 9     10 0.8721402 0.8396893 0.8988139  ce
## 10     1 0.8702785 0.8376570 0.8971498  de
## 11     6 0.8216767 0.7851760 0.8531356   e
# Gráfico com estimativas, IC e texto.
ggplot(data = results,
       mapping = aes(x = reorder(inset, fit), y = fit)) +
    geom_point() +
    geom_errorbar(mapping = aes(ymin = lwr, ymax = upr),
                  width = 0) +
    geom_text(mapping = aes(label = sprintf("%0.2f %s", fit, cld)),
              angle = 90,
              vjust = 0,
              nudge_x = -0.05) +
    labs(x = "Tratamento",
         y = "Proporção de hastes sobreviventes")

4.5 Geração do delineamento

latin_square(6)
##    lin col trt
## 1    1   1   6
## 2    2   1   3
## 3    3   1   2
## 4    4   1   4
## 5    5   1   1
## 6    6   1   5
## 7    1   2   2
## 8    2   2   5
## 9    3   2   4
## 10   4   2   6
## 11   5   2   3
## 12   6   2   1
## 13   1   3   1
## 14   2   3   4
## 15   3   3   3
## 16   4   3   5
## 17   5   3   2
## 18   6   3   6
## 19   1   4   3
## 20   2   4   6
## 21   3   4   5
## 22   4   4   1
## 23   5   4   4
## 24   6   4   2
## 25   1   5   5
## 26   2   5   2
## 27   3   5   1
## 28   4   5   3
## 29   5   5   6
## 30   6   5   4
## 31   1   6   4
## 32   2   6   1
## 33   3   6   6
## 34   4   6   2
## 35   5   6   5
## 36   6   6   3

TODO!


Manual de Planejamento e Análise de Experimentos com R
Walmes Marques Zeviani