У меня есть вектор:
seq1<-c('a','b','c','b','a','b','c','b','a','b','c')
Я хочу переставить элементы этого вектора для создания нескольких (в идеале до 5000) векторов с условием, что перестановленные векторы не могут иметь повторяющиеся элементы внутри вектора в последовательных элементах. например "abbca...." не допускается, так как "b-b" является повторением.
Я понимаю, что для этого небольшого примера, вероятно, не 5000 решений. Обычно я имею дело с гораздо большими векторами. Я также согласен рассмотреть выборку с заменой, хотя в настоящее время я работаю над решениями без замены.
Я ищу лучшие решения, чем мое текущее мышление.
Вариант 1. - грубая сила.
Здесь я просто повторяю выборку и проверяю, являются ли какие-либо последующие элементы дублирующими.
set.seed(18)
seq1b <- sample(seq1a)
seq1b
#[1] "b" "b" "a" "a" "c" "b" "b" "c" "a" "c" "b"
sum(seq1b[-length(seq1b)]==seq1b[-1]) #3
Это не решение, так как есть три повторяющихся последовательных элемента. Я также понимаю, что lag, вероятно, лучший способ проверить дублирующиеся элементы, но по какой-то причине он тонкий (я думаю, что он замаскирован другим загруженным мной пакетом).
set.seed(1000)
res<-NULL
for (i in 1:10000){res[[i]]<-sample(seq1a)}
res1 <- lapply(res, function(x) sum(x[-length(x)]==x[-1]))
sum(unlist(res1)==0) #228
Это дает 228 опций из 10000 итераций. Но посмотрим, сколько уникальных:
res2 <- res[which(unlist(res1)==0)]
unique(unlist(lapply(res2, paste0, collapse=""))) #134
Из 10000 попыток мы получаем только 134 уникальных из этого короткого примерного вектора.
Вот 3 из 134 примерных последовательностей:
# "bcbabcbabca" "cbabababcbc" "bcbcababacb"
На самом деле, если я попробую более 500 000 образцов, я могу получить только 212 уникальных последовательностей, которые соответствуют моим не повторяющимся критериям. Вероятно, это близко к верхнему пределу возможных.
Вариант 2. - итеративно
Вторая идея, которую я имел, должна быть более итеративной в отношении подхода.
seq1a
table(seq1a)
#a b c
#3 5 3
Мы могли бы выбрать одну из этих букв в качестве отправной точки. Затем выберите другой из остальных, проверьте, совпадает ли он с ранее выбранным, а если нет, добавьте его в конец. И так далее и т.д.
set.seed(10)
newseq <- sample(seq1a,1) #b
newseq #[1] "b"
remaining <-seq1a[!seq1a %in% newseq | duplicated(seq1a)]
table(remaining)
#a b c
#3 4 3
set.seed(10)
newone <- sample(remaining,1) #c
#check if newone is same as previous one.
newone==newseq[length(newseq)] #FALSE
newseq <- c(newseq, newone) #update newseq
newseq #[1] "b" "c"
remaining <-seq1a[!seq1a %in% newseq | duplicated(seq1a)] #update remaining
remaining
table(remaining)
#a b c
#3 4 2
Это может сработать, но я также вижу, что он сталкивается с множеством проблем - например. мы могли бы пойти:
# "a" "c" "a" "c" "a" "b" ...
а затем останется еще 3 b, которые не могут идти в конце, так как они будут дублировать.
Конечно, это было бы намного проще, если бы я разрешил выборку с заменой, но на данный момент я пытаюсь сделать это без замены.
