-
Notifications
You must be signed in to change notification settings - Fork 9
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
b13ada1
commit 47c1125
Showing
176 changed files
with
1,614 additions
and
1,242 deletions.
There are no files selected for viewing
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,12 +1,12 @@ | ||
| Package: agricolae | ||
| Type: Package | ||
| Title: Statistical Procedures for Agricultural Research | ||
| Version: 1.0-4 | ||
| Date: 2007-09-11 | ||
| Version: 1.0-5 | ||
| Date: 2008-07-25 | ||
| Author: Felipe de Mendiburu | ||
| Maintainer: Felipe de Mendiburu <f.mendiburu@cgiar.org> | ||
| Suggests: akima, klaR, SuppDists, corpcor | ||
| Description: These functions are currently utilized by the International Potato Center Research (CIP), the Statistics and Informatics Instructors and the Students of the Universidad Nacional Agraria La Molina Peru, and the Specialized Master in "Bosques y Gestion de Recursos Forestales" (Forest Resource Management). This package contains functionality for the statistical analysis of experimental designs applied specially for field experiments in agriculture and plant breeding. Planning of field experiments: Lattice, factorial, RCBD, CRD, Latin Square, Greaco, BIB, PBIB, Alpha design. Comparison of multi-location trials: AMMI (biplot and triplot), Stability. Comparison between treatments: LSD, Bonferroni, HSD, Waller, Kruskal, Friedman, Durbin, Van Der Waerden. Resampling and simulation: resampling.model, simulation.model, analysis Mother and baby trials, Ecology: Indices Biodiversity, path analysis, consensus cluster, Uniformity Soil: Index Smith's. | ||
| Description: Agricolae is a project in order to obtain the degree of master in Systems Engineering in the National University of Engineering in Lima-Peru (UNI in Spanish). These functions are currently utilized by the International Potato Center Research (CIP), the Universidad Nacional Agraria La Molina (UNALM-PERU), and the Instituto Nacional de Investigacion Agricola (INIA-PERU). It comprises the functionality of statistical analysis into experimental designs applied specially for field experiments in agriculture and plant breeding: Lattice, factorial, complete and incomplete block, Latin Square, Greaco, Alpha designs, Cyclic designs, comparison of multi-location trials, comparison between treatments, resampling, simulation, biodiversity indexes and consensus cluster. | ||
| License: GPL | ||
| URL: http://tarwi.lamolina.edu.pe/~fmendiburu | ||
| Packaged: Tue Sep 11 20:55:49 2007; hornik | ||
| Packaged: Fri Jul 25 19:04:19 2008; fdemendiburu |
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,100 +1,114 @@ | ||
| `BIB.test` <- | ||
| function(block,trt,y, method="lsd", alpha=0.05,group=TRUE) | ||
| function (block, trt, y, method = "lsd", alpha = 0.05, group = TRUE) | ||
| { | ||
| block.unadj<-as.factor(block) | ||
| trt.adj <-as.factor(trt) | ||
| name.y <- paste(deparse(substitute(y))) | ||
| model<-lm(y ~ block.unadj+trt.adj) | ||
| DFerror<-df.residual(model) | ||
| MSerror<-deviance(model)/DFerror | ||
| k <-unique(table(block.unadj)) | ||
| r <-unique(table(trt.adj)) | ||
| b <-nlevels(block.unadj) | ||
| ntr <-nlevels(trt.adj) | ||
| lambda<-r*(k-1)/(ntr-1) | ||
| tabla<-suppressWarnings(mxyz(block,trt,y )) | ||
| AA<-!is.na(tabla) | ||
| BB<-tapply(y,block.unadj,sum) | ||
| B<-BB%*%AA | ||
| Y<-tapply(y,trt.adj,sum) | ||
| Q<-Y-as.numeric(B)/k | ||
|
|
||
| SStrt.adj<-sum(Q^2)*k/(lambda*ntr) | ||
| MStrt.adj<- SStrt.adj/(ntr-1) | ||
| sdtdif<-sqrt(2*k*MSerror/(lambda*ntr)) | ||
| Fvalue<- MStrt.adj/MSerror | ||
| # mean adjusted. | ||
|
|
||
| mean.adj<-mean(y)+Q*k/(lambda*ntr) | ||
| sdmean.adj <- sqrt(MSerror*(1+k*r*(ntr-1)/(lambda*ntr))/(r*ntr)) | ||
| cat("\nANALYSIS BIB: ", name.y, "\nClass level information\n") | ||
| cat("\nBlock: ", unique(as.character(block))) | ||
| cat("\nTrt : ", unique(as.character(trt))) | ||
| cat("\n\nNumber of observations: ", length(y), "\n\n") | ||
| print(anova(model)) | ||
| cat("coefficient of variation:",round(cv.model(model),1),"%\n") | ||
| cat("\nTreatments\n") | ||
| print(data.frame( row.names=NULL,trt=row.names(Y),means=Y/r,mean.adj,sdmean.adj)) | ||
| parameter<- k/(lambda*ntr) | ||
| if (method=="lsd") { | ||
| Tprob<-qt(1-alpha/2,DFerror) | ||
| cat("\nLSD test\n") | ||
| cat("\nAlpha :",alpha) | ||
| cat("\nLSD :",Tprob*sdtdif) | ||
| } | ||
| if (method=="tukey") { | ||
| Tprob <- qtukey(1-alpha, ntr, DFerror) | ||
| cat("\nTukey\n") | ||
| cat("\nAlpha :",alpha) | ||
| cat("\nHSD :",Tprob*sdtdif) | ||
| parameter<-parameter/2 | ||
| } | ||
| if (method=="waller") { | ||
| K<-650-16000*alpha+100000*alpha^2 | ||
| Tprob<-waller(K,ntr-1,DFerror,Fvalue) | ||
| cat("\nWaller-Duncan K-ratio\n") | ||
| cat("\nThis test minimizes the Bayes risk under additive") | ||
| cat("\nloss and certain other assumptions.\n") | ||
| cat("\nk Ratio: ",K) | ||
| cat("\nMSD :",Tprob*sdtdif) | ||
| } | ||
| E<-lambda*ntr/(r*k) | ||
| cat("\nParameters BIB") | ||
| cat("\nLambda :",lambda) | ||
| cat("\ntreatmeans :",ntr) | ||
| cat("\nBlock size :",k) | ||
| cat("\nBlocks :",b) | ||
| cat("\nReplication:",r,"\n") | ||
| cat("\nEfficiency factor",E,"\n\n<<< Book >>>\n") | ||
| if (group) { | ||
| cat("\nMeans with the same letter are not significantly different.") | ||
| cat("\n\nComparison of treatments\n\nGroups, Treatments and means\n") | ||
| output <- order.group(names(mean.adj), as.numeric(mean.adj), rep(1,ntr), | ||
| MSerror, Tprob,std.err=sdmean.adj,parameter) | ||
| output[,4]<-r | ||
| block.unadj <- as.factor(block) | ||
| trt.adj <- as.factor(trt) | ||
| name.y <- paste(deparse(substitute(y))) | ||
| modelo <- formula(paste(name.y,"~ block.unadj + trt.adj")) | ||
| model <- lm(modelo) | ||
| DFerror <- df.residual(model) | ||
| MSerror <- deviance(model)/DFerror | ||
| k <- unique(table(block.unadj)) | ||
| r <- unique(table(trt.adj)) | ||
| b <- nlevels(block.unadj) | ||
| ntr <- nlevels(trt.adj) | ||
| lambda <- r * (k - 1)/(ntr - 1) | ||
| datos <- data.frame(block, trt, y) | ||
| tabla <- by(datos[,3], datos[,1:2], function(x) mean(x,na.rm=TRUE)) | ||
| tabla <-as.data.frame(tabla[,]) | ||
| AA <- !is.na(tabla) | ||
| BB <- tapply(y, block.unadj, sum) | ||
| B <- BB %*% AA | ||
| Y <- tapply(y, trt.adj, sum) | ||
| Q <- Y - as.numeric(B)/k | ||
| SStrt.adj <- sum(Q^2) * k/(lambda * ntr) | ||
| MStrt.adj <- SStrt.adj/(ntr - 1) | ||
| sdtdif <- sqrt(2 * k * MSerror/(lambda * ntr)) | ||
| Fvalue <- MStrt.adj/MSerror | ||
| mean.adj <- mean(y) + Q * k/(lambda * ntr) | ||
| StdError.adj <- sqrt(MSerror * (1 + k * r * (ntr - 1)/(lambda * | ||
| ntr))/(r * ntr)) | ||
| cat("\nANALYSIS BIB: ", name.y, "\nClass level information\n") | ||
| cat("\nBlock: ", unique(as.character(block))) | ||
| cat("\nTrt : ", unique(as.character(trt))) | ||
| cat("\n\nNumber of observations: ", length(y), "\n\n") | ||
| print(anova(model)) | ||
| cat("\ncoefficient of variation:", round(cv.model(model), 1), | ||
| "%\n") | ||
| cat(name.y, "Means:", mean(y,na.rm=TRUE), "\n") | ||
| cat("\nTreatments\n") | ||
| print(data.frame(row.names = 1:ntr, trt = row.names(Y), means = Y/r, | ||
| mean.adj, StdError.adj)) | ||
| parameter <- k/(lambda * ntr) | ||
| if (method == "lsd") { | ||
| Tprob <- qt(1 - alpha/2, DFerror) | ||
| cat("\nLSD test") | ||
| cat("\nStd.diff :", sdtdif) | ||
| cat("\nAlpha :", alpha) | ||
| cat("\nLSD :", Tprob * sdtdif) | ||
| } | ||
| if (method == "tukey") { | ||
| Tprob <- qtukey(1 - alpha, ntr, DFerror) | ||
| cat("\nTukey") | ||
| cat("\nAlpha :", alpha) | ||
| cat("\nStd.err :", sdtdif) | ||
| cat("\nHSD :", Tprob * sdtdif) | ||
| parameter <- parameter/2 | ||
| } | ||
| if (method == "waller") { | ||
| K <- 650 - 16000 * alpha + 1e+05 * alpha^2 | ||
| Tprob <- waller(K, ntr - 1, DFerror, Fvalue) | ||
| cat("\nWaller-Duncan K-ratio") | ||
| cat("\nThis test minimizes the Bayes risk under additive") | ||
| cat("\nloss and certain other assumptions.\n") | ||
| cat("\nk Ratio : ", K) | ||
| cat("\nMSD :", Tprob * sdtdif) | ||
| } | ||
| E <- lambda * ntr/(r * k) | ||
| cat("\n\nParameters BIB") | ||
| cat("\nLambda :", lambda) | ||
| cat("\ntreatmeans :", ntr) | ||
| cat("\nBlock size :", k) | ||
| cat("\nBlocks :", b) | ||
| cat("\nReplication:", r, "\n") | ||
| cat("\nEfficiency factor", E, "\n\n<<< Book >>>\n") | ||
| if (group) { | ||
| cat("\nMeans with the same letter are not significantly different.") | ||
| cat("\n\nComparison of treatments\n\nGroups, Treatments and means\n") | ||
| output <- order.group(names(mean.adj), as.numeric(mean.adj), | ||
| rep(1, ntr), MSerror, Tprob, std.err = StdError.adj, | ||
| parameter) | ||
| output[, 4] <- r | ||
| } | ||
| if (!group) { | ||
| comb <- combn(ntr, 2) | ||
| nn <- ncol(comb) | ||
| dif <- rep(0, nn) | ||
| pvalue <- rep(0, nn) | ||
| for (k in 1:nn) { | ||
| i <- comb[1, k] | ||
| j <- comb[2, k] | ||
| dif[k] <- abs(mean.adj[i] - mean.adj[j]) | ||
| if (method == "lsd") | ||
| pvalue[k] <- 2 * round(1 - pt(dif[k]/sdtdif, | ||
| DFerror), 4) | ||
| if (method == "tukey") | ||
| pvalue[k] <- round(1 - ptukey(dif[k] * sqrt(2)/sdtdif, | ||
| ntr, DFerror), 4) | ||
| } | ||
| if (method == "waller") | ||
| significant = dif > Tprob * sdtdif | ||
| tr.i <- comb[1, ] | ||
| tr.j <- comb[2, ] | ||
| cat("\nComparison between treatments means\n") | ||
| if (method == "waller") | ||
| print(data.frame(row.names = NULL, tr.i, tr.j, diff = dif, | ||
| significant)) | ||
| else print(data.frame(row.names = NULL, tr.i, tr.j, diff = dif, | ||
| pvalue)) | ||
| output <- data.frame(trt = names(mean.adj), means = as.numeric(mean.adj), | ||
| M = "", N = r, std.err = StdError.adj) | ||
| } | ||
| return(output) | ||
| } | ||
| if (!group) { | ||
| comb <-combn(ntr,2) | ||
| nn<-ncol(comb) | ||
| dif<-rep(0,nn) | ||
| pvalue<-rep(0,nn) | ||
| for (k in 1:nn) { | ||
| i<-comb[1,k] | ||
| j<-comb[2,k] | ||
| dif[k]<-abs(mean.adj[i]-mean.adj[j]) | ||
| if (method=="lsd") pvalue[k]<- 2*round(1-pt(dif[k]/sdtdif,DFerror),4) | ||
| if (method=="tukey") pvalue[k]<- round(1-ptukey(dif[k]*sqrt(2)/sdtdif,ntr,DFerror),4) | ||
| } | ||
| if (method=="waller") significant = dif > Tprob*sdtdif | ||
|
|
||
| tr.i<-comb[1,] | ||
| tr.j<-comb[2,] | ||
|
|
||
| cat("\nComparison between treatments means\n") | ||
| if (method=="waller") print(data.frame(row.names=NULL,tr.i,tr.j,diff=dif,significant)) | ||
| else print(data.frame(row.names=NULL,tr.i,tr.j,diff=dif,pvalue)) | ||
| output<-data.frame(trt= names(mean.adj),means= as.numeric(mean.adj),M="", | ||
| N=r,std.err=sdmean.adj) | ||
| } | ||
| return(output) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.