Заполнение набора данных с помощью перестановки в r

Question

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

Мне нужно сделать длябольший набор, где столбцы (slots = 6) и последовательность от 1 до 200, а требуемая сумма равна 100. Согласно приведенному выше сценарию, это занимает слишком много времени.Пожалуйста, предложите какой-нибудь другой способ сделать это.

Заранее спасибо.

library(gtools)
library(dplyr)

df <- as.data.frame( permutations(5,4,seq(0,8,1))) %>% 
  mutate(sum = `V1`+`V2`+`V3`+`V4`) %>% 
  filter(sum == 6) %>% 
  select(-sum)

Answer 1

Используя RcppAlgos (я - автор), это тривиально.

RcppAlgos::permuteGeneral(seq(0, 8, 1), 4,
                          constraintFun = "sum",
                          comparisonFun = "==",
                          limitConstraints = 6)

Алгоритм ниже оптимизирован для быстрого удаления невозможных решений.Мы также рассматривали только проверку комбинаций, так как сложение / умножение коммутативно и порядок не имеет значения.Как только мы находим подходящую комбинацию, мы генерируем все перестановки этой конкретной комбинации.Также помогает то, что мы используем Rcpp для значительного повышения эффективности.

Для реальной задачи ОП с 200 числами и 6 столбцами выполнимость будет сильно зависеть от необходимой суммы.Если мы рассмотрим среднюю сумму (которая произойдет больше всего), нам может потребоваться рассмотреть альтернативные подходы, поскольку число возможных решений сдвига превышает 2^31 - 1.Это также займет значительное количество времени.Только с 5 столбцами и желаемой суммой в 500 я даже не могу произвести перестановки.Однако я могу создать комбинации:

res <- RcppAlgos::comboGeneral(1:200, 5,
                               constraintFun = "sum",
                               comparisonFun = "==",
                               limitConstraints = 500, 
                               upper = 1e8)  ## upper argument constrains the output to a maximum number of results
nrow(res)
[1] 7669861

И, учитывая, что повторов нет, мы можем рассчитать количество перестановок:

7669861 * factorial (5) =920 383 320

Вот ошибка, которую я получаю:

res <- RcppAlgos::permuteGeneral(1:200, 5,
                                constraintFun = "sum",
                                comparisonFun = "==",
                                limitConstraints = 500, 
                                upper = 921000000)
Show Traceback

Rerun with Debug
Error: vector memory exhausted (limit reached?) 

Если желаемая сумма относительно мала или велика по сравнению со средней суммой, вычисления возможны.Например, если желаемая сумма равна 100, мы можем быстро получить все перестановки:

system.time(res <- RcppAlgos::permuteGeneral(1:200, 6,
                                             constraintFun = "sum",
                                             comparisonFun = "==",
                                             limitConstraints = 100, 
                                             upper = 1e8))
 user  system elapsed 
2.213   0.525   2.753 

nrow(res)
[1] 47395440

Answer 2

Один из вариантов:

as.data.frame(permutations(5, 4, seq(0, 8, 1))) %>% 
  filter(reduce(., `+`) == 6)

С другой стороны, это также можно сделать за пределами dplyr или других пакетов, таких как:

df <- as.data.frame(permutations(5, 4, seq(0, 8, 1)))

df[reduce(df, `+`) == 6,]

Вы также можете попробовать data.table, например:

library(data.table)

dt <- setDT(as.data.frame(permutations(5, 4, seq(0, 8, 1))))

dt[Reduce(`+`, mget(names(dt))) == 6]

Или другой вариант - возможно, более медленный - также может быть (после сохранения в dt, как указано выше):

dt[dt[, rowSums(.SD) == 6]]