Как сгенерировать все возможные векторы на основе выборки без замены в R?

Question

У меня есть пул из семи номеров.Я хотел бы сгенерировать все векторы длины 7 с помощью:

• два первых элемента взяты из пула из 7 чисел.
• два следующих элемента взяты из 5 оставшихся чисел.
• три последних элемента взяты из трех оставшихся чисел.

Этот способ можно описать вектором c (2,2,3).

For example:
sample <- c(8.93,9.11,9.12,9.05,8.87,8.95,9.02)
structure <- c(2,2,3)

Я знаю, что есть 7C2 * 5C2 * 3C3 = 210 таких векторов.Чтобы быть более понятным, мне не нужно перестановку внутри каждой группы элементов, например, два вектора c(8.93,9.11,9.12,9.05,8.87,8.95,9.02) и c(9.11,8.93,9.12,9.05,8.87,8.95,9.02) одинаковы для меня, мне нужно только один из них появиться в списке из 210 векторов.

Вот что я сделал, используя for loop, combn и setdiff.Однако я хотел бы использовать вектор structure в коде, а также сделать его более гибким, например, c(2,5) вместо c(2,2,3).Есть ли более простое решение для обобщения моей проблемы, например, с помощью семейства функций apply?

df<-data.frame()
sample <- c(8.93,9.11,9.12,9.05,8.87,8.95,9.02)
combn(sample,2) -> com1
for (i in 1:ncol(com1)){
    com1[,i]
    setdiff(sample,com1[,i]) -> com2
    combn(com2,2) -> com3
    for (j in 1:ncol(com3)){
    setdiff(com2,com3[,j]) -> com4
    c(com1[,i],com3[,j],com4) -> de
    df <- rbind(df,de)
    }
}
df

Answer 1

Рекурсивная версия в базе R:

x <- c(8.93,9.11,9.12,9.05,8.87,8.95,9.02)
k <- c(2, 2, 3)

f <- function(el, l) {
    if (length(l)==1L) {
        return(data.frame(t(el)))
    }

    do.call(rbind, combn(el, l[1L], 
        #using code directly from setdiff for slight speedup and 
        #comparing integers for robustness
        function(s) cbind(data.frame(t(s)), f(el[match(el, s, 0L) == 0L], l[-1L])),
        simplify=FALSE))
}

apply(f(seq_along(x), k), 1L:2L, function(i) x[i])

Answer 2

find_combns_in_remainders <- function(list_combns_and_remainders, m) {
  unlist(lapply(
    list_combns_and_remainders,
    function(.) combn(x = .$remainder,
                      m = m,
                      FUN = function(combination) 
                        list(combination = c(.$combination, combination),
                             remainder = setdiff(.$remainder, combination)),
                      simplify = FALSE)
  ), recursive = FALSE)
}

Reduce(
  x = structure, 
  f = find_combns_in_remainders, 
  init = list(list(combination = numeric(0), remainder = sample))
)

# [[1]]
# [[1]]$combination
# [1] 8.93 9.11 9.12 9.05 8.87 8.95 9.02
# 
# [[1]]$remainder
# numeric(0)
# 
# 
# [[2]]
# [[2]]$combination
# [1] 8.93 9.11 9.12 8.87 9.05 8.95 9.02
# 
# [[2]]$remainder
# numeric(0)
# 
# 
# [[3]]
# [[3]]$combination
# [1] 8.93 9.11 9.12 8.95 9.05 8.87 9.02
# 
# [[3]]$remainder
# numeric(0)
# 
# 
# ....
# 
# 
# [[208]]
# [[208]]$combination
# [1] 8.95 9.02 9.12 9.05 8.93 9.11 8.87
# 
# [[208]]$remainder
# numeric(0)
# 
# 
# [[209]]
# [[209]]$combination
# [1] 8.95 9.02 9.12 8.87 8.93 9.11 9.05
# 
# [[209]]$remainder
# numeric(0)
# 
# 
# [[210]]
# [[210]]$combination
# [1] 8.95 9.02 9.05 8.87 8.93 9.11 9.12
# 
# [[210]]$remainder
# numeric(0)

Answer 3

Поскольку вы упомянули combn и setdiff, существует возможность:

1. Сначала мы создаем вспомогательную функцию draw, которая извлекает ndraw выборок из x и сохраняет результаты в lst.

   draw <- function(x, ndraw, lst) {
       unlist(lapply(lst, function(y) {
           lapply(
               combn(setdiff(x, y), ndraw, simplify = F),
               function(z) c(y, z))
       }), recursive = F)
   }
   

2. Затем мы можем определить функцию от generate_samples до draw столько сэмплов из x, сколько записей в draws. Я добавил проверку, чтобы убедиться, что сумма draws равна количеству элементов в x.

   generate_samples <- function(x, draws) {
       stopifnot(sum(draws) == length(x))
       res <- list(NULL)
       for (i in seq_along(draws)) res <- draw(x, draws[i], res)
       res
   }
   

3. В вашем конкретном случае мы бы сделали

   lst <- generate_samples(sample, draws = structure)
   #[[1]]
   #[1] 8.93 9.11 9.12 9.05 8.87 8.95 9.02
   #
   #[[2]]
   #[1] 8.93 9.11 9.12 8.87 9.05 8.95 9.02
   #
   #[[3]]
   #[1] 8.93 9.11 9.12 8.95 9.05 8.87 9.02
   #
   #[[4]]
   #[1] 8.93 9.11 9.12 9.02 9.05 8.87 8.95
   #
   #[[5]]
   #[1] 8.93 9.11 9.05 8.87 9.12 8.95 9.02
   #
   #[[6]]
   #[1] 8.93 9.11 9.05 8.95 9.12 8.87 9.02
   # ....
   

4. Мы подтверждаем, что это действительно производит 210 элементов на выходе list

   length(lst)
   #[1] 210
   

Answer 4

Это то, что вам нужно? Выглядело как противоречие в вопросе «Я хотел бы сгенерировать все векторы длины 7», но потом сказал, что вам нужен только один из 2-х примеров. Используя combn, не закончите ли вы одной случайной выборкой?

library(combinat)
x1 <- permn(sample[1:2])
x2 <- permn(sample[3:4])
x3 <- permn(sample[5:7])

all <- expand.grid(x1, x2, x3)
apply(all, 1, unlist)