Question

考虑到本文Permutations of 3 elements within 6 positions中的答案，我认为有必要就元素的顺序进行新的讨论。

第一个条件是必须始终具有包含备用元素的序列：

#   Var1 Var2 Var3 Var4 Var5 Var6     V7
# 1    b    c    a    b    c    a bcabca
# 2    c    a    b    c    a    b cabcab
# 3    a    b    c    a    b    c abcabc
# 4    b    a    b    c    a    b babcab
# 5    c    b    c    a    b    c cbcabc
# 6    a    c    a    b    c    a acabca

但是，即使邻域限制中一个元素的巧合，其余的排列也可能有价值。例如：

    #   Var1 Var2 Var3 Var4 Var5 Var6 Coincidence  
    # 1    b    b    a    b    c    a     -->[bb]
    # 2    c    c    b    c    a    b     -->[cc] 
    # 3    a    b    c    a    a    c     -->[aa] 
    # 4    b    a    c    c    a    b     -->[cc]

是否也可以使用expand.grid？

Answer 1

如果只是“一个”，那么我建议允许的最简单方法是强制。

使用上一个问题的开头：

r <- replicate(6, seq_len(length(abc)-1), simplify=FALSE)
r[[1]] <- c(r[[1]], length(abc))

我们现在复制此单个列表（传递到expand.grid），并将第二个元素至最后一个元素替换为0。回想一下，我们将这些数字与cumsum一起使用，以从上一个更改值，因此将1:2替换为0意味着我们要强制下一个元素相同。

rs <- lapply(seq_len(length(r)-1) + 1, function(i) { r[[i]] <- 0; r; })
#            ^^^^^^^^^^^^^^^^^^^^^^^^ or: seq_len(length(r))[-1]
str(rs[1:2])
# List of 2
#  $ :List of 6
#   ..$ : int [1:3] 1 2 3
#   ..$ : num 0             <--- the second letter will repeat
#   ..$ : int [1:2] 1 2
#   ..$ : int [1:2] 1 2
#   ..$ : int [1:2] 1 2
#   ..$ : int [1:2] 1 2
#  $ :List of 6
#   ..$ : int [1:3] 1 2 3
#   ..$ : int [1:2] 1 2
#   ..$ : num 0             <--- the third letter will repeat
#   ..$ : int [1:2] 1 2
#   ..$ : int [1:2] 1 2
#   ..$ : int [1:2] 1 2
### other rs's are similar

我们可以验证它是否可以按照我们认为的方式工作：

# rs[[1]] repeats the first 2
m <- t(apply(do.call(expand.grid, rs[[1]]), 1, cumsum) %% length(abc) + 1)
m[] <- abc[m]
head(as.data.frame(cbind(m, apply(m, 1, paste, collapse = ""))), n=3)
#   Var1 Var2 Var3 Var4 Var5 Var6     V7
# 1    b    b    c    a    b    c bbcabc
# 2    c    c    a    b    c    a ccabca
# 3    a    a    b    c    a    b aabcab

# rs[[3]] repeats the 3rd-4th
m <- t(apply(do.call(expand.grid, rs[[3]]), 1, cumsum) %% length(abc) + 1)
m[] <- abc[m]
head(as.data.frame(cbind(m, apply(m, 1, paste, collapse = ""))), n=3)
#   Var1 Var2 Var3 Var4 Var5 Var6     V7
# 1    b    c    a    a    b    c bcaabc
# 2    c    a    b    b    c    a cabbca
# 3    a    b    c    c    a    b abccab

从这里开始，通过将所有这些都放入一个列表并lapply对其进行自动化。

rs <- c(list(r), rs)
rets <- do.call(rbind.data.frame, c(stringsAsFactors=FALSE, lapply(rs, function(r) {
  m <- t(apply(do.call(expand.grid, r), 1, cumsum) %% length(abc) + 1)
  m[] <- abc[m]
  as.data.frame(cbind(m, apply(m, 1, paste, collapse = "")), stringsAsFactors=FALSE)
})))
head(rets)
#   Var1 Var2 Var3 Var4 Var5 Var6     V7
# 1    b    c    a    b    c    a bcabca
# 2    c    a    b    c    a    b cabcab
# 3    a    b    c    a    b    c abcabc
# 4    b    a    b    c    a    b babcab
# 5    c    b    c    a    b    c cbcabc
# 6    a    c    a    b    c    a acabca
tail(rets)
#     Var1 Var2 Var3 Var4 Var5 Var6     V7
# 331    b    c    b    a    c    c bcbacc
# 332    c    a    c    b    a    a cacbaa
# 333    a    b    a    c    b    b abacbb
# 334    b    a    c    b    a    a bacbaa
# 335    c    b    a    c    b    b cbacbb
# 336    a    c    b    a    c    c acbacc

其他步骤的演练：

rs <- c(list(r), rs)将第一个（不重复的r）制成一个封闭列表，然后将其添加到rs列表中。
lapply(rs, function(r) ...)对...列表中的每个元素一次执行上一个问题的rs。我在anon函数内部将其命名为r，以使其完全清楚（在函数内部），每次得到一个新的r时，它都会执行与上一个问题完全相同的步骤。
do.call(rbind.data.frame, c(stringsAsFactors=FALSE, ...，因为来自lapply的每个返回都将是一个data.frame，我们希望将它们组合成一个帧。我不喜欢任何因素，但可以根据需要选择其他方式。（您可以使用rbind.data.frame或data.table::rbindlist来代替dplyr::bind_rows，而不必使用stringsAsFactors。）

现在，前96行没有重复，然后其余五批每行48行（总共336行）每行都有一个重复。我们“知道”对于每个重复列表来说48是正确的数字，因为通过将位置之一从“ 1 2”更改为“ 0”（从2更改为1）），将可能的组合总数（96 / 2 == 48减半。

如果由于某种原因您的 next 问题询问如何扩展此范围以允许两个重复...那么我就不一定建议强行使用 this 方面：有6或10种可能的重复组合（取决于是否允许"aaa"），我更喜欢采用更具编程性的处理方式，而不是这种蛮力的附加一个约束。

6个位置中3个元素的排列：一个相等的邻居

1 个答案: