3个元素在6个位置的排列

Question

我希望在六个位置内排列（或组合）c("a","b","c")，条件是始终具有交替元素的序列，例如 abcbab.

排列很容易得到：

abc<-c("a","b","c")
permutations(n=3,r=6,v=abc,repeats.allowed=T)

我认为使用 gtools 不可能做到这一点，我一直在尝试为此设计一个功能 - 尽管我认为它可能已经存在。

Answer 1

可能有更清洁的方法，但这里是：

abc <- letters[1:3]

library(tidyverse)

res <- gtools::permutations(n = 3, r = 6, v = abc, repeats.allowed = TRUE) %>% 
  data.frame() %>% 
  unite(united, sep = "", remove = FALSE) %>%
  filter(!str_detect(united, "([a-c])\1"))

head(res)  

  united X1 X2 X3 X4 X5 X6
1 ababab  a  b  a  b  a  b
2 ababac  a  b  a  b  a  c
3 ababca  a  b  a  b  c  a
4 ababcb  a  b  a  b  c  b
5 abacab  a  b  a  c  a  b
6 abacac  a  b  a  c  a  c

如果您想要矢量，可以使用 res$united 或在上面的管道末尾添加 %>% pull(united) 作为附加步骤。

Answer 2

由于您正在寻找排列，因此 expand.grid 可以和 permutations 一样工作。但是因为你不想要相似的邻居，我们可以大大缩短它的维数。我认为这是随机的！

前期：

r <- replicate(6, seq_len(length(abc)-1), simplify=FALSE)
r[[1]] <- c(r[[1]], length(abc))
m <- t(apply(do.call(expand.grid, r), 1, cumsum) %% length(abc) + 1)
m[] <- abc[m]
dim(m)
# [1] 96  6
head(as.data.frame(cbind(m, apply(m, 1, paste, collapse = ""))))
#   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

演练：

既然你要它的所有循环排列，我们可以用gtools::permutations，也可以用expand.grid……我就用后者吧，不知道多不多更快，但它确实是我需要的捷径（稍后会详细介绍）
在处理这样的约束时，我喜欢扩展值向量的索引

然而，由于我们不希望邻居相同，我认为我们 cumsum 他们不是每行值都是直接索引；通过使用它，我们可以控制累积和重新达到相同值的能力......通过从可能值列表中删除 0 和 length(abc)，我们消除了 (a ) 永远不会保持不变，并且 (b) 实际上永远不会增加一个矢量长度（重复相同的值）；作为演练：

head(expand.grid(1:3, 1:2, 1:2, 1:2, 1:2, 1:2), n = 6)
#   Var1 Var2 Var3 Var4 Var5 Var6
# 1    1    1    1    1    1    1
# 2    2    1    1    1    1    1
# 3    3    1    1    1    1    1
# 4    1    2    1    1    1    1
# 5    2    2    1    1    1    1
# 6    3    2    1    1    1    1

由于第一个值可以是所有三个值，因此它是 1:3，但每个附加值都应与其相差 1 或 2。

head(t(apply(expand.grid(1:3, 1:2, 1:2, 1:2, 1:2, 1:2), 1, cumsum)), n = 6)
#      Var1 Var2 Var3 Var4 Var5 Var6
# [1,]    1    2    3    4    5    6
# [2,]    2    3    4    5    6    7
# [3,]    3    4    5    6    7    8
# [4,]    1    3    4    5    6    7
# [5,]    2    4    5    6    7    8
# [6,]    3    5    6    7    8    9

好吧，这似乎没什么用（因为它超出了向量的长度），所以我们可以调用模数运算符和移位（因为模数 returns 基于 0，我们想要基于 1):

head(t(apply(expand.grid(1:3, 1:2, 1:2, 1:2, 1:2, 1:2), 1, cumsum) %% 3 + 1), n = 6)
#      Var1 Var2 Var3 Var4 Var5 Var6
# [1,]    2    3    1    2    3    1
# [2,]    3    1    2    3    1    2
# [3,]    1    2    3    1    2    3
# [4,]    2    1    2    3    1    2
# [5,]    3    2    3    1    2    3
# [6,]    1    3    1    2    3    1

为了验证这是否有效，我们可以在每一行上执行 diff 并查找 0:

m <- t(apply(expand.grid(1:3, 1:2, 1:2, 1:2, 1:2, 1:2), 1, cumsum) %% 3 + 1)
any(apply(m, 1, diff) == 0)
# [1] FALSE

到自动这个到任意向量，我们寻求replicate的帮助来生成可能的向量列表：

r <- replicate(6, seq_len(length(abc)-1), simplify=FALSE)
r[[1]] <- c(r[[1]], length(abc))
str(r)
# List of 6
#  $ : int [1:3] 1 2 3
#  $ : int [1:2] 1 2
#  $ : int [1:2] 1 2
#  $ : int [1:2] 1 2
#  $ : int [1:2] 1 2
#  $ : int [1:2] 1 2

然后do.call展开它。

你有索引矩阵，

head(m)
#      Var1 Var2 Var3 Var4 Var5 Var6
# [1,]    2    3    1    2    3    1
# [2,]    3    1    2    3    1    2
# [3,]    1    2    3    1    2    3
# [4,]    2    1    2    3    1    2
# [5,]    3    2    3    1    2    3
# [6,]    1    3    1    2    3    1

然后用向量的值替换每个索引：

m[] <- abc[m]
head(m)
#      Var1 Var2 Var3 Var4 Var5 Var6
# [1,] "b"  "c"  "a"  "b"  "c"  "a" 
# [2,] "c"  "a"  "b"  "c"  "a"  "b" 
# [3,] "a"  "b"  "c"  "a"  "b"  "c" 
# [4,] "b"  "a"  "b"  "c"  "a"  "b" 
# [5,] "c"  "b"  "c"  "a"  "b"  "c" 
# [6,] "a"  "c"  "a"  "b"  "c"  "a"

然后我们 cbind 联合字符串（通过 apply 和 paste）

性能：

library(microbenchmark)
library(dplyr)
library(tidyr)
library(stringr)

microbenchmark(
  tidy1 = {
    gtools::permutations(n = 3, r = 6, v = abc, repeats.allowed = TRUE) %>% 
      data.frame() %>% 
      unite(united, sep = "", remove = FALSE) %>%
      filter(!str_detect(united, "([a-c])\1"))
  },
  tidy2 = {
      filter(unite(data.frame(gtools::permutations(n = 3, r = 6, v = abc, repeats.allowed = TRUE)),
                   united, sep = "", remove = FALSE),
             !str_detect(united, "([a-c])\1"))
  },
  base = {
    r <- replicate(6, seq_len(length(abc)-1), simplify=FALSE)
    r[[1]] <- c(r[[1]], length(abc))
    m <- t(apply(do.call(expand.grid, r), 1, cumsum) %% length(abc) + 1)
    m[] <- abc[m]
  },
  times=10000
)
# Unit: microseconds
#   expr      min        lq     mean   median       uq       max neval
#  tidy1 1875.400 2028.8510 2446.751 2165.651 2456.051 12790.901 10000
#  tidy2 1745.402 1875.5015 2284.700 2000.051 2278.101 50163.901 10000
#   base  796.701  871.4015 1020.993  919.801 1021.801  7373.901 10000

我尝试了 infix (non-%>%) tidy2 版本只是为了好玩，虽然我相信它理论上会更快，但我没有意识到它会比运行次。（50163 可能是 R 垃圾收集，而不是 "real"。）我们为 readability/maintainability 付出的代价。

3个元素在6个位置的排列

Permutations of 3 elements within 6 positions

arrays

r

combinatorics

permute