R/design.aug.alpha.R

In myaseen208/agricolae: Statistical Procedures for Agricultural Research

#' Augmented alpha design type (0,1)
#'
#' Generates an augmented 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, all controls are randomly arranged
#' in each block and all the experimental units r*s*(k+nck) (r replications and
#' nck controls).
#'
#'
#' Parameters for the augmented 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 ck Controls
#' @param k size block without controls
#' @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 Yuhang Guo
#' @seealso \code{\link{design.ab}}, \code{\link{design.alpha}},
#' \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
#' ck <- 31:32
#' t <- length(trt)
#' # size block k
#' k<-3
#' # Blocks s
#' s<-t/k
#' # replications r
#' r <- 2
#' outdesign<- design.aug.alpha(trt,ck,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]
#' ck <- letters[13:14]
#' t <- length(trt)
#' k<-3
#' r<-3
#' s<-t/k
#' outdesign<- design.aug.alpha(trt,ck,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.aug.alpha <-
function (trt, ck, 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)
  nck <- length(ck)
  if (seed == 0) {
    genera<-runif(1)
    seed <- .Random.seed[3]
  }
  set.seed(seed, kinds)
  s <- ntr/k
  atr <- c(trt, rep(ck, s))
  natr <- length(atr)
  tk <- k + nck
  if (length(intersect(trt, ck)) != 0) {
    cat("\nThe controls are included in treatments","\nthe controls are modified with prefix with 'CK'")
    ck <- paste0("CK",ck)
    if (length(intersect(trt, ck)) != 0)
      cat("\nThe controls are included in treatments","\nrename your controls to avoid the error")
  }else 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 if (k + nck > s) {
    cat("\nThe size of the block or CK is not appropriate", "\nThe sum of k (size block) and nck (size control) can not be greater than s (k+nck <= s) \n")
  }
  else {
    serie <- ""
    if (r == 2 & tk <= s) {
      alpha <- matrix(0, nrow = tk, 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 & tk <= s) {
      alpha <- matrix(0, nrow = tk, 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 & tk < s) {
      s1 <- s/2
      alpha <- matrix(0, nrow = tk, 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 & tk <= s) {
      s2 <- (s + 1)/2
      alpha <- matrix(0, nrow = tk, 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
      }
      for (n in 1:nck){
        cc[k + n, , ] <- ntr + n - 1
      }
      intermediate <- cc
      cat("\nAlpha Design (0,1) - Serie ", serie, "\n")
      E <- (ntr - 1) * (r - 1)/((ntr - 1) * (r - 1) + r *
          (s - 1))
      cat("\nParameters Augmented Alpha Design\n=================================")
      cat("\nTreatmeans :", ntr)
      cat("\nControls :", ck)
      cat("\nBlock size :", k)
      cat("\nBlocks     :", s)
      cat("\nReplication:", r, "\n")
      cat("\nEfficiency factor\n(E )", E, "\n\n<<< Book >>>\n")
      parameters <- list(design = "augmented alpha", trt = trt, ck = ck,
                         k = k, r = r, serie = serie, seed = seed, kinds = kinds)
      statistics <- data.frame(treatments = ntr, controls = nck, blocks = s,
                               Efficiency = E)
      rownames(statistics) <- "values"
      for (m in 1:r) {
        for (j in 1:s) {
          aleatorio <- 1:tk
          if (randomization)
            aleatorio <- sample(1:tk, tk)
          cc[, j, m] <- cc[aleatorio, j, m]
        }
      }
      for (m in 1:r) {
        aleatorio <- 1:s
        if (randomization)
          aleatorio <- sample(1:s, s)
        cc[, , m] <- cc[, aleatorio, m]
      }
      cc <- cc + 1
      block <- gl(s, tk)
      md <- as.numeric(cc[, , 1])
      bp <- 1:natr
      if (randomization) {
        bp[1:ntr] <- sample(1:ntr, ntr)
        bp[(ntr + 1):natr] <- rep(sample((ntr + 1):(ntr + nck), nck), s)
      }
      atr <- atr[bp]
      mtr <- atr[md]
      book <- data.frame(block = as.factor(block), trt = as.factor(mtr),
                         replication = 1)
      for (i in 2:r) {
        md <- as.numeric(cc[, , i])
        mtr <- atr[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:natr)
      cols <- as.numeric(rep(gl(tk, 1), s * r))
      book <- data.frame(plots = plots, cols = cols, book)
      book <- data.frame(row.names = NULL, book)
      book$block <- gl(s * r, tk)
      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(tk, 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)
    }
  }
}