我正在寻找在条件下始终具有交替元素(例如c("a","b","c"))的情况下在六个位置内置换(或组合)abcbab的方法。

排列很容易得到:

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


我认为无法使用gtools做到这一点,并且我一直在尝试为此设计一个功能-即使我认为它可能已经存在。

最佳答案

由于您正在寻找排列,因此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不是每行值都是直接索引,通过使用它,我们可以控制累积总和重新达到相同值的能力...通过从可能值列表中删除0length(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


好吧,这似乎没有什么用(因为它超出了向量的长度),所以我们可以调用模运算符和移位(因为模数返回从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统一的字符串(通过applypaste




性能:

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版本,尽管我确信从理论上讲它会更快,但我没有意识到它将运行时间节省7%以上。 (50163可能是R垃圾收集,不是“真实的”。)我们为可读性/可维护性付出的代价。

07-24 09:52
查看更多