Nothing
##' Calculate the Treatment Replication number
##'
##' Calculate the replication number of every treatment term including the
##' interaction. This is used to compute the treatment efficiency factors.
##'
##'
##' @param design.df a data frame containing the experimental design. Requires
##' every column be a \code{\link{factor}}.
##' @param trtTerm a vector of character containing the labels of the treatment
##' terms in the model generated by the \code{\link{terms}}.
##' @return A list containing two objects. The first object is a matrix called
##' \code{Rep} which contains the replication numbers, where the rows
##' correspond to each treatment combination and the columns correspond to the
##' treatment factors, i.e. the replication number with respect to each
##' treatment factor based on the treatment combination. The second object
##' called \code{Sca} which is a numeric vector for computing a coefficients of
##' the fixed effect parameter in EMS.
##' @author Kevin Chang
##' @references John J, Williams E (1987). \emph{Cyclic and computer generated
##' Designs}. Second edition. Chapman & Hall.
##' @examples
##'
##' design1 <- local({
##' Ani = as.factor(LETTERS[c(1,2,3,4,
##' 5,6,7,8)])
##' Trt = as.factor(letters[c(1,1,1,1,
##' 2,2,2,2)])
##' data.frame(Ani, Trt, stringsAsFactors = TRUE )
##' })
##'
##' trt.str = "Trt"
##'
##' fT = terms(as.formula(paste("~", trt.str, sep = "")), keep.order = TRUE) #fixed terms
##'
##' trtTerm = attr(fT,"term.labels")
##' effectsMatrix = attr(fT,"factor")
##'
##' getTrtRep(design1, trtTerm)
##'
##'
##' @export getTrtRep
getTrtRep <- function(design.df, trtTerm) {
if (length(trtTerm) == 1 && !any(grepl("[[:punct:]]", trtTerm))) {
return(list(Rep = as.matrix(table(design.df[, trtTerm])), Sca = 1))
} else if (any(grepl("[[:punct:]]", trtTerm))) {
level <- t(sapply(strsplit(sort(levels(interaction(design.df[, unique(unlist(strsplit(trtTerm,
"[[:punct:]]+")))]))), "\\."), rbind))
#level <- t(sapply(strsplit( sort(unique(apply(design.df[, unique(unlist(strsplit(trtTerm, #"[[:punct:]]")))],1, function(x) paste(x, collapse = ".")))), "\\."), rbind))
colnames(level) <- unique(unlist(strsplit(trtTerm, "[[:punct:]]+")))
inter <- trtTerm[grepl("[[:punct:]]", trtTerm)]
for (i in 1:length(inter)) {
level <- cbind(level, apply(level[, unique(unlist(strsplit(inter[i], "[[:punct:]]+")))],
1, function(x) paste(x, collapse = ".")))
colnames(level)[ncol(level)] <- inter[i]
}
trtTermList <- lapply(strsplit(trtTerm, "[[:punct:]]+"), function(x) design.df[,
x])
names(trtTermList) <- trtTerm
repList <- lapply(trtTermList, function(y) if (is.factor(y)) {
table(y)
} else {
table(apply(y, 1, function(x) paste(x, collapse = ".")))
})
repMat <- level
for (i in 1:length(repList)) {
level.temp <- level[, names(repList)[i]]
repMat <- cbind(repMat, repList[[i]][level.temp])
}
repMat <- repMat[, -(1:ncol(level))]
if (is.matrix(repMat)) {
repMat <- apply(repMat, 2, function(x) ifelse(is.na(x), 0, as.numeric(x)))
colnames(repMat) <- names(repList)
rownames(repMat) <- NULL
levelList <- sapply(trtTermList, function(y) if (is.factor(y)) {
nlevels(y)
} else {
nlevels(as.factor(apply(y, 1, function(x) paste(x, collapse = "."))))
})/apply(repMat, 2, function(x) sum(x != 0))
repList <- repMat %*% diag(levelList)
} else {
repMat <- ifelse(is.na(repMat), 0, as.numeric(repMat))
levelList <- sapply(trtTermList, function(y) if (is.factor(y)) {
nlevels(y)
} else {
nlevels(as.factor(apply(y, 1, function(x) paste(x, collapse = "."))))
})/sum(repMat != 0)
repList <- as.matrix(repMat * levelList)
}
return(list(Rep = repList, Sca = levelList))
} else {
level <- t(sapply(strsplit(sort(levels(interaction(design.df[, trtTerm]))),
"\\."), rbind))
#level <- t(sapply(strsplit( sort(unique(apply(design.df[, trtTerm],1,
# function(x) paste(x, collapse = ".")))), "\\."), rbind))
colnames(level) <- trtTerm
repList <- lapply(design.df[, trtTerm], table)
repMat <- level
for (i in 1:length(repList)) {
level.temp <- level[, names(repList)[i]]
repMat <- cbind(repMat, repList[[i]][level.temp])
}
repMat <- repMat[, -(1:ncol(level))]
repMat <- apply(repMat, 2, function(x) ifelse(is.na(x), 0, as.numeric(x)))
colnames(repMat) <- names(repList)
rownames(repMat) <- NULL
levelList <- apply(design.df[, trtTerm], 2, function(x) nlevels(as.factor(x)))/apply(repMat,
2, function(x) sum(x != 0))
repList <- repMat %*% diag(levelList)
return(list(Rep = repList, Sca = levelList))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.