| #### labestData ##### `github.com/pet-estatistica/labestData`

# Análise de Experimentos em Delineamento de Blocos Casualizados

#### PET Estatística UFPR

## Análise exploratória

Para exemplificação da análise de um experimento em delineamento de blocos casualizados (DBC), vamos considerar o conjunto de dados `PimentelEg5.2`.

    library(labestData)

    ## ----------------------------------------------------------------------
    ##   labestData: Biblioteca de Dados para Ensino de Estatística
    ##
    ##   Para colaboração, suporte ou relato de bugs, visite:
    ##     http://gitlab.c3sl.ufpr.br/pet-estatistica/labestData,
    ##     https://github.com/pet-estatistica/labestData
    ##
    ##   labestData version 0.0-17.458 (feito em 2016-06-27) foi carregado.
    ## ----------------------------------------------------------------------

    ls("package:labestData")

    ##   [1] "BanzattoQd1.2.3"   "BanzattoQd3.2.1"   "BanzattoQd3.4.1"
    ##   [4] "BanzattoQd3.6.1"   "BanzattoQd3.7.1"   "BanzattoQd4.5.2"
    ##   [7] "BanzattoQd4.7.1"   "BanzattoQd5.2.1"   "BanzattoQd5.2.4"
    ##  [10] "BanzattoQd5.3.1"   "BanzattoQd5.3.7"   "BanzattoQd5.5.1"
    ##  [13] "BanzattoQd6.2.2"   "BanzattoQd6.2.5"   "BanzattoQd6.3.4"
    ##  [16] "BanzattoQd6.4.2"   "BanzattoQd7.2.1"   "BanzattoQd7.3.1"
    ##  [19] "BanzattoQd7.3.3"   "BanzattoQd8.2.1"   "BanzattoQd8.3.1"
    ##  [22] "BanzattoQd8.4.1"   "BanzattoQd8.4.3"   "BanzattoQd9.2.1"
    ##  [25] "BarbinEx1"         "BarbinEx13"        "BarbinEx14"
    ##  [28] "BarbinEx16"        "BarbinEx17"        "BarbinEx18"
    ##  [31] "BarbinEx3"         "BarbinEx8"         "BarbinEx9"
    ##  [34] "BarbinPg104"       "BarbinPg114"       "BarbinPg125"
    ##  [37] "BarbinPg137"       "BarbinPg156"       "BarbinPg167"
    ##  [40] "BarbinPg177"       "BarbinPg25"        "BarbinPg72"
    ##  [43] "CharnetApD.1"      "CharnetEg12.2"     "CharnetEg4.2"
    ##  [46] "CharnetEg5.2"      "CharnetEg6.4"      "CharnetEg7.3"
    ##  [49] "CharnetEg8.2"      "CharnetEg9.2"      "CharnetEg9.4"
    ##  [52] "CharnetEx1.17"     "CharnetEx1.18"     "CharnetEx1.20"
    ##  [55] "CharnetEx1.5"      "CharnetEx1.6"      "CharnetEx10.7"
    ##  [58] "CharnetEx11.2"     "CharnetEx11.3"     "CharnetEx2.10"
    ##  [61] "CharnetEx2.11"     "CharnetEx2.12"     "CharnetEx2.13"
    ##  [64] "CharnetEx2.14"     "CharnetEx2.15"     "CharnetEx2.8"
    ##  [67] "CharnetEx2.9"      "CharnetEx3.1"      "CharnetEx3.3"
    ##  [70] "CharnetEx3.4"      "CharnetEx3.9"      "CharnetEx4.1"
    ##  [73] "CharnetEx4.10"     "CharnetEx4.2"      "CharnetEx4.8"
    ##  [76] "CharnetEx5.1"      "CharnetEx5.10"     "CharnetEx5.11"
    ##  [79] "CharnetEx5.13"     "CharnetEx5.3"      "CharnetEx5.5"
    ##  [82] "CharnetEx5.6"      "CharnetEx6.3"      "CharnetEx6.6"
    ##  [85] "CharnetEx6.7"      "CharnetEx7.1"      "CharnetEx7.2"
    ##  [88] "CharnetEx7.7"      "CharnetEx8.1"      "CharnetEx8.2"
    ##  [91] "CharnetEx8.3"      "CharnetEx8.4"      "CharnetEx8.5"
    ##  [94] "CostaEx5.7.2"      "CostaEx5.7.3"      "CostaTb4"
    ##  [97] "CostaTb6"          "CostaTb7"          "CostaTb8"
    ## [100] "DemetrioEg7.7"     "DemetrioEx1.4.1.1" "DemetrioEx1.4.1.2"
    ## [103] "DemetrioEx1.4.1.3" "DemetrioEx1.4.1.4" "DemetrioEx1.4.1.5"
    ## [106] "DemetrioEx1.4.2"   "DemetrioEx2.12.15" "DemetrioEx2.12.16"
    ## [109] "DemetrioEx2.12.5"  "DemetrioEx5.4.2"   "DemetrioEx5.4.5"
    ## [112] "DemetrioEx6.5.2"   "DemetrioEx7.8.3"   "DemetrioTb1.1"
    ## [115] "DemetrioTb1.2"     "DemetrioTb1.3"     "DemetrioTb1.4"
    ## [118] "DemetrioTb1.5"     "DemetrioTb1.6"     "DemetrioTb10.2"
    ## [121] "DemetrioTb2.10"    "DemetrioTb2.11"    "DemetrioTb2.12"
    ## [124] "DemetrioTb2.9"     "DemetrioTb3.5"     "DemetrioTb3.6"
    ## [127] "DemetrioTb4.2"     "DemetrioTb4.5"     "DemetrioTb5.1"
    ## [130] "DemetrioTb7.1"     "DiasEg10.1"        "DiasEg10.2"
    ## [133] "DiasEg11.1"        "DiasEg3.2"         "DiasEg3.6"
    ## [136] "DiasEg5.1"         "DiasEg5.3"         "DiasEg6.1"
    ## [139] "DiasEg6.2"         "DiasEg6.3"         "DiasEg7.1"
    ## [142] "DiasEg9.1"         "DiasEg9.2"         "DiasEg9.4"
    ## [145] "DiasEx10.4.10"     "DiasEx10.4.6"      "DiasEx10.4.7"
    ## [148] "DiasEx10.4.8"      "DiasEx11.7.8"      "DiasEx11.7.9"
    ## [151] "DiasEx3.6.7"       "DiasEx6.5.1"       "DiasEx6.5.10"
    ## [154] "DiasEx6.5.9"       "DiasEx9.6.10"      "DiasEx9.6.4"
    ## [157] "DiasEx9.6.6"       "DiasEx9.6.7"       "Dinorah"
    ## [160] "EpprechtTb2.1"     "EpprechtTb2.2"     "EpprechtTb2.3"
    ## [163] "EpprechtTb5.2"     "EpprechtTb5.4"     "EpprechtTb5.5"
    ## [166] "EpprechtTb5.6"     "EpprechtTb5.9"     "EpprechtTb6.10"
    ## [169] "EpprechtTb6.12"    "EpprechtTb6.4"     "EpprechtTb6.9"
    ## [172] "EpprechtTb7.5"     "EpprechtTb8.12"    "EpprechtTb8.13"
    ## [175] "EpprechtTb8.14"    "EpprechtTb8.15"    "EpprechtTb8.16"
    ## [178] "EpprechtTb8.2"     "EpprechtTb8.8"     "FariaEg2.9.5"
    ## [181] "FariaEg3.2.4"      "FariaQd11.4"       "FariaQd11.9"
    ## [184] "FariaQd12.5"       "FariaQd14.2"       "FariaQd14.3"
    ## [187] "FariaQd6.1"        "FerreiraEg13.2"    "FerreiraEg13.3"
    ## [190] "FerreiraEg3.4"     "FerreiraEg5.1"     "FerreiraEg6.3"
    ## [193] "FerreiraEg7.1"     "FerreiraEg7.4"     "FerreiraEg8.1"
    ## [196] "FerreiraEg9.1"     "FerreiraEx10.11.9" "FerreiraEx3.8.5"
    ## [199] "FerreiraEx7.4.1"   "FerreiraEx8.5.1"   "FerreiraEx9.7.2"
    ## [202] "ManlyTb1.1"        "ManlyTb1.2"        "ManlyTb1.3"
    ## [205] "ManlyTb1.4"        "ManlyTb1.5"        "ManlyTb10.2"
    ## [208] "ManlyTb10.4"       "ManlyTb11.3"       "ManlyTb11.5"
    ## [211] "ManlyTb4.5"        "ManlyTb6.6"        "ManlyTb6.7"
    ## [214] "ManlyTb9.7"        "ManlyTb9.8"        "MingotiAnA1"
    ## [217] "MingotiAnA2"       "MingotiAnA3"       "MingotiAnA4"
    ## [220] "MingotiAnA5"       "MingotiAnA6"       "MingotiTb2.1"
    ## [223] "MingotiTb2.2"      "MingotiTb3.1"      "MingotiTb3.10"
    ## [226] "MingotiTb3.5"      "MingotiTb3.7"      "MingotiTb6.1"
    ## [229] "MingotiTb6.8"      "MingotiTb8.1"      "PaulaEg1.12.2"
    ## [232] "PaulaEg1.12.4"     "PaulaEg1.12.5"     "PaulaEg1.12.6"
    ## [235] "PaulaEg2.4.2"      "PaulaEg2.4.3"      "PaulaEg2.5.2"
    ## [238] "PaulaEg2.8.1"      "PaulaEg3.5.1"      "PaulaEg3.5.2"
    ## [241] "PaulaEg3.6.11a"    "PaulaEg3.6.11b"    "PaulaEg3.6.9c"
    ## [244] "PaulaEg4.2.6"      "PaulaEg4.3.6"      "PaulaEg5.2.8a"
    ## [247] "PaulaEg5.2.8c"     "PaulaEg5.5.1"      "PaulaEg5.5.2"
    ## [250] "PaulaEg5.5.3"      "PaulaEx1.13.19"    "PaulaEx1.13.20"
    ## [253] "PaulaEx1.13.21"    "PaulaEx1.13.22"    "PaulaEx1.13.23"
    ## [256] "PaulaEx1.13.24"    "PaulaEx1.13.25"    "PaulaEx2.10.15"
    ## [259] "PaulaEx2.10.16"    "PaulaEx2.10.17"    "PaulaEx2.10.19"
    ## [262] "PaulaEx2.10.20"    "PaulaEx2.10.7"     "PaulaEx3.7.14"
    ## [265] "PaulaEx3.7.15"     "PaulaEx3.7.16"     "PaulaEx3.7.19"
    ## [268] "PaulaEx3.7.20"     "PaulaEx3.7.21"     "PaulaEx3.7.22"
    ## [271] "PaulaEx3.7.23"     "PaulaEx3.7.24"     "PaulaEx3.7.25"
    ## [274] "PaulaEx3.7.7a"     "PaulaEx3.7.7b"     "PaulaEx3.7.7c"
    ## [277] "PaulaEx3.7.8"      "PaulaEx4.6.15"     "PaulaEx4.6.17"
    ## [280] "PaulaEx4.6.20"     "PaulaEx4.6.5"      "PaulaEx4.6.6"
    ## [283] "PaulaEx4.6.7"      "PaulaEx5.6.13"     "PaulaEx5.6.14"
    ## [286] "PaulaEx5.6.15"     "PaulaTb1.6"        "PaulaTb1.9"
    ## [289] "PaulaTb2.1"        "PaulaTb2.6"        "PaulaTb3.12"
    ## [292] "PaulaTb3.20"       "PaulaTb3.21"       "PaulaTb4.12"
    ## [295] "PaulaTb4.14"       "PaulaTb4.2"        "PaulaTb4.7"
    ## [298] "PaulaTb4.9"        "PimentelEg4.2"     "PimentelEg5.2"
    ## [301] "PimentelEg6.2"     "PimentelEg7.3"     "PimentelEg7.4"
    ## [304] "PimentelEx5.8.4"   "PimentelEx5.8.5"   "PimentelEx6.6.3"
    ## [307] "PimentelPg142"     "PimentelPg185"     "PimentelPg267"
    ## [310] "PimentelPg269"     "PimentelPg382"     "PimentelPg72"
    ## [313] "PimentelPg91"      "PimentelTb10.3.1"  "PimentelTb10.4.1"
    ## [316] "PimentelTb10.6.1"  "PimentelTb11.3.1"  "PimentelTb12.2.1"
    ## [319] "PimentelTb12.3.1"  "PimentelTb12.4.1"  "PimentelTb13.5.1"
    ## [322] "PimentelTb14.4.1"  "PimentelTb14.5.1"  "PimentelTb14.7.1"
    ## [325] "PimentelTb16.2.1"  "PimentelTb16.3.1"  "PimentelTb17.3.1"
    ## [328] "PimentelTb17.4.1"  "PimentelTb18.2.1"  "PimentelTb20.2.1"
    ## [331] "PimentelTb21.5.1"  "PimentelTb5.3.1"   "PimentelTb6.3.1"
    ## [334] "PimentelTb7.2.1"   "PimentelTb7.6.1"   "PimentelTb7.8.1"
    ## [337] "PimentelTb7.9.1"   "PimentelTb8.3.1"   "PimentelTb9.2.1"
    ## [340] "PimentelTb9.3.1"   "PimentelTb9.4.1"   "RamalhoEg11.10"
    ## [343] "RamalhoEg11.13"    "RamalhoEg11.4"     "RamalhoEg12.10"
    ## [346] "RamalhoEg13.2"     "RamalhoEg4.3"      "RamalhoEg4.7"
    ## [349] "RamalhoEg7.8"      "RamalhoEg8.1"      "RamalhoEg8.8"
    ## [352] "RamalhoEx1.7"      "RamalhoEx12.2"     "RamalhoEx13.1"
    ## [355] "RamalhoEx13.2"     "RamalhoEx13.3"     "RamalhoEx3.1"
    ## [358] "RamalhoEx4.1"      "RamalhoEx4.2"      "RamalhoEx7.10"
    ## [361] "RamalhoEx8.1"      "RamalhoEx8.2"      "RamalhoTb1.2"
    ## [364] "RamalhoTb11.1"     "RamalhoTb11.17"    "RamalhoTb12.8"
    ## [367] "RamalhoTb13.1"     "RamalhoTb13.11"    "RamalhoTb13.13"
    ## [370] "RamalhoTb13.15"    "RamalhoTb13.6"     "RamalhoTb3.1"
    ## [373] "RamalhoTb3.4"      "RamalhoTb3.6"      "RamalhoTb7.1"
    ## [376] "RamalhoTb8.12"     "RamosAnC1"         "RamosAnC2"
    ## [379] "RamosAnC4"         "RamosAnC6"         "RamosAnC7"
    ## [382] "RamosAnC8"         "RamosTb2.5"        "RamosTb2.6"
    ## [385] "RamosTb2.7"        "RamosTb3.1"        "RamosTb4.1"
    ## [388] "RamosTb5.2"        "RamosTb5.8"        "RamosTb6.1"
    ## [391] "StorckEg2.3.5"     "StorckTb101"       "StorckTb2"
    ## [394] "StorckTb56"        "StorckTb60"        "StorckTb67"
    ## [397] "StorckTb74"        "StorckTb8"         "VieiraEx7.3"
    ## [400] "VieiraEx7.5"       "VieiraEx8.3"       "VieiraPg50.1"
    ## [403] "VieiraPg50.2"      "VieiraPg57.1"      "VieiraPg57.2"
    ## [406] "VieiraTb4.1"       "VieiraTb5.3"       "VieiraTb7.2"
    ## [409] "VieiraTb7.7"       "VieiraTb8.5"       "ZimmermannTb10.15"
    ## [412] "ZimmermannTb10.20" "ZimmermannTb10.6"  "ZimmermannTb10.9"
    ## [415] "ZimmermannTb11.1"  "ZimmermannTb11.10" "ZimmermannTb11.13"
    ## [418] "ZimmermannTb11.19" "ZimmermannTb11.7"  "ZimmermannTb12.1"
    ## [421] "ZimmermannTb12.13" "ZimmermannTb12.14" "ZimmermannTb12.19"
    ## [424] "ZimmermannTb12.2"  "ZimmermannTb12.20" "ZimmermannTb12.26"
    ## [427] "ZimmermannTb12.27" "ZimmermannTb12.32" "ZimmermannTb12.33"
    ## [430] "ZimmermannTb12.7"  "ZimmermannTb12.8"  "ZimmermannTb13.1"
    ## [433] "ZimmermannTb14.3"  "ZimmermannTb14.9"  "ZimmermannTb15.1"
    ## [436] "ZimmermannTb15.10" "ZimmermannTb15.4"  "ZimmermannTb16.1"
    ## [439] "ZimmermannTb16.10" "ZimmermannTb16.3"  "ZimmermannTb16.4"
    ## [442] "ZimmermannTb16.5"  "ZimmermannTb16.8"  "ZimmermannTb3.12"
    ## [445] "ZimmermannTb3.2.1" "ZimmermannTb3.5"   "ZimmermannTb4.11"
    ## [448] "ZimmermannTb4.4"   "ZimmermannTb5.11"  "ZimmermannTb5.15"
    ## [451] "ZimmermannTb5.2"   "ZimmermannTb7.1"   "ZimmermannTb7.4"
    ## [454] "ZimmermannTb8.5"   "ZimmermannTb9.13"  "ZimmermannTb9.17"
    ## [457] "ZimmermannTb9.22"  "ZimmermannTb9.26"  "labestDataView"

    help(PimentelEg5.2, help_type = "html")

Nesse experimento estudou-se a produção (resposta) de variedades de batatinha (fator de interesse). O experimento foi instalado em blocos, muito provavelmente para controlar variáveis do ambiente, como a fertilidade do solo, por exemplo. Além disso, uma vez feita a imposição dos blocos, todas as demais variáveis de entrada (mão de obra, dia de colheita, máquinas, etc) devem ser as mesmas para todas as parcelas de um bloco. Isso significa, por exemplo, que todas as parcelas de um bloco devem ser colhidas no mesmo dia e devem ser zeladas (capina, irrigação) pela mesma pessoa. Lembre-se que a blocagem visa a uniformidade, ou seja, condições de contorno iguais para todas as suas parcelas, e por isso as variáveis de entrada precisam ser controladas também.

No conjunto de dados `PimentelEg5.2`, temos a variável `bloco` e `variedade`, ambas como fator. Esse é um detalhe importante: quando as fontes de variação forem de níveis categóricos, elas devem ser variáveis de classe `factor` no R. É preciso cuidado pois alguns livros usam números inteiros para representar os níveis de fatores categóricos, de tal forma que, se não as declararmos como fatores, o R as entenderá como variáveis numéricas.

    #-----------------------------------------------------------------------
    # Ler a partir do repositório do labestData.

    # url <- paste0("https://gitlab.c3sl.ufpr.br/pet-estatistica",
    #               "/labestData/raw/devel/data-raw/PimentelEg5.2.txt")
    #
    # PimentelEg5.2 <-
    #     read.table(file = url, sep = "\t", header = TRUE)

    #-----------------------------------------------------------------------
    # Análise exploratória.

    # Estrutura do objeto.
    str(PimentelEg5.2)

    ## 'data.frame':    32 obs. of  3 variables:
    ##  $ bloco    : Factor w/ 4 levels "I","II","III",..: 1 1 1 1 1 1 1 1 2 2 ...
    ##  $ variedade: Factor w/ 8 levels "B 116-51","B 1-52",..: 1 2 3 4 5 6 7 8 1 2 ...
    ##  $ producao : num  23.1 20 12.7 18 15.4 21.1 9.2 22.6 24.2 21.1 ...

    # Tabela de frequência para os tratamentos.
    xtabs(~variedade + bloco, data = PimentelEg5.2)

    ##              bloco
    ## variedade     I II III IV
    ##   B 116-51    1  1   1  1
    ##   B 1-52      1  1   1  1
    ##   B 25-50 E   1  1   1  1
    ##   B 72-53 A   1  1   1  1
    ##   Buena Vista 1  1   1  1
    ##   Huinkul     1  1   1  1
    ##   Kennebec    1  1   1  1
    ##   S. Rafalela 1  1   1  1

    # Dados desempilhados.
    t(unstack(x = PimentelEg5.2, form = producao ~ variedade))

    ##             [,1] [,2] [,3] [,4]
    ## B.116.51    23.1 24.2 26.4 16.3
    ## B.1.52      20.0 21.1 20.0 28.0
    ## B.25.50.E   12.7 18.0 18.2 17.1
    ## B.72.53.A   18.0 24.6 24.0 24.6
    ## Buena.Vista 15.4 11.9 10.1 12.3
    ## Huinkul     21.1 27.0 26.4 25.7
    ## Kennebec     9.2 13.4 11.0  9.2
    ## S..Rafalela 22.6 29.9 24.2 25.1

    library(lattice)

    # Para uma melhor exibição dos dados, vamos reordenar os níveis
    # de cultivar pela média de cada uma delas. Depois vamos ordenar os
    # registros no data.frame por bloco/variedade.

    # Reordena os níveis.
    PimentelEg5.2 <- transform(PimentelEg5.2,
                               variedade = reorder(variedade, producao))

    # Reordena os registros.
    PimentelEg5.2 <- PimentelEg5.2[
        with(PimentelEg5.2, order(bloco, variedade)), ]

    # Diagrama de dispersão.
    xyplot(producao ~ variedade, data = PimentelEg5.2,
           groups = bloco, type = "o",
           auto.key = list(corner = c(0.05, 0.95), columns = 1,
                           title = "Bloco", cex.title = 1.1),
           xlab = "Variedades de batatinha (ordenadas)",
           ylab = expression("Produção de batatinha"~(t~ha^{-1})),
           scales = list(x = list(rot = 90)))

Como pode ser visto na análise preliminar, o número de níveis de `variedade` é 8 e o número de blocos é 4.

No gráfico de dispersão, ordenamos as variedades pela média amostral e as observações de um mesmo bloco foram ligadas. Note que a relação sinal-ruído fornece uma evidência visual do efeito de variedade.

As observações de um mesmo blocos não foram ligadas por acaso. Nesse gráfico é possível ter impressões sob uma suposição do modelo estatístico: a aditividade dos efeitos de tratamento e bloco.

## Especificação e ajuste do modelo

O modelo estatístico correspondente ao delineamento de blocos casualizados é

\[ \begin{aligned} Y|\text{bloco, variedade} &\,\sim \text{Normal}(\mu_{ij}, \sigma^2) \newline \mu_{ij} &= \mu + \alpha_{i} + \tau_{j}, \end{aligned} \]

em que \(Y\) é a variável resposta, \(\alpha_{i}\) é o efeito do bloco \(i\), \(\tau_j\) é o efeito da variedade \(j\), \(\mu\) é a média de \(Y\) na ausência do efeito dos blocos e da variedade e \(\sigma^2\) é a variância das observações ao redor das suas respectivas médias. Note que a média (\(\mu\)) tem dois índices, um referente ao bloco e outro à variedade.

    #-----------------------------------------------------------------------
    # Ajuste do modelo.

    m0 <- lm(producao ~ bloco + variedade, data = PimentelEg5.2)

    # Estimativas dos efeitos. Restrição de zerar primeiro nível.
    cbind(coef(m0))

    ##                        [,1]
    ## (Intercept)           8.750
    ## blocoII               3.500
    ## blocoIII              2.275
    ## blocoIV               2.025
    ## variedadeBuena Vista  1.725
    ## variedadeB 25-50 E    5.800
    ## variedadeB 1-52      11.575
    ## variedadeB 116-51    11.800
    ## variedadeB 72-53 A   12.100
    ## variedadeHuinkul     14.350
    ## variedadeS. Rafalela 14.750

    # Aqui tem-se o grupo de coeficientes para cada um dos termos do
    # preditor para a média (\mu = 0, \alpha_i = 1, \tau_j = 2).
    split(coef(m0), m0$assign)

    ## $`0`
    ## (Intercept)
    ##        8.75
    ##
    ## $`1`
    ##  blocoII blocoIII  blocoIV
    ##    3.500    2.275    2.025
    ##
    ## $`2`
    ## variedadeBuena Vista   variedadeB 25-50 E      variedadeB 1-52
    ##                1.725                5.800               11.575
    ##    variedadeB 116-51   variedadeB 72-53 A     variedadeHuinkul
    ##               11.800               12.100               14.350
    ## variedadeS. Rafalela
    ##               14.750

    # Matrizes de contrastes utilizadas, sob a retrição zerar primeiro nível.
    contrasts(PimentelEg5.2$bloco)

    ##     II III IV
    ## I    0   0  0
    ## II   1   0  0
    ## III  0   1  0
    ## IV   0   0  1

    contrasts(PimentelEg5.2$variedade)

    ##             Buena Vista B 25-50 E B 1-52 B 116-51 B 72-53 A Huinkul
    ## Kennebec              0         0      0        0         0       0
    ## Buena Vista           1         0      0        0         0       0
    ## B 25-50 E             0         1      0        0         0       0
    ## B 1-52                0         0      1        0         0       0
    ## B 116-51              0         0      0        1         0       0
    ## B 72-53 A             0         0      0        0         1       0
    ## Huinkul               0         0      0        0         0       1
    ## S. Rafalela           0         0      0        0         0       0
    ##             S. Rafalela
    ## Kennebec              0
    ## Buena Vista           0
    ## B 25-50 E             0
    ## B 1-52                0
    ## B 116-51              0
    ## B 72-53 A             0
    ## Huinkul               0
    ## S. Rafalela           1

    # Médias amostrais.
    aggregate(producao ~ variedade, data = PimentelEg5.2, FUN = mean)

    ##     variedade producao
    ## 1    Kennebec   10.700
    ## 2 Buena Vista   12.425
    ## 3   B 25-50 E   16.500
    ## 4      B 1-52   22.275
    ## 5    B 116-51   22.500
    ## 6   B 72-53 A   22.800
    ## 7     Huinkul   25.050
    ## 8 S. Rafalela   25.450

No modelo estatístico para DBC, tem-se dois termos com efeito na média: os blocos e as variedades, que são os parâmetros com subíndice. Como os fatores são categóricos, \(k-1\) parâmetros são estimados para acomodar o efeito de cada um (\(k\) é o número de níveis). O R por padrão usa a restrição de zerar o efeito do primeiro nível de cada fator e cada coeficiente corresponde, então, à diferença entre o nível de referência e outro nível qualquer.

O prefixo no nome dos coeficientes vem dos correspondentes termos do modelo. O elemento `assign` mostra que foi atribuido o mesmo número inteiro para os coeficientes do mesmo termo.

É possível usar outra restrição ou tipo de contraste. Abaixo foi usado o contraste que zera o efeito do último nível, padrão de outro software.

    m1 <- update(m0, contrasts = list(bloco = "contr.SAS"))
    split(data.frame(coef(m0), coef(m1), row.names = NULL), m0$assign)

    ## $`0`
    ##   coef.m0. coef.m1.
    ## 1     8.75   10.775
    ##
    ## $`1`
    ##   coef.m0. coef.m1.
    ## 2    3.500   -2.025
    ## 3    2.275    1.475
    ## 4    2.025    0.250
    ##
    ## $`2`
    ##    coef.m0. coef.m1.
    ## 5     1.725    1.725
    ## 6     5.800    5.800
    ## 7    11.575   11.575
    ## 8    11.800   11.800
    ## 9    12.100   12.100
    ## 10   14.350   14.350
    ## 11   14.750   14.750

    # Médias ajustadas de mínimos quadrados (least squares means).
    # L <- doBy::LSmatrix(m1, effect = "variedade")
    L <- matrix(c(1, 0.25, 0.25, 0.25, 0, 0, 0, 0, 0, 0, 0,
                  1, 0.25, 0.25, 0.25, 1, 0, 0, 0, 0, 0, 0,
                  1, 0.25, 0.25, 0.25, 0, 1, 0, 0, 0, 0, 0,
                  1, 0.25, 0.25, 0.25, 0, 0, 1, 0, 0, 0, 0,
                  1, 0.25, 0.25, 0.25, 0, 0, 0, 1, 0, 0, 0,
                  1, 0.25, 0.25, 0.25, 0, 0, 0, 0, 1, 0, 0,
                  1, 0.25, 0.25, 0.25, 0, 0, 0, 0, 0, 1, 0,
                  1, 0.25, 0.25, 0.25, 0, 0, 0, 0, 0, 0, 1),
                byrow = TRUE,
                nrow = nlevels(PimentelEg5.2$variedade),
                dimnames = list(levels(PimentelEg5.2$variedade), NULL))

    L %*% coef(m1)

    ##               [,1]
    ## Kennebec    10.700
    ## Buena Vista 12.425
    ## B 25-50 E   16.500
    ## B 1-52      22.275
    ## B 116-51    22.500
    ## B 72-53 A   22.800
    ## Huinkul     25.050
    ## S. Rafalela 25.450

O interesse nesse experimento é estudar o efeito das variedades. No entanto, no modelo tem-se também o efeito dos blocos, que foram incluídos para efeito de controle local. Uma maneira de representar o efeito das variedades é calcular as médias ajustadas, ao invés de considerar os coeficientes estimados. Ajustar, no caso, é considerar que para cada termo fora de interesse, os efeitos terão como peso o inverso do número de níveis. Sendo assim, com 4 blocos os pesos são 1/4, ou seja, cada bloco contribui com 1/4 do seu efeito. Perceba que isso é exatamente uma média de efeitos. Apesar da simplicidade, esse tipo de média ficou conhecida por lsmeans (Least Squares Means).

## Avaliação dos pressupostos

Além das suposições de normalidade e homogeneidade de variâncias, no modelo para DBC tem-se que o efeito dos blocos e das variedades é aditivo. Ou seja, espera-se que ao mudar de bloco as médias das diferentes variedades sejam deslocadas em igual quantidade. Mas há situações em que isso pode não acontecer. Por exemplo, imagine um experimento de competição de cultivares em que existem blocos pouco férteis e muito férteis. Pode acontecer que no bloco fértil exista praticamente nunhuma diferença entre as cultivares, já que o ambiente é favorável. No bloco pouco fértil, por outro lado, as cultivares melhor adaptadas à baixa fertilidade podem apresentar produção superior. Em outras palavras, nesse cenário o bloco interage com as cultivares, pois as diferenças entre elas é influenciada pelos blocos. O modelo estatístico assume aditividade e, por isso, cabe na hora do planejamento perceber se a característica blocada (fertilidade) pode influenciar no efeito sendo estudado (cultivares). Em caso afirmativo, poder-se-ia procurar uma área experimental uniforme em fertilidade (de preferência, nesse caso, de baixa fertilidade) para permitir distinguir as cultivares.

    #-----------------------------------------------------------------------
    # Exibe o quarteto fantástico da avaliação dos pressupostos.

    par(mfrow = c(2, 2))
    plot(m0); layout(1)

Os gráficos de resíduos não apresentam evidências para o fuga dos pressupostos. O gráfico 2-1 (Scale-Location) mostra que a dispersão dos valores é a mesma independente da média. O gráfico 1-2 (Normal Q-Q) mostra que os pontos não fogem acentuadamente uma reta, indicando que a suposição de normalidade dos erros foi atendida.

O teste de Tukey para não aditividade foi proposto por Tukey em 1949 com a finalidade de verificar se dois termos tem efeitos aditivos. Não é o objetivo dessa vinheta entrar em detalhes sobre os fundamentos do teste.

No R há ao menos 3 pacotes com funções para fazer o teste de aditividade de Tukey: `agricolae::nonadditivity()`, `asbio::tukey.add.test()` e `addititivityTests::tukey.test()`. No entanto, esse teste pode ser feito sem chamar pacotes, conforme ilustramos abaixo.

    #-----------------------------------------------------------------------
    # Teste da aditividade bloco x tratamento.

    X <- model.matrix(m0)
    beta <- coef(m0)
    a <- m0$assign
    aditiv <- X[, a == 1] %*% beta[a == 1] * X[, a == 2] %*% beta[a == 2]

    anova(update(m0, . ~ . + aditiv))

    ## Analysis of Variance Table
    ##
    ## Response: producao
    ##           Df Sum Sq Mean Sq F value    Pr(>F)
    ## bloco      3  50.53  16.843  2.0223    0.1432
    ## variedade  7 919.72 131.389 15.7755 7.007e-07 ***
    ## aditiv     1  12.89  12.892  1.5479    0.2278
    ## Residuals 20 166.57   8.329
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

    # Pacote agricolae possuí função para o teste da aditividade.
    # agricolae::nonadditivity(y = PimentelEg5.2$prod,
    #                          factor1 = PimentelEg5.2$bloco,
    #                          factor2 = PimentelEg5.2$variedade,
    #                          df = df.residual(m0),
    #                          MSerror = deviance(m0)/df.residual(m0))

Pelo resultado do teste não rejeitamos a hipótese de que os efeitos de blocos e variedades são aditivos. Para detalhes sobre o teste da aditividade visite http://www.ime.usp.br/~botter/mae327/Blocos/Blocos.pdf, página 20.

## Inferências

O efeito das variedades é representado pelos coeficientes \(\tau_j\) no modelo estatístico do experimento. Se não existe efeito das variedades, os valores estimados \(\tau_{i}\) serão próximos a zero. A hipóteses nula de não haver efeito é representada por

\[ \text{H}_{0}: \tau_j = 0, \text{para todo}\,j. \]

Essa hipótese é avaliada pelo estatística F do quadro de análise de variância.

    anova(m0)

    ## Analysis of Variance Table
    ##
    ## Response: producao
    ##           Df Sum Sq Mean Sq F value    Pr(>F)
    ## bloco      3  50.53  16.843  1.9709    0.1493
    ## variedade  7 919.72 131.389 15.3744 5.723e-07 ***
    ## Residuals 21 179.47   8.546
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Pelo quadro, existe efeito das variedades, ou seja, elas não apresentam a mesma produção média. Os códigos abaixo retornam os valores preditos para as variedades sob efeito do bloco I. Ou seja, esses são os valores esperados de produção para as variedades cultivadas no bloco I. Se outro bloco for considerado, os valores médios serão diferentes devido à mudança no efeito do bloco. No entanto, é importante enfatizar que as diferenças entre as médias das variedades é a mesma, independente do bloco considerado. Portanto, como o interesse está na diferença entre médias, tanto faz o bloco escolhido.

    # Predição das médias das variades no bloco I.
    pred <- data.frame(variedade = levels(PimentelEg5.2$variedade),
                       bloco = "I")
    pred <- cbind(pred,
                  as.data.frame(predict(m0,
                                        newdata = pred,
                                        interval = "confidence")))
    pred$variedade <- reorder(pred$variedade, pred$fit)
    pred

    ##     variedade bloco    fit       lwr      upr
    ## 1    Kennebec     I  8.750  5.185618 12.31438
    ## 2 Buena Vista     I 10.475  6.910618 14.03938
    ## 3   B 25-50 E     I 14.550 10.985618 18.11438
    ## 4      B 1-52     I 20.325 16.760618 23.88938
    ## 5    B 116-51     I 20.550 16.985618 24.11438
    ## 6   B 72-53 A     I 20.850 17.285618 24.41438
    ## 7     Huinkul     I 23.100 19.535618 26.66438
    ## 8 S. Rafalela     I 23.500 19.935618 27.06438

Se por um lado a escolha do bloco não altera a diferença entre médias, por outro, existe preferência por considerar não o efeito de um bloco qualquer, mas sim o efeito médio de todos. São duas as principais vantagens: 1) com o efeito médio dos blocos o erro padrão das médias é menor e 2) considerando que efeito dos blocos vem de uma distribuição de probabilidades, usar a média dos efeitos tem uma interpretação interessante. Por exemplo, se os blocos controlam as variações de fertilidade do solo, ao considerar a média do efeito dos blocos tem-se as produtividades médias das variedades ao longo dessas condições de fertilidade (férteis, normais, ruins). Embora o objetivo do experimento seja estudar a diferença entre as variedades, o pesquisador tem necessidade de reportar um número que indique, de alguma forma, a previsão de desempenho futuro.

    suppressMessages(library(multcomp, quietly = TRUE))

    # Vetor de pesos para o valor esperado da variedade 1 no bloco I e na
    # média dos blocos.
    l1 <- matrix(c(1, 0,    0,    0,    0, 0, 0, 0, 0, 0, 0), nrow = 1)
    l0 <- matrix(c(1, 0.25, 0.25, 0.25, 0, 0, 0, 0, 0, 0, 0), nrow = 1)

    # Os erros padrões também são diferentes, assim como as médias.
    summary(glht(m0, linfct = l1))

    ##
    ##   Simultaneous Tests for General Linear Hypotheses
    ##
    ## Fit: lm(formula = producao ~ bloco + variedade, data = PimentelEg5.2)
    ##
    ## Linear Hypotheses:
    ##        Estimate Std. Error t value Pr(>|t|)
    ## 1 == 0    8.750      1.714   5.105 4.68e-05 ***
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## (Adjusted p values reported -- single-step method)

    summary(glht(m0, linfct = l0))

    ##
    ##   Simultaneous Tests for General Linear Hypotheses
    ##
    ## Fit: lm(formula = producao ~ bloco + variedade, data = PimentelEg5.2)
    ##
    ## Linear Hypotheses:
    ##        Estimate Std. Error t value Pr(>|t|)
    ## 1 == 0   10.700      1.462    7.32 3.32e-07 ***
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## (Adjusted p values reported -- single-step method)

    # Erros-padrões obtidos matricialmente.
    # sqrt(l1 %*% vcov(m0) %*% t(l1))
    # sqrt(l0 %*% vcov(m0) %*% t(l0))

    # A prova de que a variância do efeito de bloco não contribui para a
    # variância da média quando se usa a média dos blocos.
    round(data.frame("bloco I" = t(l1 %*% vcov(m0)),
                     "média" = t(l0 %*% vcov(m0))), 5)

    ##                       bloco.I    média
    ## (Intercept)           2.93767  2.13649
    ## blocoII              -1.06824  0.00000
    ## blocoIII             -1.06824  0.00000
    ## blocoIV              -1.06824  0.00000
    ## variedadeBuena Vista -2.13649 -2.13649
    ## variedadeB 25-50 E   -2.13649 -2.13649
    ## variedadeB 1-52      -2.13649 -2.13649
    ## variedadeB 116-51    -2.13649 -2.13649
    ## variedadeB 72-53 A   -2.13649 -2.13649
    ## variedadeHuinkul     -2.13649 -2.13649
    ## variedadeS. Rafalela -2.13649 -2.13649

O código acima mostra que ao considerar a médias dos blocos o erro-padrão foi menor. Isso porque na média dos blocos, os efeitos dos blocos se anulam e por isso o erro-padrão da estimativa do efeito dos blocos é 0 e não contribui pro erro-padrão da estimativa dos efeitos das variedades.

    # IC *individual* de cobertura 95%.
    # ic <- confint(glht(m0, linfct = L), calpha = univariate_calpha())
    # ic <- as.data.frame(ic$confint)

    # IC *global* de cobertura 95%. CUIDADO, essa função demora muito quando
    # o número de níveis é grande.
    ic <- confint(glht(m0, linfct = L))
    ic <- as.data.frame(ic$confint)

    names(ic) <- c("fit", "lwr", "upr")

    pred <- cbind(variedade = pred$variedade, ic)
    pred

    ##               variedade    fit       lwr      upr
    ## Kennebec       Kennebec 10.700  6.307154 15.09285
    ## Buena Vista Buena Vista 12.425  8.032154 16.81785
    ## B 25-50 E     B 25-50 E 16.500 12.107154 20.89285
    ## B 1-52           B 1-52 22.275 17.882154 26.66785
    ## B 116-51       B 116-51 22.500 18.107154 26.89285
    ## B 72-53 A     B 72-53 A 22.800 18.407154 27.19285
    ## Huinkul         Huinkul 25.050 20.657154 29.44285
    ## S. Rafalela S. Rafalela 25.450 21.057154 29.84285

    library(latticeExtra)

    segplot(variedade ~ lwr + upr, centers = fit, data = pred,
            draw = FALSE, horizontal = FALSE,
            xlab = "Variedades de batatinha",
            ylab = expression("Produção de batatinha"~(t~ha^{-1})),
            scales = list(x = list(rot = 90)),
            panel = function(x, y, z, centers, ...) {
                panel.segplot(x = x, y = y, z = z, centers = centers, ...)
                panel.text(x = as.numeric(z), y = centers,
                           label = sprintf("%0.2f", centers),
                           srt = 90, cex = 0.8, adj = c(0.5, -0.5))
            })

Por fim, uma representação intessante é colocar as médias ajustadas das variades com alguma presentação de incerteza, como o intervalo de confiança. No caso, foi usando o intervalo de confiança com cobertura global de 95%. Os intervalos de cobertura individual são aqueles cuja probabilidade de conter o parâmetro é \(\gama\) para cada coeficiente separadamente. Já o de confiança global, a probabilidade \(\gama\) é a de todos os intervalores conterem os parâmetros simultaneamente. Esses intervalos são mais amplos (menos precisos) que os de cobertura individual.

## Gerando experimento em DBC

A casualização em um experimento em delineamento de blocos casualizados é feita dentro de cada bloco. O código abaixo produz um sorteio considerando a mesma estrutra do conjunto de dados analisado.

    replicate(nlevels(PimentelEg5.2$bloco),
              sample(levels(PimentelEg5.2$variedade)))

    ##      [,1]          [,2]          [,3]          [,4]
    ## [1,] "B 72-53 A"   "B 1-52"      "S. Rafalela" "B 72-53 A"
    ## [2,] "B 116-51"    "B 116-51"    "B 25-50 E"   "S. Rafalela"
    ## [3,] "Buena Vista" "B 72-53 A"   "Kennebec"    "B 25-50 E"
    ## [4,] "Kennebec"    "Kennebec"    "B 72-53 A"   "B 116-51"
    ## [5,] "S. Rafalela" "Buena Vista" "B 1-52"      "B 1-52"
    ## [6,] "B 1-52"      "S. Rafalela" "B 116-51"    "Buena Vista"
    ## [7,] "Huinkul"     "B 25-50 E"   "Huinkul"     "Huinkul"
    ## [8,] "B 25-50 E"   "Huinkul"     "Buena Vista" "Kennebec"

## Informações da sessão

    sessionInfo()

    ## R version 3.3.1 (2016-06-21)
    ## Platform: x86_64-pc-linux-gnu (64-bit)
    ## Running under: Ubuntu 14.04.4 LTS
    ##
    ## locale:
    ##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C
    ##  [3] LC_TIME=pt_BR.UTF-8        LC_COLLATE=C
    ##  [5] LC_MONETARY=pt_BR.UTF-8    LC_MESSAGES=en_US.UTF-8
    ##  [7] LC_PAPER=pt_BR.UTF-8       LC_NAME=C
    ##  [9] LC_ADDRESS=C               LC_TELEPHONE=C
    ## [11] LC_MEASUREMENT=pt_BR.UTF-8 LC_IDENTIFICATION=C
    ##
    ## attached base packages:
    ## [1] stats     graphics  grDevices utils     datasets  methods
    ## [7] base
    ##
    ## other attached packages:
    ##  [1] multcomp_1.4-5        TH.data_1.0-7
    ##  [3] MASS_7.3-45           survival_2.39-4
    ##  [5] mvtnorm_1.0-5         labestData_0.0-17.458
    ##  [7] latticeExtra_0.6-28   RColorBrewer_1.1-2
    ##  [9] lattice_0.20-33       knitr_1.13.1
    ##
    ## loaded via a namespace (and not attached):
    ##  [1] Rcpp_0.12.5       magrittr_1.5      splines_3.3.1
    ##  [4] stringr_1.0.0     tools_3.3.1       grid_3.3.1
    ##  [7] htmltools_0.3.5   yaml_2.1.13       digest_0.6.9
    ## [10] Matrix_1.2-6      formatR_1.4       codetools_0.2-14
    ## [13] evaluate_0.9      rmarkdown_0.9.6.9 sandwich_2.3-4
    ## [16] stringi_1.0-1     zoo_1.7-13