bom dia, segue!  require(ExpDes.pt) data(ex4)attach(ex4)fat2.dic(revol,esterco,zn,quali=c(FALSE,TRUE),mcomp="tukey", fac.names=c("Revolvimento","Esterco"),sigT = 0.05, sigF = 0.05, unfold=NULL) att,.André  Em domingo, 17 de dezembro de 2023 às 08:04:57 BRT, Andre Oliveira <andreolsouza@yahoo.com.br> escreveu: bo dia dia! segue!  att,.André  Em sábado, 16 de dezembro de 2023 às 21:11:21 BRT, Cesar Rabak por (R-br) <r-br@listas.c3sl.ufpr.br> escreveu: CMR ? On Sat, Dec 16, 2023 at 4:20 PM Andre Oliveira por (R-br) <r-br@listas.c3sl.ufpr.br> wrote: boa tarde,alguém com problemas com a biblioteca ExpDes.pt? Função fatorial duplo retornando o QM errado. att,.André _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível. _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.

bom dia, QM errado. att,.André  Em domingo, 17 de dezembro de 2023 às 14:30:57 BRT, Cesar Rabak por (R-br) <r-br@listas.c3sl.ufpr.br> escreveu: OK e qual era a expectativa que foi frustrada em relação ao resultado obtido? On Sun, Dec 17, 2023 at 8:06 AM Andre Oliveira por (R-br) <r-br@listas.c3sl.ufpr.br> wrote: bom dia, segue!  require(ExpDes.pt) data(ex4)attach(ex4)fat2.dic(revol,esterco,zn,quali=c(FALSE,TRUE),mcomp="tukey", fac.names=c("Revolvimento","Esterco"),sigT = 0.05, sigF = 0.05, unfold=NULL) att,.André  Em domingo, 17 de dezembro de 2023 às 08:04:57 BRT, Andre Oliveira <andreolsouza@yahoo.com.br> escreveu: bo dia dia! segue!  att,.André  Em sábado, 16 de dezembro de 2023 às 21:11:21 BRT, Cesar Rabak por (R-br) <r-br@listas.c3sl.ufpr.br> escreveu: CMR ? On Sat, Dec 16, 2023 at 4:20 PM Andre Oliveira por (R-br) <r-br@listas.c3sl.ufpr.br> wrote: boa tarde,alguém com problemas com a biblioteca ExpDes.pt? Função fatorial duplo retornando o QM errado. att,.André _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível. _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível. _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível. _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.

Eu ainda acho que falta mais uma correção: se na chamada: fat2.dic(revol, esterco, zn, quali=c(FALSE,TRUE), mcomp="tukey", fac.names=c("Revolvimento","Esterco"), sigT = 0.05, sigF = 0.05, unfold=NULL) o primeiro fator NÃO é qualitativo, o número de graus de liberdade deveria ser um e não três. . . posto que revolvimento está sendo oferecido como dado numérico. . . Não entendo porque nossos colegas brasileiros insistem em colocar uma linha adicional da tabela ANOVA para o total das somas quadráticas, posto que essa informação não tem uso algum. On Mon, Dec 18, 2023 at 6:46 AM Alan Rodrigo Panosso por (R-br) < r-br@listas.c3sl.ufpr.br> wrote:

Prezado André, veja se corrigiu.

require(ExpDes.pt)

data(ex4) attach(ex4) fat2.dic(revol, esterco, zn, quali=c(FALSE,TRUE), mcomp="tukey", fac.names=c("Revolvimento","Esterco"), sigT = 0.05, sigF = 0.05, unfold=NULL)

fat2.dic <- function (fator1, fator2, resp, quali = c(TRUE, TRUE), mcomp = "tukey", fac.names = c("F1", "F2"), sigT = 0.05, sigF = 0.05, unfold = NULL) {

cat("------------------------------------------------------------------------\nLegenda:\n") cat("FATOR 1: ", fac.names[1], "\n") cat("FATOR 2: ", fac.names[2], "\n------------------------------------------------------------------------\n\n") fatores <- cbind(fator1, fator2) Fator1 <- factor(fator1) Fator2 <- factor(fator2) nv1 <- length(summary(Fator1)) nv2 <- length(summary(Fator2)) lf1 <- levels(Fator1) lf2 <- levels(Fator2) anava <- aov(resp ~ Fator1 * Fator2) tab <- summary(anava) colnames(tab[[1]]) <- c("GL", "SQ", "QM", "Fc", "Pr>Fc") tab[[1]] <- rbind(tab[[1]], c(apply(tab[[1]], 2, sum))) rownames(tab[[1]]) <- c(fac.names[1], fac.names[2], paste(fac.names[1], "*", fac.names[2], sep = ""), "Residuo", "Total") cv <- round(sqrt(tab[[1]][4, 3])/mean(resp) * 100, 2) tab[[1]][5, 3] = NA cat("\nQuadro da analise de variancia\n------------------------------------------------------------------------\n") print(tab[[1]])

cat("------------------------------------------------------------------------\nCV =", cv, "%\n") pvalor.shapiro <- shapiro.test(anava$residuals)$p.value

cat("\n------------------------------------------------------------------------\nTeste de normalidade dos residuos (Shapiro-Wilk)\n") cat("valor-p: ", pvalor.shapiro, "\n") if (pvalor.shapiro < 0.05) { cat("ATENCAO: a 5% de significancia, os residuos nao podem ser considerados normais!\n------------------------------------------------------------------------\n") } else { cat("De acordo com o teste de Shapiro-Wilk a 5% de significancia, os residuos podem ser considerados normais.\n------------------------------------------------------------------------\n") } if (is.null(unfold)) { if (tab[[1]][3, 5] > sigF) { unfold <- c(unfold, 1) } if (tab[[1]][3, 5] <= sigF) { unfold <- c(unfold, 2) } } if (any(unfold == 1)) { cat("\nInteracao nao significativa: analisando os efeitos simples\n------------------------------------------------------------------------\n") fatores <- data.frame(`fator 1` = fator1, `fator 2` = fator2) for (i in 1:2) { if (quali[i] == TRUE && tab[[1]][i, 5] <= sigF) { cat(fac.names[i]) if (mcomp == "tukey") { tukey(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "duncan") { duncan(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "lsd") { lsd(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "lsdb") { lsdb(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "sk") { scottknott(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "snk") { snk(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "ccboot") { ccboot(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "ccF") { ccF(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } } if (quali[i] == TRUE && tab[[1]][i, 5] > sigF) { cat(fac.names[i]) cat("\nDe acordo com o teste F, as medias desse fator sao estatisticamente iguais.\n")

cat("------------------------------------------------------------------------\n") mean.table <- tapply.stat(resp, fatores[, i], mean) colnames(mean.table) <- c("Niveis", "Medias") print(mean.table)

cat("------------------------------------------------------------------------") } if (quali[i] == FALSE && tab[[1]][i, 5] <= sigF) { cat(fac.names[i]) reg.poly(resp, fatores[, i], tab[[1]][4, 1], tab[[1]][4, 2], tab[[1]][i, 1], tab[[1]][i, 2]) } if (quali[i] == FALSE && tab[[1]][i, 5] > sigF) { cat(fac.names[i]) cat("\nDe acordo com o teste F, as medias desse fator sao estatisticamente iguais.\n\n")

cat("------------------------------------------------------------------------\n") mean.table <- tapply.stat(resp, fatores[, i], mean) colnames(mean.table) <- c("Niveis", "Medias") print(mean.table)

cat("------------------------------------------------------------------------") } cat("\n") } } if (any(unfold == 2)) { cat("\n\n\nInteracao significativa: desdobrando a interacao\n------------------------------------------------------------------------\n") cat("\nDesdobrando ", fac.names[1], " dentro de cada nivel de ", fac.names[2], "\n------------------------------------------------------------------------\n") des1 <- aov(resp ~ Fator2/Fator1) l1 <- vector("list", nv2) names(l1) <- names(summary(Fator2)) v <- numeric(0) for (j in 1:nv2) { for (i in 0:(nv1 - 2)) v <- cbind(v, i * nv2 + j) l1[[j]] <- v v <- numeric(0) } des1.tab <- summary(des1, split = list(`Fator2:Fator1` = l1))[[1]] glb = nv2 - 1 glf1 = c(as.numeric(des1.tab[3:(nv2 + 2), 1])) glE = tab[[1]][4, 1] glT = tab[[1]][5, 1] SQb = tab[[1]][2, 2] SQf1 = c(as.numeric(des1.tab[3:(nv2 + 2), 2])) SQE = tab[[1]][4, 2] SQT = tab[[1]][5, 2] QMb = SQb/glb QMf1 = SQf1/glf1 QME = SQE/glE QMT = SQT/glT Fcb = QMb/QME Fcf1 = QMf1/QME rn <- numeric(0) for (j in 1:nv2) { rn <- c(rn, paste(paste(fac.names[1], ":", fac.names[2], sep = ""), lf2[j])) } anavad1 <- data.frame(GL = c(round(c(glb, glf1, glE, glT))), SQ = c(round(c(SQb, SQf1, SQE, SQT), 5)), QM = c(round(c(QMb, QMf1, QME, QMT), 5)), Fc = c(round(c(Fcb,

Fcf1), 4), " ", " "), `Pr>Fc` = c(round(c(1 -

pf(Fcb, glb, glE), 1 - pf(Fcf1, glf1, glE)),

4), "", "")) rownames(anavad1) = c(fac.names[2], rn, "Residuo", "Total")

cat("------------------------------------------------------------------------\nQuadro da analise de variancia\n------------------------------------------------------------------------\n") print(anavad1)

cat("------------------------------------------------------------------------\n\n") for (i in 1:nv2) { if (des1.tab[(i + 2), 5] <= sigF) { if (quali[1] == TRUE) { cat("\n\n", fac.names[1], " dentro do nivel ", lf2[i], " de ", fac.names[2], "\n------------------------------------------------------------------------") if (mcomp == "tukey") { tukey(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "duncan") { duncan(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4,

2], sigT) } if (mcomp == "lsd") { lsd(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "lsdb") { lsdb(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "sk") { scottknott(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4,

2], sigT) } if (mcomp == "snk") { snk(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "ccboot") { ccboot(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4,

2], sigT) } if (mcomp == "ccF") { ccF(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } } else { cat("\n\n", fac.names[1], " dentro do nivel ", lf2[i], " de ", fac.names[2], "\n------------------------------------------------------------------------") reg.poly(resp[Fator2 == lf2[i]], fator1[Fator2 == lf2[i]], tab[[1]][4, 1], tab[[1]][4, 2], des1.tab[i + 2, 1], des1.tab[i + 2, 2]) } } else { cat("\n\n", fac.names[1], " dentro do nivel ", lf2[i], " de ", fac.names[2], "\n") cat("\nDe acordo com o teste F, as medias desse fator sao estatisticamente iguais.\n")

cat("------------------------------------------------------------------------\n") mean.table <- tapply.stat(resp[Fator2 == lf2[i]], fatores[, 1][Fator2 == lf2[i]], mean) colnames(mean.table) <- c("Niveis", "Medias") print(mean.table)

cat("------------------------------------------------------------------------\n") } } cat("\n\n") cat("\nDesdobrando ", fac.names[2], " dentro de cada nivel de ", fac.names[1], "\n------------------------------------------------------------------------\n") des2 <- aov(resp ~ Fator1/Fator2) l2 <- vector("list", nv1) names(l2) <- names(summary(Fator1)) v <- numeric(0) for (j in 1:nv1) { for (i in 0:(nv2 - 2)) v <- cbind(v, i * nv1 + j) l2[[j]] <- v v <- numeric(0) } des2.tab <- summary(des2, split = list(`Fator1:Fator2` = l2))[[1]] gla = nv1 - 1 glf2 = c(as.numeric(des2.tab[3:(nv1 + 2), 1])) SQa = tab[[1]][1, 2] SQf2 = c(as.numeric(des2.tab[3:(nv1 + 2), 2])) QMa = SQa/gla QMf2 = SQf2/glf2 Fca = QMa/QME Fcf2 = QMf2/QME rn <- numeric(0) for (i in 1:nv1) { rn <- c(rn, paste(paste(fac.names[2], ":", fac.names[1], sep = ""), lf1[i])) } anavad2 <- data.frame(GL = c(round(c(gla, glf2, glE, glT))), SQ = c(round(c(SQa, SQf2, SQE, SQT), 5)), QM = c(round(c(QMa, QMf2, QME, QMT), 5)), Fc = c(round(c(Fca,

Fcf2), 4), " ", " "), `Pr>Fc` = c(round(c(1 -

pf(Fca, gla, glE), 1 - pf(Fcf2, glf2, glE)),

4), "", "")) rownames(anavad2) = c(fac.names[1], rn, "Residuo", "Total")

cat("------------------------------------------------------------------------\nQuadro da analise de variancia\n------------------------------------------------------------------------\n") print(anavad2)

cat("------------------------------------------------------------------------\n\n") for (i in 1:nv1) { if (des2.tab[(i + 2), 5] <= sigF) { if (quali[2] == TRUE) { cat("\n\n", fac.names[2], " dentro do nivel ", lf1[i], " de ", fac.names[1], "\n------------------------------------------------------------------------") if (mcomp == "tukey") { tukey(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "duncan") { duncan(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4,

2], sigT) } if (mcomp == "lsd") { lsd(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "lsdb") { lsdb(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "sk") { scottknott(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4,

2], sigT) } if (mcomp == "snk") { snk(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } if (mcomp == "ccboot") { ccboot(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4,

2], sigT) } if (mcomp == "ccF") { ccF(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4, 2], sigT) } } else { cat("\n\n", fac.names[2], " dentro do nivel ", lf1[i], " de ", fac.names[1], "\n------------------------------------------------------------------------") reg.poly(resp[Fator1 == lf1[i]], fator2[Fator1 == lf1[i]], tab[[1]][4, 1], tab[[1]][4, 2], des2.tab[i + 2, 1], des2.tab[i + 2, 2]) } } else { cat("\n\n", fac.names[2], " dentro do nivel ", lf1[i], " de ", fac.names[1], "\n") cat("\nDe acordo com o teste F, as medias desse fator sao estatisticamente iguais.\n")

cat("------------------------------------------------------------------------\n") mean.table <- tapply.stat(resp[Fator1 == lf1[i]], fatores[, 2][Fator1 == lf1[i]], mean) colnames(mean.table) <- c("Niveis", "Medias") print(mean.table)

cat("------------------------------------------------------------------------\n") } } } out <- list() out$residuos <- anava$residuals out$gl.residual <- anava$df.residual out$coeficientes <- anava$coefficients out$efeitos <- anava$effects out$valores.ajustados <- anava$fitted.values out$medias.fator1 <- tapply.stat(resp, fatores[, 1], mean) out$medias.fator2 <- tapply.stat(resp, fatores[, 2], mean) tabmedia <- model.tables(anava, "means") out$medias.dentro12 <- tabmedia$tables$`Fator1:Fator2` invisible(out) }

fat2.dic(revol, esterco, zn, quali=c(FALSE,TRUE), mcomp="tukey", fac.names=c("Revolvimento","Esterco"), sigT = 0.05, sigF = 0.05, unfold=NULL)

Em seg., 18 de dez. de 2023 às 05:34, Andre Oliveira por (R-br) < r-br@listas.c3sl.ufpr.br> escreveu:

...

bom dia, *QM errado.*

att,. André

Em domingo, 17 de dezembro de 2023 às 14:30:57 BRT, Cesar Rabak por (R-br) <r-br@listas.c3sl.ufpr.br> escreveu:

OK e qual era a expectativa que foi frustrada em relação ao resultado obtido?

On Sun, Dec 17, 2023 at 8:06 AM Andre Oliveira por (R-br) < r-br@listas.c3sl.ufpr.br> wrote:

bom dia, segue!

*require(ExpDes.pt)*

*data(ex4)* *attach(ex4)* *fat2.dic(revol,esterco,zn,quali=c(FALSE,TRUE),mcomp="tukey", **fac.names=c("Revolvimento","Esterco"),sigT = 0.05, **sigF = 0.05, unfold=NULL)*

att,. André

Em domingo, 17 de dezembro de 2023 às 08:04:57 BRT, Andre Oliveira < andreolsouza@yahoo.com.br> escreveu:

bo dia dia! segue!

att,. André

Em sábado, 16 de dezembro de 2023 às 21:11:21 BRT, Cesar Rabak por (R-br) <r-br@listas.c3sl.ufpr.br> escreveu:

CMR ?

On Sat, Dec 16, 2023 at 4:20 PM Andre Oliveira por (R-br) < r-br@listas.c3sl.ufpr.br> wrote:

*boa tarde,* *alguém com problemas com a biblioteca ExpDes.pt? Função fatorial duplo retornando o QM errado.*

*att,.* *André * _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.

_______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível. _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.

_______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível. _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.

--

Alan Rodrigo Panosso

----------------------------------------------------------------------------

Professor Assistente Doutor - Departamento de Engenharia e Ciências Exatas Faculdade de Ciências Agrárias e Veterinárias - FCAV - UNESP/Jaboticabal

Via de Acesso Prof.Paulo Donato Castellane s/n

14884-900 - Jaboticabal, SP

E_mail: alan.panosso@u <alanrp@mat.feis.unesp.br>nesp.br Tel.: (16) 3209-7210 _______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.