我希望c("a","b","c")
在条件下在六个位置内置换(或组合)以始终具有交替元素的序列,例如abcbab
.
排列很容易得到:
abc<-c("a","b","c")
permutations(n=3,r=6,v=abc,repeats.allowed=T)
我认为使用 gtools 是不可能做到这一点的,而且我一直在尝试为此设计一个函数——即使我认为它可能已经存在。
我希望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
;通过使用它,我们可以控制累积和重新达到相同值的能力......通过从可能值列表中删除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
好吧,这似乎没什么用(因为它超出了向量的长度),所以我们可以调用模运算符和移位(因为模返回从 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
每一行进行 a 并查找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
我尝试了中缀(非%>%
)tidy2 版本只是为了好玩,虽然我相信理论上它会更快,但我没有意识到它会减少超过 7% 的运行时间。(50163 可能是 R 垃圾收集器,而不是“真实的”。)我们为可读性/可维护性付出的代价。
可能有更清洁的方法,但在这里你去:
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)