Выборка из таблицы непредвиденных обстоятельств

Question

Я справился с приведенным ниже кодом при написании функции для выборки из таблицы сопряженности - пропорционально частотам в ячейках.

Используется expand.grid, а затем table, чтобы вернуться к таблице исходных размеров. Что прекрасно работает, если размер выборки достаточно велик, чтобы некоторые категории не пропали полностью. В противном случае команда table возвращает таблицу меньшего размера, чем исходная.

FunSample<- function(Full, n) {
  Frame <- expand.grid(lapply(dim(Full), seq))
  table(Frame[sample(1:nrow(Frame), n, prob = Full, replace = TRUE), ])
}
Full<-array(c(1,2,3,4), dim=c(2,2,2))
FunSample(Full, 100) # OK
FunSample(Full, 1) # not OK, I want it to still have dim=c(2,2,2)!

Мой мозг перестал работать, я знаю, что это должно быть небольшая настройка, чтобы вернуть его в нужное русло!?

Answer 1

Кросс-таблица также является многочленным распределением, поэтому вы можете использовать rmultinom и сбросить размерность на выходе. Это должно значительно повысить производительность и сократить объем кода, который необходимо поддерживать.

> X <- rmultinom(1, 500, Full)
> dim(X) <- dim(Full)
> X
, , 1

     [,1] [,2]
[1,]   18   92
[2,]   45   92

, , 2

     [,1] [,2]
[1,]   28   72
[2,]   49  104

> X2 <-rmultinom(1, 4, Full)
> dim(X2) <- dim(Full)
> X2
, , 1

     [,1] [,2]
[1,]    0    1
[2,]    0    0

, , 2

     [,1] [,2]
[1,]    0    1
[2,]    1    1

Answer 2

Если вы не хотите, чтобы table() «отбрасывал» пропущенные комбинации, вам нужно сделать так, чтобы столбцы Frame были факторами:

FunSample <- function(Full, n) {
  Frame <- as.data.frame( lapply( expand.grid(lapply(dim(Full), seq)), factor) )  
  table( Frame[sample(1:nrow(Frame), n, prob = Full, replace = TRUE), ])
}   

> dim( FunSample(Full, 1))
[1] 2 2 2
> dim( FunSample(Full, 100))
[1] 2 2 2

Answer 3

Вы можете использовать tabulate вместо table; он работает с целочисленными векторами, как у вас здесь. Вы также можете получить вывод в массив, используя array напрямую, как при создании исходных данных.

FunSample<- function(Full, n) {
  samp <- sample(1:length(Full), n, prob = Full, replace = TRUE)
  array(tabulate(samp), dim=dim(Full))
}