R/design.alpha.R

In myaseen208/agricolae: Statistical Procedures for Agricultural Research

#' Alpha design type (0,1)
#' 
#' Generates an alpha designs starting from the alpha design fixing under the
#' series formulated by Patterson and Williams. These designs are generated by
#' the alpha arrangements. They are similar to the lattice designs, but the
#' tables are rectangular s by k (with s blocks and k<s columns.  The number of
#' treatments should be equal to s*k and all the experimental units r*s*k (r
#' replications).
#' 
#' 
#' Parameters for the alpha design: I.  r=2, k <= s; II. r=3, s odd, k <= s;
#' III.r=3, s even, k <= s-1; IV. r=4, s odd but not a multiple of 3, k<=s
#' 
#' r= replications s=number of blocks k=size of block Number of treatment is
#' equal to k*s
#' 
#' @param trt Treatments
#' @param k size block
#' @param r Replications
#' @param serie number plot, 1: 11,12; 2: 101,102; 3: 1001,1002
#' @param seed seed
#' @param kinds method for to randomize
#' @param randomization TRUE or FALSE - randomize
#' @return \item{parameters}{Design parameters} \item{statistics }{Design
#' statistics} \item{sketch}{Design sketch} \item{book}{Fieldbook}
#' @author Felipe de Mendiburu
#' @seealso \code{\link{design.ab}},
#' \code{\link{design.split}},\code{\link{design.bib}}, \code{\link{design.crd}
#' }, \code{\link{design.cyclic} }, \code{\link{design.dau} },
#' \code{\link{design.graeco}}, \code{\link{design.lattice}},
#' \code{\link{design.lsd}}, \code{\link{design.rcbd}},
#' \code{\link{design.strip}}
#' @references H.D. Patterson and E.R. Williams. Biometrika (1976) A new class
#' of resolvable incomplete block designs. printed in Great Britain.  Online:
#' http://biomet.oxfordjournals.org/cgi/content/abstract/63/1/83
#' @keywords design
#' @importFrom stats runif
#' @export
#' @examples
#' 
#' library(agricolae)
#' #Example one
#' trt<-1:30
#' t <- length(trt)
#' # size block k
#' k<-3
#' # Blocks s
#' s<-t/k
#' # replications r
#' r <- 2
#' outdesign<- design.alpha(trt,k,r,serie=2)
#' book<-outdesign$book
#' plots<-book[,1]
#' dim(plots)<-c(k,s,r)
#' for (i in 1:r) print(t(plots[,,i]))
#' outdesign$sketch
#' # Example two 
#' trt<-letters[1:12] 
#' t <- length(trt)
#' k<-3
#' r<-3
#' s<-t/k
#' outdesign<- design.alpha(trt,k,r,serie=2)
#' book<-outdesign$book
#' plots<-book[,1]
#' dim(plots)<-c(k,s,r)
#' for (i in 1:r) print(t(plots[,,i]))
#' outdesign$sketch
#' 
design.alpha <-
function (trt, k, r, serie = 2, seed = 0, kinds = "Super-Duper",randomization=TRUE)
{
number<-10
if(serie>0) number<-10^serie
    name.trt <- c(paste(deparse(substitute(trt))))
    ntr <- length(trt)
    if (seed == 0) {
    genera<-runif(1)
    seed <-.Random.seed[3]
    }
    set.seed(seed,kinds)
    s <- ntr/k
    if (ntr%%k!= 0)
        cat("\nThe size of the block is not appropriate", "\nthe number of treatments must be multiple of k (size block) \n")
    else {
        serie <- ""
        if (r == 2 & k<=s  ) {
            alpha <- matrix(0, nrow = k, ncol = r)
            alpha[2, 2] <- 1
            for (i in 3:k) {
                alpha[i, 2] <- alpha[i - 1, 2] + 1
            }
            serie <- "I"
        }
        if (r == 3 & s%%2 != 0 & k <= s  ) {
            alpha <- matrix(0, nrow = k, ncol = r)
            alpha[2, 2] <- 1
            alpha[2, 3] <- s - 1
            for (i in 3:k) {
                alpha[i, 2] <- alpha[i - 1, 2] + 1
                alpha[i, 3] <- alpha[i - 1, 3] - 1
            }
            serie <- "II"
        }
        if (r == 3 & s%%2 == 0 & k < s ) {
            s1 <- s/2
            alpha <- matrix(0, nrow = k, ncol = r)
            alpha[2, 2] <- 1
            alpha[2, 3] <- s1
            for (i in 3:k) {
                alpha[i, 2] <- alpha[i - 1, 2] + 1
                alpha[i, 3] <- alpha[i - 2, 3] + 1
            }
            serie <- "III"
        }
         if (r == 4 & s%%2 != 0 & s%%3 != 0 & k<=s) {
            s2 <- (s + 1)/2
            alpha <- matrix(0, nrow = k, ncol = r)
            alpha[2, 2] <- 1
            alpha[2, 3] <- s - 1
            alpha[2, 4] <- s2
            for (i in 3:k) {
                alpha[i, 2] <- alpha[i - 1, 2] + 1
                alpha[i, 3] <- alpha[i - 1, 3] - 1
                alpha[i, 4] <- alpha[i - 2, 4] + 1
            }
            serie <- "IV"
        }
        if (serie == "") {
            cat("\nhelp(design.alpha): to see the series of alpha generators\n")
            stop
        }
        else {
            nf <- nrow(alpha)
            nc <- ncol(alpha)
            cc <- rep(alpha[, 1], s)
            for (i in 2:r) {
                cc <- c(cc, rep(alpha[, i], s))
            }
            dim(cc) <- c(nf, s, r)
            for (m in 1:r) cc[, 1, m] <- alpha[, m]
            for (i in 2:s) {
                for (j in 1:nf) {
                  for (m in 1:r) {
                    cc[j, i, m] <- cc[j, i - 1, m] + 1
                    if (cc[j, i, m] >= s)
                      cc[j, i, m] <- 0
                  }
                }
            }
            for (j in 1:nf) {
                cc[j, , ] <- cc[j, , ] + (j - 1) * s
            }
            intermediate <-cc
            cat("\nAlpha Design (0,1) - Serie ", serie, "\n")
            E <- (ntr - 1) * (r - 1)/((ntr - 1) * (r - 1) + r *
                (s - 1))
            cat("\nParameters Alpha Design\n=======================")
            cat("\nTreatmeans :", ntr)
            cat("\nBlock size :", k)
            cat("\nBlocks     :", s)
            cat("\nReplication:", r, "\n")
            cat("\nEfficiency factor\n(E )", E, "\n\n<<< Book >>>\n")
      parameters<-list(design="alpha",trt=trt,k=k,r=r,serie=serie,seed=seed,kinds=kinds)
      statistics<-data.frame(treatments= ntr,blocks=s,Efficiency=E)
			rownames(statistics)<-"values"
            for (m in 1:r) {
                for (j in 1:s) {
                aleatorio <- 1:k
                if(randomization) aleatorio <- sample(1:k, k)
                  cc[, j, m] <- cc[aleatorio, j, m]  # randomize block in rep
                }
            }
            for (m in 1:r) {
                aleatorio <- 1:s
                if(randomization)aleatorio <- sample(1:s, s)
                cc[, , m] <- cc[, aleatorio, m]  # randomize col in rep
            }
            cc<-cc+1
            block <- gl(s, k)
            md <- as.numeric(cc[, , 1])
            bp <- 1:ntr
            if(randomization) bp <- sample(1:ntr, ntr)    # 
            trt <- trt[bp]              # randomize treatments
            mtr <- trt[md]              # assign to plot
            book <- data.frame(block = as.factor(block), trt = as.factor(mtr),
                replication = 1)
            for (i in 2:r) {
                md <- as.numeric(cc[, , i])
                mtr <- trt[md]
                book1 <- data.frame(block = as.factor(block),
                  trt = as.factor(mtr), replication = i)
                book <- rbind(book, book1)
            }
            Rep<-book$replication
            plots <- Rep*number+(1:ntr)
            cols <- as.numeric(rep(gl(k, 1), s * r))
            book <- data.frame(plots = plots, cols = cols, book)
            book <- data.frame(row.names = NULL, book)
            book$block <- gl(s * r, k)
            book[,2]<-as.factor(book[,2])
            book[,5]<-as.factor(book[,5])
            names(book)[4] <- name.trt
            tr<-as.character(book[,4])
            dim(tr)<-c(k,s,r)
            if ( r == 2) design<-list(rep1=t(tr[,,1]),rep2=t(tr[,,2]))
            if ( r == 3) design<-list(rep1=t(tr[,,1]),rep2=t(tr[,,2]),rep3=t(tr[,,3]))
            if ( r == 4) design<-list(rep1=t(tr[,,1]),rep2=t(tr[,,2]),rep3=t(tr[,,3]),rep4=t(tr[,,4]))
            outdesign<-list(parameters=parameters, statistics=statistics, sketch=design,book=book)
            return(outdesign)
        }
    }
}