diff --git a/50-parcela-subdividida.Rmd b/50-parcela-subdividida.Rmd index 1c9684a53aa97f156433d937e6efa2d0ac5dd815..563468a0c46a09ca4e9211f2810daec638b5c0ff 100644 --- a/50-parcela-subdividida.Rmd +++ b/50-parcela-subdividida.Rmd @@ -350,3 +350,232 @@ emm # Comparações múltiplas (já imbutem as aproximações). multcomp::cld(emm) ``` + +## Desdobramento de hipóteses + +```{r, eval = FALSE} +#----------------------------------------------------------------------- +# Leitura dos dados. + +txt <- "metodo espacam bloco rendimento +M1 17 1 2400 +M1 34 1 2625 +M1 51 1 2411 +M1 68 1 2524 +M2 17 1 2375 +M2 34 1 1933 +M2 51 1 2209 +M2 68 1 1901 +M3 17 1 2170 +M3 34 1 2105 +M3 51 1 1894 +M3 68 1 1652 +M4 17 1 2248 +M4 34 1 2144 +M4 51 1 2072 +M4 68 1 2175 +M1 17 2 2364 +M1 34 2 2330 +M1 51 2 2351 +M1 68 2 2509 +M2 17 2 2270 +M2 34 2 2360 +M2 51 2 2162 +M2 68 2 2024 +M3 17 2 2049 +M3 34 2 2292 +M3 51 2 2195 +M3 68 2 1840 +M4 17 2 2447 +M4 34 2 2189 +M4 51 2 2269 +M4 68 2 2275 +M1 17 3 2453 +M1 34 3 2485 +M1 51 3 2625 +M1 68 3 2637 +M2 17 3 2511 +M2 34 3 2312 +M2 51 3 2093 +M2 68 3 2106 +M3 17 3 2146 +M3 34 3 2330 +M3 51 3 2167 +M3 68 3 1833 +M4 17 3 2222 +M4 34 3 2314 +M4 51 3 2132 +M4 68 3 2202 +M1 17 4 2353 +M1 34 4 2449 +M1 51 4 2347 +M1 68 4 2540 +M2 17 4 2124 +M2 34 4 1852 +M2 51 4 2089 +M2 68 4 2092 +M3 17 4 1808 +M3 34 4 2101 +M3 51 4 2178 +M3 68 4 2055 +M4 17 4 2671 +M4 34 4 2667 +M4 51 4 2229 +M4 68 4 2365" + +dados_PSD <- read.table(textConnection(txt), + sep = "\t", + header = TRUE) +dados_PSD <- transform(dados_PSD, + bloco = factor(bloco), + espacam = factor(espacam)) +closeAllConnections() + +#----------------------------------------------------------------------- +# Usando aov(). + +# Ajusta com aninhamento. +m2_em <- aov(rendimento ~ bloco + metodo/espacam + Error(bloco:metodo), + data = dados_PSD) + +# Juntando espaçamento e interação método:espaçamento. +summary(m2_em) + +# (by = número de níveis de metodo e length.out = gl de espacam) +espacam_in_metodo <- list(met_M1 = seq(1, by = 4, length.out = 3), + met_M2 = seq(2, by = 4, length.out = 3), + met_M3 = seq(3, by = 4, length.out = 3), + met_M4 = seq(4, by = 4, length.out = 3)) + +# Somas de quadrados particionadas. +summary(m2_em, split = list(`metodo:espacam` = espacam_in_metodo)) + +# DANGER: Modelo que NÃO tem os dois estratos. +m2_me <- aov(rendimento ~ bloco + espacam/metodo + bloco:metodo, + data = dados_PSD) + +# Juntando método e interação método:espaçamento. +summary(m2_me) + +# Estar atentdo a posição das estimativas. +coef(m2_me) + +# Para fatiar as somas de quadrados. +metodo_in_espacam <- list(esp_17 = seq(1, by = 4, length.out = 3), + esp_34 = seq(2, by = 4, length.out = 3), + esp_51 = seq(3, by = 4, length.out = 3), + esp_68 = seq(4, by = 4, length.out = 3)) + +# (by = numero de niveis de espacam e length.out = gl de metodo) +summary(m2_me, split = list(`espacam:metodo` = metodo_in_espacam)) + +#----------------------------------------------------------------------- + +# rm(list = ls()) + +library(lme4) +library(lmerTest) +library(car) # linearHypothesis() + +# Modelo de efeitos cruzados. +mm0 <- lmer(rendimento ~ bloco + (1 | bloco:metodo) + metodo * espacam, + data = dados_PSD) +anova(mm0) + +# Desdobrar espaçamento dentro de método. ------------------------------ + +# Modelo de efeitos aninhados com espaçamento dentro de método. +mm_me <- lmer(rendimento ~ bloco + (1 | bloco:metodo) + metodo/espacam, + data = dados_PSD) +anova(mm_me) + +# fixef(mm_me) +# levels(mm_me@frame$metodo) +# levels(mm_me@frame$espacam) + +# Matriz de 0 que será preenchida com 1 nos locais corretos. +L <- matrix(0, + nrow = nlevels(mm_me@frame$espacam) - 1, + ncol = length(fixef(mm_me)),) +colnames(L) <- names(fixef(mm_me)) + +L_esp_in_met <- lapply(levels(mm_me@frame$metodo), + function(i) { + one <- grep(x = names(fixef(mm_me)), + pattern = sprintf("%s:", i)) + L[cbind(seq_along(one), one)] <- 1 + return(L) + }) +names(L_esp_in_met) <- levels(mm_me@frame$metodo) + +# Aplica para o primeiro nível de método. +u <- linearHypothesis(mm_me, + hypothesis.matrix = L_esp_in_met[[1]], + test = "F") +u + +# Aplica para todos os níveis de método. +lapply(L_esp_in_met, FUN = linearHypothesis, model = mm_me, test = "F") + +# Aplica para todos os níveis de método e ajeita o resultado. +lht <- lapply(L_esp_in_met, + FUN = function(ll) { + lh <- linearHypothesis(model = mm_me, + hypothesis.matrix = ll, + test = "F") + as.data.frame(lh)[2, ] + }) +do.call(rbind, lht) + +# Do quadro de anova do objeto aov(). +# metodo:espacam: met_M1 3 55744 18581 1.181 0.33068 +# metodo:espacam: met_M2 3 178136 59379 3.773 0.01878 * +# metodo:espacam: met_M3 3 280553 93518 5.942 0.00212 ** +# metodo:espacam: met_M4 3 109256 36419 2.314 0.09229 . + +# Desdobrar método dentro de espaçamento. ------------------------------ + +# Modelo de efeitos aninhados com método dentro de espaçamento. +mm_em <- lmer(rendimento ~ bloco + (1 | bloco:metodo) + espacam/metodo, + data = dados_PSD) +anova(mm_em) + +# Matriz de 0 que será preenchida com 1 nos locais corretos. +L <- matrix(0, + nrow = nlevels(mm_em@frame$metodo) - 1, + ncol = length(fixef(mm_em))) +colnames(L) <- names(fixef(mm_em)) + +L_met_in_esp <- lapply(levels(mm_em@frame$espacam), + function(i) { + one <- grep(x = names(fixef(mm_em)), + pattern = sprintf("%s:", i)) + L[cbind(seq_along(one), one)] <- 1 + return(L) + }) +names(L_met_in_esp) <- levels(mm_em@frame$espacam) + +# Aplica para todos os níveis de método e ajeita o resultado. +lht <- lapply(L_met_in_esp, + FUN = function(ll) { + lh <- linearHypothesis(model = mm_em, + hypothesis.matrix = ll, + test = "F") + as.data.frame(lh)[2, ] + }) +do.call(rbind, lht) + +# with(dados_PSD, +# ExpDes::split2.rbd(factor1 = metodo, +# factor2 = espacam, +# block = bloco, +# resp = rendimento)) +#-------------------------------------------- +# DF SS MS Fc p.value +# F1 : F2 17 3.00000 334910.7 111636.90 4.99005 0.006173 +# F1 : F2 34 3.00000 288453.5 96151.17 4.297854 0.012084 +# F1 : F2 51 3.00000 266123.2 88707.73 3.96514 0.016842 +# F1 : F2 68 3.00000 1113673.2 371224.42 16.593334 1e-06 +# Pooled Error 30.74135 687742.4 22371.90 +#-------------------------------------------- +```