r-在实验设计中,为什么Graeco拉丁方不能针对特定的治疗长度进行计算



在实验设计中,我试图设计一个Graeco Latin-Square,我认为它是Latin Square设计的扩展版本,包含了更多因素。。然而,我发现它的行为很奇怪,下面是一些使用处理1和2模拟的片段,长度为1-26

graeco_design_possibility <- function(test_until=20){
library(agricolae)
k_graeco <- seq(2,test_until,1)
bool_possibility <- c()
for(n in 2:test_until){
b <- design.graeco(LETTERS[1:n], 1:n)
if(is.null(b)){
bool_possibility <- c(bool_possibility, FALSE)
}else{
bool_possibility <- c(bool_possibility, TRUE)
}
}
simulation_graeco <- data.frame(number_k = k_graeco, success_run=bool_possibility)
return(simulation_graeco)
}

当我测试这个时,模拟结果如下:(注意:在k=26之后会发生更多奇怪的错误(

g <- graeco_design_possibility(26)
g
number_k success_run
1         2        TRUE
2         3        TRUE
3         4        TRUE
4         5        TRUE
5         6       FALSE
6         7        TRUE
7         8        TRUE
8         9        TRUE
9        10        TRUE
10       11        TRUE
11       12        TRUE
12       13        TRUE
13       14       FALSE
14       15        TRUE
15       16       FALSE
16       17        TRUE
17       18       FALSE
18       19        TRUE
19       20       FALSE
20       21        TRUE
21       22       FALSE
22       23        TRUE
23       24       FALSE
24       25        TRUE
25       26       FALSE

这就是为什么,我看了一下文档,它说这个函数只适用于奇数和偶数(4、8、10和12(的平方我不太理解这个解释,因为模拟的结果与解释有点矛盾:6,14,16是偶数对吗?那么,为什么问题会以这种方式持续存在呢?

我删除了开发者在design.graeco()函数中应该限制的限制,老实说,我不知道为什么在处理上应该限制特定的长度,这是Graeco Latin Square设计没有限制的最终结果

design_graeco_custom <- function(trt1, trt2, serie = 2, seed = 0, kinds = "Super-Duper", randomization = TRUE){
number <- 10
if (serie > 0) 
number <- 10^serie
r <- length(trt1)
if (seed == 0) {
genera <- runif(1)
seed <- .Random.seed[3]
}
set.seed(seed, kinds)
parameters <- list(design = "graeco", trt1 = trt1, 
trt2 = trt2, r = r, serie = serie, seed = seed, kinds = kinds, 
randomization)
col <- rep(gl(r, 1), r)
fila <- gl(r, r)
fila <- as.character(fila)
fila <- as.numeric(fila)
plots <- fila * number + (1:r)
C1 <- data.frame(plots, row = factor(fila), col)

C2 <- C1
a <- 1:(r * r)
dim(a) <- c(r, r)
for (i in 1:r) {
for (j in 1:r) {
k <- i + j - 1
if (k > r) 
k <- i + j - r - 1
a[i, j] <- k
}
}
m <- trt1
if (randomization) 
m <- sample(trt1, r)
C1 <- data.frame(C1, m[a])
m <- trt2
if (randomization) 
m <- sample(trt2, r)
C2 <- data.frame(C2, m[a])
ntr <- length(trt1)
C1 <- data.frame(C1, B = 0)
for (k in 1:r) {
x <- C1[k, 4]
i <- 1
for (j in 1:(r^2)) {
y <- C2[(k - 1) * r + i, 4]
if (C1[j, 4] == x) {
C1[j, 5] <- y
i <- i + 1
}
}
}

C1[, 4] <- as.factor(C1[, 4])
C1[, 5] <- as.factor(C1[, 5])
names(C1)[4] <- c(paste(deparse(substitute(trt1))))
names(C1)[5] <- c(paste(deparse(substitute(trt2))))
outdesign <- list(parameters = parameters, 
sketch = matrix(paste(C1[,4], C1[,5]), 
byrow = TRUE, ncol = r), book = C1)
return(outdesign)
}

我还发现,在26岁以上的治疗中,我决定使用额外的辅助功能来生成可能的字母:

letters_construction <- function(n=27, format_letter="upper"){
if(n > 26 && n <= 702){
letter_result <- NULL
letter_comb <- NULL
if(format_letter=="upper"){
letter_result <- LETTERS[1:26]
letter_comb <- expand.grid(LETTERS[1:26], LETTERS[1:26])
}else if(format_letter=="lower"){
letter_result <- letters[1:26]
letter_comb <- expand.grid(letters[1:26], letters[1:26])
}
letter_comb$comb <- paste0(letter_comb$Var2, letter_comb$Var1)
letter_finalcomb <- as.character(letter_comb$comb)
n_remainder <- n-26
letter_result <- c(letter_result, letter_finalcomb[1:n_remainder])
return(letter_result)
}
}

所以我可以像这样实现Big Graeco拉丁广场的设计:

b <- letters_construction(30)
design_graeco_custom(b, 1:30)

相关内容

  • 没有找到相关文章