Как получить все комбинации значений по очереди в кадре данных

Question

У меня есть таблица непредвиденных обстоятельств (ct), например:

read.table( text=     
      1  2  3 4 5 6
1     0  0  1 0 2 0
2     0  0  2 0 0 0
70    0  0  3 0 0 0
76   15 13 19 2 9 8
85    0  0  2 0 0 0
109   0  0  0 0 1 2
479   0  0  0 0 2 0
491   2  0  0 0 0 0
1127  0  1  0 1 6 0
1131  0  1  1 1 2 0
1206  1  3  1 0 0 1
1208  1  0  1 0 0 1
1210  0  1  0 0 0 1
1225  2  0  1 0 0 0
1232  0  0  0 0 1 1
1242  0  0  0 1 0 1
1243  1  0  0 0 1 1
1251  0  0  2 0 1 2
1267  0  2  1 0 0 0
4415  0  2  0 0 0 0
4431  0  0  0 2 0 0
4808  0  0  0 0 2 0
4823  0  2  0 0 0 0 )

Где строки представляют кластер, столбцы представляют больницы, а цифры в таблице - количество изолятов.
Например: кластер 1 имеет3 изолята, 1 в больнице 3 и 2 в больнице 2.

Теперь я хочу проверить, зависят ли кластеры и больницы друг от друга или нет.Для этого я хотел бы создать 1000 случайно распределенных таблиц, в которых все изоляты в одном кластере могут попасть в каждую больницу.
Например: 3 изолята в кластере 1 могут быть распределены по 3 больницам, так чтоЯ получаю значения: 0 1 1 1 0 0.

Комбинации могут встречаться несколько раз.

Я пробовал это:

 replicates <- 1000

 permutations <- lapply(seq(replicates), function(i, ct){
   list <- lapply(apply(ct,1,list),unlist)
   list <- lapply(list, function(x)as.numeric(x))
    z <- as.data.frame(do.call(rbind, lapply(list, function(x) sample(x))))
 }, ct = ct)

Но при этом только значения в кадре данных перемещаются на другую позицию в строке.
Может ли кто-нибудь помочь мне с этим?

Answer 1

Вот альтернативный вариант использования partitions::composition.

library(partitions)

# smaller toy data
d <- data.frame(x1 = c(0, 1, 1), x2 = c(2, 2, 0), x3 = c(0, 1, 1))

# calculate row sums
rs <- rowSums(d)

# for each unique row sum, partition the value with order m = number of columns
# this avoids repeating calculation of partitions on duplicate row sums
l <- lapply(unique(rs), compositions, m = ncol(d))

# name list elements with row sums
names(l) <- unique(rs)

# set number of samples
n <- 4

# to reproduce sample in this example  
set.seed(1)

# loop over rows in data frame
lapply(1:nrow(d), function(i){

  # index list of partitions using row sums
  m <- l[[as.character(rs[i])]]

  # number of columns to sample from
  nc <- ncol(m)

  # select columns from matrix using a sample of n column indexes
  m[ , sample(nc, n, replace = TRUE)]
})

Результатом является список, в котором каждый элемент является матрицей для каждой строки исходных данных. Каждый столбец матрицы представляет собой один (выборочный) раздел.

# [[1]]
#      [,1] [,2] [,3] [,4]
# [1,]    1    0    1    0
# [2,]    1    2    0    0
# [3,]    0    0    1    2
# 
# [[2]]
#     [,1] [,2] [,3] [,4]
# [1,]    1    0    0    2
# [2,]    3    1    0    0
# [3,]    0    3    4    2
# 
# [[3]]
#      [,1] [,2] [,3] [,4]
# [1,]    1    2    1    1
# [2,]    0    0    1    1
# [3,]    1    0    0    0

---

Я попытался разбить наибольшую сумму строк в данных вашего примера (66), и она работает довольно быстро. Таким образом, если суммы строк не очень велики, а количество столбцов невелико (как здесь), приведенный выше код может быть приемлемым вариантом.

system.time(p <- compositions(66, 6))
#   user  system elapsed 
#   1.53    0.16    1.68 
str(p)
# 'partition' int [1:6, 1:13019909] 66 0 0 0 0 0 65 1 0 0 ...

Обратите внимание, что он быстро взрывается, если количество столбцов увеличивается:

system.time(p <- compositions(66, 7))
#    user  system elapsed 
#   14.11    1.61   15.72

Answer 2

Извините @Henrik за поздний ответ. Ваш код отлично сработал для меня! Однако, с помощью моего коллеги, я разобрался с этим кодом (я просто покажу его, используя ваши образцы данных):

#data
d <- data.frame(x1 = c(0, 1, 1), x2 = c(2, 2, 0), x3 = c(0, 1, 1))
#Number of replicates I want
replicates <- 1000
#Number of columns in the table 
k<- 3

l <- NULL

#unlist the dataframe
list <- lapply(apply(d,1,list),unlist)

#Calculate replicates of the dataframe, where numbers are permuted within rows

permutations <- lapply(seq(replicates), function(j){
        l_sampled <- lapply(list, function(x){
          pos.random <- sample(k, sum(x), replace = T) 
          x.random <- rep(0,k)                        
          for (i in 1:k){
            x.random[i] <- sum(pos.random==i)
          }
          l = rbind(l, data.frame(x.random)) 
        })
        df <- data.frame(matrix(unlist(l_sampled), nrow=length(l_sampled), byrow=T))
})

#Example for results:

> permutations[[8]]
  X1 X2 X3
1  2  0  0
2  1  2  1
3  1  0  1
> permutations[[10]]
  X1 X2 X3
1  0  1  1
2  2  0  2
3  0  2  0

Answer 3

Я согласен с ответом Maurits Evers: при полном ранге вы получаете биномиальную комбинацию на строки: n переменных означают 2 ^ n комбинацию ... если вы добавляете m-1 столбцов, это дает 2 ^ (n + m) возможностей.