Перестановки 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

Поскольку вы ищете перестановки, 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) из списка возможных значений, мы исключаем возможность (а) никогда не оставаться вто же самое и (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
  

• to автоматизировать это для произвольного вектора, мы заручаемся помощью 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-сборщик мусора, а не «реальный».) Цена, которую мы платим за удобочитаемость / ремонтопригодность.

Answer 2

Вероятно, есть более чистые методы, но здесь вы идете:

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) в качестве дополнительного шага в конце каналоввыше.