r - 排列一个向量，使一个元素不能在同一个地方

Question

我想排列一个向量，使排列后的元素不能像原来一样位于同一位置。假设我有一个这样的元素列表:AABBCCADEF

一个有效的洗牌应该是:BBAADEFCCA

但这些将无效:BAACFEDCAB 或 BCABFEDCAB

我能找到的最接近的答案是:python shuffle such that position will never repeat .但这并不是我想要的，因为那个例子中没有重复的元素。

我想要一个快速算法，在重复的情况下概括该答案。

MWE:

library(microbenchmark)

set.seed(1)
x <- sample(letters, size=295, replace=T)

terrible_implementation <- function(x) {
  xnew <- sample(x)
  while(any(x == xnew)) {
    xnew <- sample(x)
  }
  return(xnew)
}

microbenchmark(terrible_implementation(x), times=10)


Unit: milliseconds
                       expr      min       lq    mean  median       uq      max neval
 terrible_implementation(x) 479.5338 2346.002 4738.49 2993.29 4858.254 17005.05    10

此外，我如何确定一个序列是否可以以这种方式排列？

编辑:为了完全清楚我想要什么，新向量应满足以下条件:

1) all(table(newx) == table(x))2) all(x != newx)

例如:

newx <- terrible_implementation(x)
all(table(newx) == table(x))
[1] TRUE
all(x != newx)
[1] TRUE

Answer 1

#DATA
set.seed(1)
x <- sample(letters, size=295, replace=T)

foo = function(S){
    if(max(table(S)) > length(S)/2){
        stop("NOT POSSIBLE")
    }
    U = unique(S)
    done_chrs = character(0)
    inds = integer(0)
    ans = character(0)
    while(!identical(sort(done_chrs), sort(U))){
        my_chrs = U[!U %in% done_chrs]
        next_chr = my_chrs[which.min(sapply(my_chrs, function(x) length(setdiff(which(!S %in% x), inds))))]
        x_inds = which(S %in% next_chr)
        candidates = setdiff(seq_along(S), union(x_inds, inds))
        if (length(candidates) == 1){
            new_inds = candidates
        }else{
            new_inds = sample(candidates, length(x_inds))
        }
        inds = c(inds, new_inds)
        ans[new_inds] = next_chr
        done_chrs = c(done_chrs, next_chr)
    }
    return(ans)
}

ans_foo = foo(x)

identical(sort(ans_foo), sort(x)) & !any(ans_foo == x)
#[1] TRUE

library(microbenchmark)
microbenchmark(foo(x))
#Unit: milliseconds
#   expr      min       lq     mean   median       uq      max neval
# foo(x) 19.49833 22.32517 25.65675 24.85059 27.96838 48.61194   100