version 1.0-8

DESCRIPTION

@@ -1,26 +1,32 @@
 Package: agricolae
 Type: Package
 Title: Statistical Procedures for Agricultural Research
-Version: 1.0-7
-Date: 2009-4-20
+Version: 1.0-8
+Date: 2009-12-01
 Author: Felipe de Mendiburu
 Maintainer: Felipe de Mendiburu <f.mendiburu@cgiar.org>
-Suggests: akima, klaR, SuppDists, corpcor
-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
+Suggests: akima, klaR, MASS
+Description: Agricolae was presented on 28 August 2009 in the thesis "A
+        statistical analysis tool for agricultural research" to obtain
+        the degree of Master on science, mention Systems Engineering,
+        of the facultad de ingenieria industrial y de sistemas -
+        Universidad Nacional de Ingenieria, Lima-Peru (UNI), being
+        approved with the qualification of 18.14 in a scale from 0 to
+        20. The thesis includes a satisfaction survey of the library,
+        with an index quality of the software of 0.8 in scale of 0-1.
+        These functions are currently used by the International Potato
+        Center (CIP), the Universidad Nacional Agraria La Molina
+        (UNALM-PERU), and the Instituto Nacional de Innovacion Agraria
         (INIA-PERU). It comprises the functionality of statistical
-        analysis into experimental designs applied specially for field
+        analysis into experimental designs applied specially in 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.
+        factorial, complete and incomplete block, Latin Square, Graeco,
+        Alpha designs, Cyclic, split and strip plot 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: 2009-04-20 13:52:25 UTC; fdemendiburu
+Packaged: 2009-12-01 16:41:30 UTC; fdemendiburu
 Repository: CRAN
-Date/Publication: 2009-04-20 17:21:12
+Date/Publication: 2009-12-01 17:35:22

R/AMMI.R

@@ -136,7 +136,6 @@ function (ENV, GEN, REP, Y, MSE = 0, number = TRUE, graph = "biplot",
     nss<-nrow(SSAMMI)
     row.names(SSAMMI) <- paste("PC", 1:nss, sep = "")
     cat("\nAnalysis\n")
-
     print(SSAMMI)
     LL <- sqrt(diag(L))
     SCOREG <- U %*% LL
@@ -161,16 +160,16 @@ function (ENV, GEN, REP, Y, MSE = 0, number = TRUE, graph = "biplot",
     cp.name <- rownames(SSAMMI)[1:3]
     cp.per <- SSAMMI[1:3, 1]
     if (graph == "biplot") {
+    plot(bplot[,3],bplot[,4],cex=0, xlab = "PC 1", ylab = "PC 2",
+                frame = TRUE, ...)
         if (number == TRUE) {
-            plot(MGEN[, 3], MGEN[, 4], cex = 0, text(MGEN[, 3],
+            text(MGEN[, 3], MGEN[, 4], cex = 0, text(MGEN[, 3],
                 MGEN[, 4], labels = as.character(1:nrow(MGEN)),
-                col = "blue"), xlab = "PC 1", ylab = "PC 2",
-                frame = TRUE, ...)
+                col = "blue"))
         }
         if (number == FALSE) {
-            plot(MGEN[, 3], MGEN[, 4], cex = 0, text(MGEN[, 3],
-                MGEN[, 4], labels = row.names(MGEN), col = "blue"),
-                xlab = "PC 1", ylab = "PC 2", frame = TRUE, ...)
+            text(MGEN[, 3], MGEN[, 4], cex = 0, text(MGEN[, 3],
+                MGEN[, 4], labels = row.names(MGEN), col = "blue"))
         }
         points(MENV[, 3], MENV[, 4], cex = 0, text(MENV[, 3],
             MENV[, 4], labels = row.names(MENV), col = "brown"))
@@ -219,4 +218,3 @@ function (ENV, GEN, REP, Y, MSE = 0, number = TRUE, graph = "biplot",
     }
     return(list(genXenv=OUTRES2, analysis=SSAMMI, means=MEDIAS, biplot=bplot))
 }
-

R/LSD.test.R

@@ -10,15 +10,18 @@ function (y, trt, DFerror, MSerror, alpha = 0.05, p.adj = c("none",
     means <- tapply.stat(junto[, 1], junto[, 2], stat="mean") #change
     sds <- tapply.stat(junto[, 1], junto[, 2], stat="sd")     #change
     nn <- tapply.stat(junto[, 1], junto[, 2], stat="length")  #change
-    means <- data.frame(means, std.err = sds[, 2]/sqrt(nn[, 2]),
-        replication = nn[, 2])
+    std.err <- sds[, 2]/sqrt(nn[, 2])
+    Tprob <- qt(1 - alpha/2, DFerror)
+    LCI <- means[,2]-Tprob*std.err
+    UCI <- means[,2]+Tprob*std.err
+    means <- data.frame(means, std.err, replication = nn[, 2],
+    LCI, UCI)
     names(means)[1:2] <- c(name.t, name.y)
     #row.names(means) <- means[, 1]
     ntr <- nrow(means)
     nk <- choose(ntr, 2)
-    if (p.adj == "none")
-        Tprob <- qt(1 - alpha/2, DFerror)
-    else {
+    if (p.adj != "none")
+        {
         a <- 1e-06
         b <- 1
         for (i in 1:100) {
@@ -43,7 +46,7 @@ function (y, trt, DFerror, MSerror, alpha = 0.05, p.adj = c("none",
     xtabla <- data.frame(...... = nvalor)
     row.names(xtabla) <- nfila
     print(xtabla)
-    cat("\nTreatment Means\n")
+    cat("\nTreatment Means and Individual (1-alpha)*100% CI\n")
     print(data.frame(row.names = NULL, means))
     if (group) {
         if (length(nr) == 1) {
@@ -60,6 +63,8 @@ function (y, trt, DFerror, MSerror, alpha = 0.05, p.adj = c("none",
         cat("\n\nGroups, Treatments and means\n")
         output <- order.group(means[, 1], means[, 2], means[,
             4], MSerror, Tprob, means[, 3])
+        w<-order(means[,2],decreasing = TRUE)
+        output <- data.frame(output,LCI=means[w,5],UCI=means[w,6])
     }
     if (!group) {
         comb <- combn(ntr, 2)
@@ -83,7 +88,7 @@ function (y, trt, DFerror, MSerror, alpha = 0.05, p.adj = c("none",
         print(data.frame(row.names = NULL, tr.i, tr.j, diff = dif,
             pvalue = pvalue))
         output <- data.frame(trt = means[, 1], means = means[,
-            2], M = "", N = means[, 4], std.err = means[, 3])
+            2], M = "", N = means[, 4], std.err ,LCI,UCI)
     }
     return(output)
     }

R/PBIB.test.R

@@ -62,7 +62,7 @@ function (block, trt, replication, y, k, method = "lsd", alpha = 0.05)
 #    c2 <- W%*%c1
 #    print(c0); print(c1); print(c2)
 ########################
-    inversa <- pseudoinverse(Ib - lambda * W)
+    inversa <- ginv(Ib - lambda * W)
     tauIntra <- t(X) %*% y/r - lambda * N %*% inversa %*% c0
     vartau <- (Ee/r) * (Iv + lambda * N %*% inversa %*% t(N))
 #   vartau <- (Ee/r) * (Iv + lambda * N %*%t(N)+lambda^2 * N%*%W%*%t(N))

R/design.crd.R

@@ -18,9 +18,9 @@ for (i in 2:tr) y <- c(y, rep(TR[i], r[i]))
 for (i in 2:length(r)) {
 	r1<-c(r1,seq(1,r[i]))
 }
-yy<-data.frame(xx,r=r1)
+yy<-data.frame(plots=xx[,1],r=r1,xx[,2])
 book<-yy[order(yy[,1]),]
-names(book)[2]<-c(paste(deparse(substitute(trt))))
+names(book)[3]<-c(paste(deparse(substitute(trt))))
 return(book)
 }
 

R/design.dau.R

@@ -0,0 +1,28 @@
+`design.dau` <-
+function (trt1, trt2, r,number=1,seed=0,kinds="Super-Duper",name="trt")
+{
+ntr1 <- length(trt1)
+if(seed != 0) set.seed(seed,kinds)
+mtr1 <- sample(trt1, ntr1, replace = FALSE)
+block <- c(rep(1, ntr1))
+for (y in 2:r) {
+block <- c(block, rep(y, ntr1))
+mtr1 <- c(mtr1, sample(trt1, ntr1, replace = FALSE))
+}
+ntr2 <- length(trt2)
+mtr2 <- sample(trt2,ntr2, replace = FALSE)
+s<-s<-1:ntr2%%r
+for(i in 1:ntr2) if(s[i]==0)s[i]<-r
+block <- c(block, s)
+mtr <- c(mtr1,mtr2)
+plots <- number+1:(ntr1*r + ntr2)-1
+
+book<-data.frame(block=as.factor(block),trt=as.factor(mtr))
+book<-book[order(book[,1]),]
+for (i in 1:r)
+book[book[,1]==i,2]<-sample(book[book[,1]==i,2],length(book[book[,1]==i,2]))
+book<-data.frame(plots,book)
+rownames(book)=1:nrow(book)
+names(book)[3]<-name
+return(book) }
+

R/design.lattice.R

@@ -44,5 +44,5 @@ trt<-c(as.numeric(t(c1)),as.numeric(t(c2)),as.numeric(t(c3)))
 plots<-(number-1)+1:(3*k*k)
 plan<-data.frame(plots,sqr=sqr,block=block,trt=trt)
 if (type=="triple") return(list(square1=c1,square2=c2,square3=c3,plan=plan))
-if (type=="simple") return(list(square1=c1,square2=c2,plan=subset(plan,plan[,3]<3)))
+if (type=="simple") return(list(square1=c1,square2=c2,plan=subset(plan,as.numeric(plan[,2])<3)))
 }

R/design.split.R

@@ -0,0 +1,34 @@
+design.split<-function (trt1, trt2,r=NULL, design=c("rcbd","crd","lsd"),number = 1, seed = 0, kinds = "Super-Duper") 
+{
+    n1<-length(trt1)
+    n2<-length(trt2)
+     if (seed != 0) 
+        set.seed(seed, kinds)
+    design <- match.arg(design)
+    if (design == "crd") {
+        book<-design.crd(trt1,r,number, seed, kinds)
+        k<-3
+        }
+    if (design == "rcbd"){
+        book<-design.rcbd(trt1,r,number, seed, kinds)
+        k<-3
+        }
+    if (design == "lsd") {
+        book<-design.lsd(trt1,number, seed, kinds)
+        r<-n1
+        k<-4
+        }
+nplot<-nrow(book)
+d<-NULL
+for(i in 1:nplot)d<-rbind(d,sample(trt2,n2))
+aa<-data.frame(book,trt2=d[,1])
+for(j in 2:n2) aa<-rbind(aa,data.frame(book,trt2=d[,j]))
+aa<-aa[order(aa[,1]),]
+    book <- aa
+rownames(book)<-1:(nrow(book))
+    names(book)[k] <- c(paste(deparse(substitute(trt1))))
+    names(book)[k+1] <- c(paste(deparse(substitute(trt2))))
+    return(book)
+}
+
+

R/design.strip.R

@@ -0,0 +1,25 @@
+design.strip<-function (trt1, trt2,r, number = 1, seed = 0, kinds = "Super-Duper") 
+{
+    n1<-length(trt1)
+    n2<-length(trt2)
+    if (seed != 0) 
+        set.seed(seed, kinds)
+        a<-sample(trt1,n1)
+        b<-sample(trt2,n2)
+        fila<-rep(b,n1)
+        columna <- a[gl(n1,n2)]
+        block <- rep(1,n1*n2)
+    if (r > 1) {
+    for (i in 2:r) {
+        a<-sample(trt1,n1)
+        b<-sample(trt2,n2)
+        fila<-c(fila,rep(b,n1))
+        columna <- c(columna,a[gl(n1,n2)])
+        block <- c(block,rep(i,n1*n2))
+    }}
+    plots <- number + 1:(n1*n2 * r) - 1
+    book <- data.frame(plots, block = as.factor(block), row = as.factor(fila), column=as.factor(columna))
+    names(book)[3] <- c(paste(deparse(substitute(trt1))))
+    names(book)[4] <- c(paste(deparse(substitute(trt2))))
+    return(book)
+}

R/durbin.test.R

@@ -34,9 +34,11 @@ s <- (y-r*(k+1)/2)^2
 s1 <- sum(s)
 # determina el valor de Durbin
 gl1<-ntr-1 ;gl2<-b*k-ntr-b+1
-s <- 12*(ntr-1)*s1/(r*ntr*(k-1)*(k+1))
+C <- b*k*(k+1)^2/4
+A <- sum(rango^2)
+s <- (ntr - 1) * s1/(A-C)
 prob<-1-pchisq(s,gl1); Tprob<-qt(1-alpha/2,gl2)
-sdtdif<- sqrt( r*k*(k+1)*(b*(k-1)-s)/(6*gl2))
+sdtdif <- sqrt(2*r*(A-C)*(1-s/(b*(k-1)))/gl2)
 LSD <-Tprob*sdtdif
 # s,prob,Tprob,Mc,gl1,gl2)
 # Impresion de resultados
@@ -87,4 +89,3 @@ output<-data.frame(means,M="",N=r)
 #
 return(output)
 }
-

R/friedman.R

@@ -50,11 +50,14 @@ C1 <-m[1]*m[2]*(m[2]+1)^2/4
 T1.aj <-(m[2]-1)*(t(s)%*%s-m[1]*C1)/(A1-C1)
 T2.aj <-(m[1]-1)*T1.aj/(m[1]*(m[2]-1)-T1.aj)
 p.value<-1-pchisq(T1.aj,m[2]-1)
-p.fried<-1-pFriedman(T1.aj, ntr, nr)
-cat("\nChi-squard:",T1.aj)
-cat("\nPvalue    :",p.value)
-cat("\npFriedman :",p.fried)
-cat("\nAlpha     :",alpha)
+p.noadj<-1-pchisq(T1,m[2]-1)
+PF<-1-pf(T2.aj, ntr-1, (ntr-1)*(nr-1) )
+cat("\nAdjusted for ties")
+cat("\nValue:",T1.aj)
+cat("\nPvalue chisq :",p.value)
+cat("\nF value :",T2.aj)
+cat("\nPvalue F:",PF)
+cat("\n\nAlpha     :",alpha)
 cat("\nt-Student :",Tprob)
 #...............
 #cat("\nReplication:\t",nr)
@@ -80,7 +83,7 @@ dif[k]<-abs(s[comb[1,k]]-s[comb[2,k]])
 sdtdif<- sqrt(2*(m[1]*A1-t(s)%*%s)/DFerror)
 pvalue[k]<- 2*round(1-pt(dif[k]/sdtdif,DFerror),4)
 LSD[k]<-round(Tprob*sdtdif,2)
-if (dif[k] >= LSD[k]) stat[k]<-"*" 
+if (dif[k] >= LSD[k]) stat[k]<-"*"
 }
 tr.i<-comb[1,]
 tr.j<-comb[2,]
@@ -91,4 +94,3 @@ output<-data.frame(trt= means[,1],means= means[,2],M="",N=means[,3])
 }
 return(output)
 }
-

R/kruskal.R

@@ -22,13 +22,11 @@ DFerror<-N - ntr
         S <- (sum(junto[, 1]^2) - (N * (N + 1)^2)/4)/(N - 1)
         H <- (rs - (N * (N + 1)^2)/4)/S
     cat("\nStudy:",main)
-    cat("\nKruskal-Wallis test's\n")
+    cat("\nKruskal-Wallis test's\nTies or no Ties\n")
     cat("\nValue:", H)
     cat("\ndegrees of freedom:", ntr - 1)
     p.chisq <- 1 - pchisq(H, ntr - 1)
-    p.kw <- 1-pKruskalWallis(H, ntr, N, U)
     cat("\nPvalue chisq  :", p.chisq)
-    cat("\npKruskalWallis:", p.kw, "\n")
     DFerror <- N - ntr
     Tprob <- qt(1 - alpha/2, DFerror)
     MSerror <- S * ((N - 1 - H)/(N - ntr))
@@ -52,7 +50,7 @@ cat("\nAlpha    :",alpha)
          cat("\nLSD      :", LSD1,"\n")
          cat("\nHarmonic Mean of Cell Sizes ", nr1)
          }
-cat("\nMeans with the same letter are not significantly different\n")
+cat("\n\nMeans with the same letter are not significantly different\n")
 cat("\nGroups, Treatments and mean of the ranks\n")
 output <- order.group(means[,1], means[,2], means[,3], MSerror, Tprob,std.err=sqrt(MSerror/ means[,3]))
  }

R/resampling.model.R

@@ -1,5 +1,5 @@
 `resampling.model` <-
-function(k,data,model) {
+function(model,data,k) {
 modelo<-model
 parte<-strsplit(model,"~")[[1]]
 model<-as.formula(model)

R/simulation.model.R

@@ -1,5 +1,5 @@
 `simulation.model` <-
-function(k,file,model,categorical=NULL) {
+function(model,file,categorical=NULL,k) {
 modelo<-model
 parte<-strsplit(model,"~")[[1]]
 model<-as.formula(model)

man/AMMI.Rd

@@ -54,10 +54,8 @@ library(klaR)
 data(plrv)
 #startgraph
 # biplot
-model<- AMMI(plrv[,2], plrv[,1], plrv[,3], plrv[,5],xlim=c(-3,3),ylim=c(-4,4),
-graph="biplot")
-model<- AMMI(plrv[,2], plrv[,1], plrv[,3], plrv[,5],xlim=c(-3,3),ylim=c(-4,4),
-graph="biplot",number=FALSE)
+model<- AMMI(plrv[,2], plrv[,1], plrv[,3], plrv[,5],graph="biplot")
+model<- AMMI(plrv[,2], plrv[,1], plrv[,3], plrv[,5],graph="biplot",number=FALSE)
 # triplot
 model<- AMMI(plrv[,2], plrv[,1], plrv[,3], plrv[,5],graph="triplot")
 model<- AMMI(plrv[,2], plrv[,1], plrv[,3], plrv[,5],graph="triplot",number=FALSE)
@@ -70,7 +68,7 @@ cic <- rbind(data1,data2)
 attach(cic)
 #startgraph
 par(cex=0.6)
-model<-AMMI(Locality, Genotype, Rep, relative,xlim=c(-0.6,0.6),
+model<-AMMI(Locality, Genotype, Rep, relative,
 ylim=c(-1.5e-8,1.5e-8))
 #endgraph
 pc<- princomp(model$genXenv, cor = FALSE)
@@ -85,7 +83,7 @@ attach(sinRepAmmi)
 REP <- 3
 MSerror <- 93.24224
 #startgraph
-model<-AMMI(ENV, GEN, REP, YLD, MSerror,xlim=c(-8,6),ylim=c(-6,6))
+model<-AMMI(ENV, GEN, REP, YLD, MSerror)
 #endgraph
 pc<- princomp(model$genXenv, cor = FALSE)
 pc$loadings

man/AMMI.contour.Rd

@@ -39,7 +39,7 @@ REP <- 3
 MSerror <- 93.24224
 # Example 1
 #startgraph
-model<-AMMI(ENV, GEN, REP, YLD, MSerror,xlim=c(-8,6),ylim=c(-6,6))
+model<-AMMI(ENV, GEN, REP, YLD, MSerror)
 AMMI.contour(model,distance=0.7,shape=8,col="red",lwd=2,lty=5)
 #endgraph
 # Example 2

man/PBIB.test.Rd

@@ -44,7 +44,7 @@ Wiley Classics Library Edition published 1992
 \seealso{\code{\link{BIB.test}}, \code{\link{design.alpha}} }
 \examples{
 library(agricolae)
-library(corpcor)
+library(MASS)
 # alpha design 
 trt<-1:30
 ntr<-length(trt)