在实验设计中,为什么无法针对特定长度的处理计算 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)
  }
}

所以我可以像这样实现大希腊拉丁广场设计:

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