置换向量，使元素不能在同一位置 [英] Permute a vector such that an element can't be in the same place

问题描述

我想对向量进行置换，以使置换后的元素不能与原始元素位于同一位置.假设我有一个像这样的元素列表:AABBCCADEF

I want to permute a vector so that an element can't be in the same place after permutation, as it was in the original. Let's say I have a list of elements like this: AABBCCADEF

有效的洗牌是:BBAADEFCCA

A valid shuffle would be: BBAADEFCCA

但是这些将是无效的:B A ACFEDCAB或BCA B FEDCAB

But these would be invalid: BAACFEDCAB or BCABFEDCAB

我能找到的最接近答案是: python shuffle使得位置永远不会重复.但这并不是我想要的，因为在该示例中没有重复的元素.

The closest answer I could find was this: python shuffle such that position will never repeat. But that's not quite what I want, because there are no repeated elements in that example.

我想要一种快速算法，可以在重复的情况下概括该答案.

I want a fast algorithm that generalizes that answer in the case of repetitions.

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

此外，如何确定序列是否可以这种方式排列?

Also, how do I determine if a sequence can be permuted in such a way?

为使我的想法清晰明了，新向量应满足以下条件:

To make it perfectly clear what I want, the new vector should satisfy the following conditions:

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

推荐答案

我认为这可以满足您的所有条件.想法是按频率排序，从最常见的元素开始，然后按最常见的元素出现的次数将值移至频率表中的下一个值.这将确保所有元素都将丢失.

I think this satisfies all your conditions. The idea is to order by the frequency, start with the most common element and shift the value to the next value in the frequency table by the number of times the most common element appears. This will guarantee all elements will be missed.

我用 data.table 编写了代码，因为它在调试过程中对我有帮助，而不会损失太多性能.在性能方面，这是适度的改进.

I've written in data.table, as it helped me during debugging, without losing too much performance. It's a modest improvement performance-wise.

library(data.table)
library(magrittr)
library(microbenchmark)


permute_avoid_same_position <- function(y) {
  DT <- data.table(orig = y)
  DT[, orig_order := .I]

  count_by_letter <- 
    DT[, .N, keyby = orig] %>%
    .[order(N)] %>%
    .[, stable_order := .I] %>%
    .[order(-stable_order)] %>%
    .[]

  out <- copy(DT)[count_by_letter, .(orig, orig_order, N), on = "orig"]
  # Dummy element
  out[, new := first(y)]
  origs <- out[["orig"]]
  nrow_out <- nrow(out)
  maxN <- count_by_letter[["N"]][1]

  out[seq_len(nrow_out) > maxN, new := head(origs, nrow_out - maxN)]
  out[seq_len(nrow_out) <= maxN, new := tail(origs, maxN)]

  DT[out, j = .(orig_order, orig, new), on = "orig_order"] %>%
    .[order(orig_order)] %>%
    .[["new"]]
}

set.seed(1)
x <- sample(letters, size=295, replace=T)
testthat::expect_true(all(table(permute_avoid_same_position(x)) == table(x)))
testthat::expect_true(all(x != permute_avoid_same_position(x)))
microbenchmark(permute_avoid_same_position(x), times = 5)

# Unit: milliseconds
#                           expr      min       lq     mean   median       uq      max
# permute_avoid_same_position(x) 5.650378 5.771753 5.875116 5.788618 5.938604 6.226228

x <- sample(1:1000, replace = TRUE, size = 1e6)
testthat::expect_true(all(table(permute_avoid_same_position(x)) == table(x)))
testthat::expect_true(all(x != permute_avoid_same_position(x)))

microbenchmark(permute_avoid_same_position(x), times = 5)
# Unit: milliseconds
#                           expr      min       lq    mean   median       uq      max
# permute_avoid_same_position(x) 239.7744 385.4686 401.521 438.2999 440.9746 503.0875

这篇关于置换向量，使元素不能在同一位置的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！