0

在实验设计中，我尝试设计一个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 是偶数吧？那么为什么问题以这种方式持续存在呢？

4

1 回答 1

0

我删除了开发人员应该限制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 Latin Square 设计：

b <- letters_construction(30)
design_graeco_custom(b, 1:30)
于 2021-06-11T04:31:56.647 回答