R: команда sample () подчиняется ограничению

17

Я пытаюсь случайным образом пробовать 7 чисел от 0 до 7 (с заменой), но при условии ограничения, что выбранные числа складываются до 7. Так, например, вывод 0 1 1 2 3 0 0 в порядке, но выход 1 2 3 4 5 6 7 нет. Есть ли способ использовать команду sample с добавленными ограничениями?

Я намерен использовать функцию replicate () с помощью команды sample в качестве аргумента, чтобы вернуть список из N разных векторов из команды sample. То, как я в настоящее время использую команду образца (без каких-либо ограничений), мне нужно, чтобы N был очень большим, чтобы получить как можно больше возможных векторов, которые суммируются ровно до 7. Я считаю, что должен быть более простой способ сделать это!

Вот мой код для этой части:

x <- replicate(100000, sample(0:7, 7, replace=T))    

В идеале я хочу, чтобы 10 000 или 100 000 векторов в x суммировались до 7, но для этого понадобилось бы огромное значение N. Спасибо за любую помощь.     

задан Kirk Fogg 20.09.2014 в 19:00
источник
  • Именно это я и сделал. Я взял подмножество этой переменной x, но с N = 100000 подмножество все еще было очень маленьким. Подмножество даже довольно мало с N = 1000000, не говоря уже о том, что требуется некоторое время для запуска! –  Kirk Fogg 20.09.2014 в 19:09
  • Возможно, вам придется использовать комбинации, если вы хотите, чтобы единый образец из набора всех возможных комбинаций ... –  Spacedman 20.09.2014 в 19:15
  • partitions :: parts (7) дает вам все разделы (способы разбить целое число на сумму), который может быть компонентом ответа ... –  Ben Bolker 20.09.2014 в 19:31
  • Это, вероятно, будет болезненно медленным, но: while (sum (x <- sample (0: 7, 7, replace = T))! = 7) {}. –  jbaums 20.09.2014 в 19:35
  • разделы: композиции (7,7) будут напрямую получать вам все возможные 7-секционные разделы, чего вы хотите. (Попробуйте, например, разделы: композиции (3,3), чтобы увидеть макет возвращаемой матрицы). –  Josh O'Brien 20.09.2014 в 20:55
Показать остальные комментарии

5 ответов

18

Чтобы убедиться, что вы выборочно выполняете выборку, вы можете просто сгенерировать все перестановки и ограничить те, которые суммируются с 7:

library(gtools)
perms <- permutations(8, 7, 0:7, repeats.allowed=T)
perms7 <- perms[rowSums(perms) == 7,]

Из nrow(perms7) , мы видим, что существует только 1716 возможных подстановок, сумма которых равна 7. Теперь вы можете равномерно выбирать из перестановок:

set.seed(144)
my.perms <- perms7[sample(nrow(perms7), 100000, replace=T),]
head(my.perms)
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,]    0    0    0    2    5    0    0
# [2,]    1    3    0    1    2    0    0
# [3,]    1    4    1    1    0    0    0
# [4,]    1    0    0    3    0    3    0
# [5,]    0    2    0    0    0    5    0
# [6,]    1    1    2    0    0    2    1

Преимущество такого подхода состоит в том, что легко видеть, что мы выборочно выбираем случайным образом. Кроме того, это довольно быстро - создание perms7 заняло 0,3 секунды на моем компьютере и построило 1 миллион строк my.perms заняло 0,04 секунды. Если вам нужно нарисовать много векторов, это будет немного быстрее, чем рекурсивный подход, потому что вы просто используете индексирование матрицы в perms7 вместо генерации каждого вектора отдельно.

Вот распределение счетчиков чисел в выборке:

#      0      1      2      3      4      5      6      7 
# 323347 188162 102812  51344  22811   8629   2472    423 
    
ответ дан josliber 20.09.2014 в 19:32
источник
8

Начните со всех нулей, добавьте их в любой элемент, выполните 7 раз:

sumTo = function(){
    v = rep(0,7)
    for(i in 1:7){
        addTo=sample(7)[1]
        v[addTo]=v[addTo]+1
    }
    v
}

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

sumTo = function(){tabulate(sample(7, 7, replace = TRUE), 7)}


> sumTo()
[1] 2 1 0 0 4 0 0
> sumTo()
[1] 1 3 1 0 1 0 1
> sumTo()
[1] 1 1 0 2 1 0 2

Я не знаю, приведет ли это к единому образцу из всех возможных комбинаций ...

Распределение отдельных элементов более 100 000 повторений:

> X = replicate(100000,sumTo())
> table(X)
X
     0      1      2      3      4      5      6 
237709 277926 138810  38465   6427    627     36 

Не поражал 0,0,0,0,0,7 того времени!

    
ответ дан Spacedman 20.09.2014 в 19:22
источник
  • Я предполагаю, что вы можете написать этот табулат (образец (7, 7, replace = TRUE), 7). –  flodel 20.09.2014 в 19:29
  • Это выглядит алгоритмически эквивалентным и очень аккуратным. Я сосать. –  Spacedman 20.09.2014 в 19:36
5

Этот рекурсивный алгоритм выведет распределение с большей вероятностью для больших чисел, чем другие решения. Идея состоит в том, чтобы бросить случайное число y в 0:7 в любом из семи доступных слотов, затем повторить со случайным числом в 0:(7-y) и т. Д .:

sample.sum <- function(x = 0:7, n = 7L, s = 7L) {
   if (n == 1) return(s)
   x <- x[x <= s]
   y <- sample(x, 1)
   sample(c(y, Recall(x, n - 1L, s - y)))
}

set.seed(123L)
sample.sum()
# [1] 0 4 0 2 0 0 1

Рисунок 100 000 векторов занял 11 секунд на моей машине, и вот распределение, которое я получаю:

#      0      1      2      3      4      5      6      7 
# 441607  98359  50587  33364  25055  20257  16527  14244 
    
ответ дан flodel 20.09.2014 в 19:26
источник
  • репликация из 100 000 взяла 8 секунд моим методом, и я получил один c (0,0,7,0,0,0,0)! –  Spacedman 20.09.2014 в 19:30
  • Вероятность того, что ваш алгоритм получит 7, - это один из 7 ^ 6 или 117 649. Я думаю, что до ОП решать, какое распределение он хочет. –  flodel 20.09.2014 в 19:33
  • На самом деле существует 8 возможных значений (0-7), поэтому на самом деле существует 8 ^ 7 = 2,097,152 7-длинных перестановок с заменой. В моем ответе я обнаружил, что только 1716 из них суммируют до 7, поэтому я бы ожидал 58 случаев вектора c (0,0,7,0,0,0,0). Только получение одного из них, вероятно, является доказательством отсутствия выборочного контроля. –  josliber♦ 20.09.2014 в 19:40
  • ... или просто, что мы отбираем выборку в разных пространствах. В конце концов, мы все используем образец, а не в том же типе эксперимента. Я бы не назвал тебя более единообразным, чем наше. –  flodel 20.09.2014 в 19:46
5

Может быть более простой и / или более элегантный способ, но вот метод грубой силы, используя LSPM:::.nPri . Ссылка включает определение для версии алгоритма только для R. Для тех, кого это интересует.

#install.packages("LSPM", repos="http://r-forge.r-project.org")
library(LSPM)
# generate all possible permutations, since there are only ~2.1e6 of them
# (this takes < 40s on my 2.2Ghz laptop)
x <- lapply(seq_len(8^7), nPri, n=8, r=7, replace=TRUE)
# set each permutation that doesn't sum to 7 to NULL
y <- lapply(x, function(p) if(sum(p-1) != 7) NULL else p-1)
# subset all non-NULL permutations
z <- y[which(!sapply(y, is.null))]

Теперь вы можете выбрать из z и быть уверены, что получаете перестановку, суммируемую до 7.

    
ответ дан Joshua Ulrich 20.09.2014 в 20:05
источник
  • Я вижу, что жозильбер предложил то же самое. Я оставлю этот ответ и другой вариант. –  Joshua Ulrich 20.09.2014 в 20:07
3

Я задаю этот вопрос интригующим и дал ему дополнительную мысль. Другой (более общий) подход к (приблизительной) выборке равномерно из всех возможных решений без генерации и сохранения всех перестановок (что явно не представляется возможным в случае с гораздо более чем 7 числами), в R на sample() , может быть простая реализация MCMC:

S <- c(0, 1, 1, 2, 3, 0, 0) #initial solution
N <- 100 #number of dependent samples (or burn in period)
series <- numeric(N)
for(i in 1:N){
    b <- sample(1:length(S), 2, replace=FALSE) #pick 2 elements at random
    opt <- sum(S[-b]) #sum of complementary elements
    a <- sample(0:(7-opt), 1) #sample a substistute
    S[b[1]] <- a #change elements
    S[b[2]] <- 7 - opt - a 
}
S #new sample 

Это, конечно, очень быстро для нескольких образцов. «Распределение»:

#"distribution" N=100.000:      0      1      2      3      4      5      6      7
#                            321729 189647 103206  52129  22287   8038   2532    432

Конечно, в этом случае, когда на самом деле можно найти и сохранить все комбинации, и если вы хотите получить огромную выборку из всех возможных результатов, просто используйте partitions::compositions(7, 7) , также предложенную Джошем О'Брайеном в комментариях, чтобы избежать вычисления всех перестановок, когда требуется лишь малая доля:

perms7 <- partitions::compositions(7, 7)

>tabulate(perms7[, sample(ncol(perms7), 100000, TRUE)]+1, 8)
#"distribution" N=100.000:      0      1      2      3      4      5      6      7
#                            323075 188787 102328  51511  22754   8697   2413    435
    
ответ дан J.R. 21.09.2014 в 13:29
источник