0

考虑到这篇文章Permutations of 3 elements within 6 position中的答案,我认为值得就如何对元素进行排序进行新的讨论。

第一个条件是总是有交替元素的序列:

#   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 ?

4

1 回答 1

2

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

使用上一个问题的开始:

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-function 中将其命名为r非常清楚(在函数内部),每次它获得一个 new 时r,它都会执行与上一个问题完全相同的步骤。
  • do.call(rbind.data.frame, c(stringsAsFactors=FALSE, ...因为每次返回lapply都会是一个data.frame,我们希望将它们组合成一个单独的帧。我不喜欢任何因素,但如果需要,您可以选择其他方式。(而不是rbind.data.frame,您可以使用data.table::rbindlistor dplyr::bind_rows,两者都没有stringsAsFactors。)

现在前 96 行没有重复,那么剩下的 5 批每批 48 行(总共 336 行)每批都有一个重复。我们“知道”48 是每个重复一次列表的正确数字,因为通过将位置之一从“ 1 2”可能更改为“ 0”(从 2 到 1 个可能值),我们将可能组合的总数减半(96 / 2 == 48)。

如果出于某种原因,您的下一个问题询问如何扩展它以允许两次重复......那么我不一定建议强制使用它的方面:有 6 或 10 种可能的组合(取决于是否"aaa"允许)重复,并且我更愿意进行更程序化的处理,而不是这种蛮力附加一个约束。

于 2018-12-02T17:35:16.813 回答