Лучший способ проверить, имеет ли векторная перестановка каждый элемент в новой позиции

Question

Я хочу проверить, является ли перестановка векторов уникальной.Например, у меня есть вектор c (1, 2, 3, 4).Скажем, я делаю sample(c(1, 2, 3, 4)), и результат равен 4 3 2 1. Эта перестановка уникальна, поскольку каждый элемент находится в новой позиции.Теперь я могу сделать это для векторов такого типа, используя операторы which(), но это не работает для вектора c(1, 1, 1, 1, ..., 1), потому что он всегда говорит, что ничего не изменилось после его смешивания.Какой лучший способ сделать это?

Я пытался использовать операторы match() и which():

if (length(which(n == sample(n))) == 0) { 'unique' }

Answer 1

Для меня наиболее интуитивным способом было бы зациклить ваши выбранные векторы и использовать функцию all, чтобы проверить, все ли элементы в выбранном векторе равны элементам вашего исходного вектора.Вы всегда можете перевернуть его, используя !, чтобы получить неравные векторы.Примерно так:

set.seed(12345)
original <- 1:4
samples <- replicate(n=20, expr = { sample(original) })

#> samples
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20]
#[1,]    3    2    3    3    2    2    3    1    1     4     4     2     1     2     3     4     4     3     2     4
#[2,]    4    1    4    1    4    1    2    2    3     3     2     1     2     1     1     1     1     4     4     2
#[3,]    2    3    1    4    1    4    4    3    4     2     3     3     3     4     4     2     2     2     1     3
#[4,]    1    4    2    2    3    3    1    4    2     1     1     4     4     3     2     3     3     1     3     1

## I presume you want to find indices where vectors such as 8th and 13th occur (or the inverse)

indices <- apply(samples, MARGIN=2, FUN=function(z) { all(z==original) })

#> which(indices)
#[1]  8 13
#> samples[,which(indices)]
#     [,1] [,2]
#[1,]    1    1
#[2,]    2    2
#[3,]    3    3
#[4,]    4    4

## Conversely, if you only want vectors that are different from the original one, use:
# which(!indices)

Я не уверен, что это наиболее эффективный в вычислительном отношении способ сделать это, но он по крайней мере довольно прост и использует только базовую R.

РЕДАКТИРОВАТЬ: Обратите вниманиечто это не сможет отличить позиции от исходного вектора, так как all(x==y) сравнивает точное содержание попарно только между векторами x и y.Он прекрасно работает, если все ваши исходные элементы уникальны, но не сможет различить дубликаты и их соответствующие позиции.

EDIT2: Альтернативно, если исходные позиции имеют значение в отношении дубликатов, вы можетевыборочные индексы элементов вместо содержимого элементов.Это, вероятно, также более эффективно использует память, в зависимости от типа вашего фактического элемента:

set.seed(12345)
original <- c("foo", "foo", "bar", "bar")
samples <- replicate(n=20, expr = { sample(1:length(original)) })
indices <- apply(samples, MARGIN=2, FUN=function(z) { all(z==1:length(original)) })

# To obtain the unique sampled vectors where original positions matter
#> do.call("cbind", lapply(which(!indices), FUN=function(z) { original[samples[,z]] }))
#     [,1]  [,2]  [,3]  [,4]  [,5]  [,6]  [,7]  [,8]  [,9]  [,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17] [,18]
#[1,] "bar" "foo" "bar" "bar" "foo" "foo" "bar" "foo" "bar" "bar" "foo" "foo" "bar" "bar" "bar" "bar" "foo" "bar"
#[2,] "bar" "foo" "bar" "foo" "bar" "foo" "foo" "bar" "bar" "foo" "foo" "foo" "foo" "foo" "foo" "bar" "bar" "foo"
#[3,] "foo" "bar" "foo" "bar" "foo" "bar" "bar" "bar" "foo" "bar" "bar" "bar" "bar" "foo" "foo" "foo" "foo" "bar"
#[4,] "foo" "bar" "foo" "foo" "bar" "bar" "foo" "foo" "foo" "foo" "bar" "bar" "foo" "bar" "bar" "foo" "bar" "foo"
## Notice that columns 2, 6, 11, and 12 are included because duplicates have changed places.

# To obtain the sampled vectors that were identical also in respect to position indices
#> do.call("cbind", lapply(which(indices), FUN=function(z) { original[samples[,z]] }))
#     [,1]  [,2] 
#[1,] "foo" "foo"
#[2,] "foo" "foo"
#[3,] "bar" "bar"
#[4,] "bar" "bar"

Answer 2

Если вы хотите, чтобы это работало также для векторов, которые имеют повторяющиеся элементы (например, c(1,1,1,1)), вам нужно отслеживать индекс наблюдения, когда вы берете выборку.Например, вы можете сделать это с помощью простой функции, приведенной ниже, которая производит выборку по позиции и сравнивает позиции:

a <- c(1,1,1,2,2,2,3)
unique_sample <- function(x) {
  samp <- sample(length(x))
  ident <- !any(samp == (1:length(x)))
  list(unique = ident, draw = x[samp])
}
set.seed(42)
unique_sample(a)
#> $unique
#> [1] FALSE
#> 
#> $draw
#> [1] 3 2 1 2 2 1 1