在实验设计中,为什么无法针对特定长度的处理计算 Graeco 拉丁方?
In Experimental Design, Why is Graeco Latin Square cannot be Computed for specific length of Treatments?
在实验设计中,我尝试设计一个 Graeco Latin-Square
,我认为它是 Latin Square
设计的扩展版本,具有更多因素。但是,我发现它表现得很奇怪,这里是一些片段通过使用长度为 1-26
的处理 1 和 2 模拟
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拉丁方设计没有限制的最终结果
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)
在实验设计中,我尝试设计一个 Graeco Latin-Square
,我认为它是 Latin Square
设计的扩展版本,具有更多因素。但是,我发现它表现得很奇怪,这里是一些片段通过使用长度为 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拉丁方设计没有限制的最终结果
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)