From 2c5b21b74ffc3721a35440637519f198959d39a3 Mon Sep 17 00:00:00 2001
From: Walmes Zeviani <walmes@ufpr.br>
Date: Tue, 22 Sep 2020 18:41:33 -0300
Subject: [PATCH] Adds more code to be improved.
---
50-parcela-subdividida.Rmd | 229 +++++++++++++++++++++++++++++++++++++
1 file changed, 229 insertions(+)
diff --git a/50-parcela-subdividida.Rmd b/50-parcela-subdividida.Rmd
index 1c9684a..563468a 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
+#--------------------------------------------
+```
--
GitLab