Não foi possível enviar o arquivo. Será algum problema com as permissões?
Diferenças

Diferenças

Aqui você vê as diferenças entre duas revisões dessa página.

Link para esta página de comparações

Ambos lados da revisão anterior Revisão anterior
Próxima revisão Ambos lados da revisão seguinte
pessoais:walmes:cursoragrarias2012 [2012/09/13 22:08]
walmes
pessoais:walmes:cursoragrarias2012 [2012/10/26 08:50]
walmes
Linha 149: Linha 149:
   * {{http://​www.youtube.com/​watch?​v=MIqyiGvrUXE&​feature=related|Introductory Statistics - Chapter 10: Regression}};​   * {{http://​www.youtube.com/​watch?​v=MIqyiGvrUXE&​feature=related|Introductory Statistics - Chapter 10: Regression}};​
   * {{http://​www.r-tutor.com/​elementary-statistics/​hypothesis-testing|Hypotesis test with R}};   * {{http://​www.r-tutor.com/​elementary-statistics/​hypothesis-testing|Hypotesis test with R}};
 +
 +=== Código ===
 +
 +<​code>​
 +#​------------------------------------------------------------------------------------------
 +
 +vol <- read.table("​http://​www.leg.ufpr.br/​~walmes/​data/​volume.txt",​
 +                  header=TRUE,​ sep="​\t"​)
 +str(vol)
 +vol$dos <- factor(vol$dose)
 +
 +xyplot(volu~dose|gen,​ data=vol)
 +
 +m0 <- aov(volu~gen+dos+gen:​dos,​ data=vol)
 +anova(m0)
 +
 +par(mfrow=c(2,​2));​ plot(m0); layout(1)
 +
 +boxcox(m0)
 +
 +m1 <- aov((volu^(1/​3))~gen+dos+gen:​dos,​ data=vol)
 +par(mfrow=c(2,​2));​ plot(m1); layout(1)
 +anova(m1)
 +
 +with(vol, fat2.crd(gen,​ dos, volu^(1/3), mcomp=c("​sk","​tukey"​)))
 +
 +#​------------------------------------------------------------------------------------------
 +
 +plot(residuals(m0)~vol$dos)
 +plot(residuals(m0)~vol$dose)
 +
 +qqmath(~residuals(m0)|vol$dose)
 +
 +pesos <- tapply(residuals(m0),​ vol$dose, var)
 +vol$pesos <- rep(pesos, each=27)
 +
 +m2 <- aov(volu~gen+dos+gen:​dos,​ data=vol, weights=1/​vol$pesos)
 +par(mfrow=c(2,​2));​ plot(m2); layout(1)
 +anova(m2)
 +
 +require(doBy)
 +
 +popMeans(m2,​ effect="​gen"​)
 +popMeans(m2,​ effect="​dos"​)
 +popMeans(m2,​ effect=c("​gen",​ "​dos"​))
 +
 +require(agricolae)
 +glr <- df.residual(m2)
 +s2 <- deviance(m2)/​df.residual(m2)
 +
 +with(subset(vol,​ dose=="​0"​),​
 +     ​HSD.test(volu,​ gen, DFerror=glr,​ MSerror=pesos[1]*s2))
 +
 +with(subset(vol,​ dose=="​5"​),​
 +     ​HSD.test(volu,​ gen, DFerror=glr,​ MSerror=pesos[2]*s2))
 +
 +with(subset(vol,​ dose=="​25"​),​
 +     ​HSD.test(volu,​ gen, DFerror=glr,​ MSerror=pesos[3]*s2))
 +
 +#​------------------------------------------------------------------------------------------
 +# dose em cada genótipo
 +
 +X <- popMatrix(m2,​ effect=c("​gen",​ "​dos"​))
 +contr <- expand.grid(gen=levels(vol$gen),​ dos=levels(vol$dos))
 +which(contr$gen=="​ATF06B"​)
 +
 +contr.x <- rbind("​0vs5"​=X[1,​]-X[10,​],​
 +                 "​0vs25"​=X[1,​]-X[19,​],​
 +                 "​5vs25"​=X[10,​]-X[19,​])
 +contr.x%*%coef(m2) # estimativas dos contrastes
 +contr.x%*%vcov(m2)%*%t(contr.x)
 +
 +summary(glht(m2,​ linfct=contr.x))
 +
 +#​------------------------------------------------------------------------------------------
 +# fizemos isso para um único nível de gen, o código abaixo faz para todos
 +
 +lM <- lapply(levels(vol$gen),​
 +             ​function(g){
 +               ​X[contr$gen==g,​]
 +             })
 +lM
 +
 +com <- combn(3, 2)
 +
 +compr <- lapply(lM,
 +                function(i){
 +                  m <- t(apply(com,​ 2, function(j) i[j[1],​]-i[j[2],​]))
 +                })
 +names(compr) <- levels(vol$gen)
 +compr
 +
 +lapply(compr,​ function(g) summary(glht(m2,​ linfct=g)))
 +
 +#​------------------------------------------------------------------------------------------
 +# colocando os resultados em um gráfico com IC
 +
 +IC <- lapply(compr,​ function(g) confint(glht(m2,​ linfct=g)))
 +IC <- lapply(IC, "​[[",​ "​confint"​) #​IC[[1]]$confint
 +IC <- do.call(rbind,​ IC)
 +nm <- apply(com, 2, function(i) paste(levels(vol$dos)[i[1]],​ levels(vol$dos)[i[2]],​ sep="​vs"​))
 +
 +IC <- cbind(expand.grid(compr=nm,​ gen=levels(vol$gen)),​ IC)
 +str(IC)
 +
 +require(latticeExtra)
 +
 +segplot(compr~lwr+upr|gen,​ data=IC)
 +
 +segplot(compr~lwr+upr|gen,​ data=IC, layout=c(1,​9),​
 +        strip.left=TRUE,​ strip=FALSE,​
 +        draw.bands=FALSE,​ centers=Estimate,​
 +        segments.fun=panel.arrows,​ ends="​both",​
 +        angle=90, length=1, unit="​mm"​)
 +
 +segplot(compr~lwr+upr|gen,​ data=IC, layout=c(1,​9),​
 +        strip.left=TRUE,​ strip=FALSE,​
 +        draw.bands=FALSE,​ centers=Estimate,​
 +        segments.fun=panel.arrows,​ ends="​both",​
 +        angle=90, length=1, unit="​mm",​
 +        panel=function(...){
 +          panel.segplot(...)
 +          panel.abline(v=0,​ col=2)
 +        })
 +
 +#​------------------------------------------------------------------------------------------
 +
 +</​code>​

QR Code
QR Code pessoais:walmes:cursoragrarias2012 (generated for current page)