Как я могу распределить вектор чисел вектором процентов, округлить результат и всегда получать ту же сумму, с которой я начал в R?

Question

Сводка вопроса

Я хочу умножить вектор чисел (столбец Sum_By_Group) на вектор процентов (столбец Percent), чтобы распределить общее число для группы по каждому идентификатору, округлите результат и получите то же общее число, с которого я начал. Другими словами, я хочу, чтобы столбец Distribution_Post_Round был таким же, как столбец Sum_By_Group.

Ниже приведен пример проблемы, с которой я столкнулся. В группе A я умножаю Percent на Sum_By_Group и завершаю sh на 3 в ID 1, 3 в ID 2 и 1 в ID 5, в сумме получается 7. Столбец Sum_By_Group и столбец Distribution_Post_Round одинаковы для группы А, и это то, что я хочу. В группе B я умножаю Percent на Sum_By_Group и завершаю sh на 1 в ID 8 и 1 в ID 10, в сумме получается 2. Я хочу, чтобы в столбце Distribution_Post_Round было 3 для группы B.

Есть ли способ сделать это без использования циклов, разделения фреймов данных на части и последующего объединения фреймов данных вместе?

Пример

library(dplyr)
df = data.frame('Group' = c(rep('A', 7), rep('B', 5)),
                  'ID' = c(1:12),
                  'Percent' = c(0.413797750, 0.385366840, 0.014417571, 0.060095668, 0.076399650,
                                0.019672573, 0.030249949, 0.381214519, 0.084121796, 0.438327886,
                                0.010665749, 0.085670050),
                  'Sum_By_Group' = c(rep(7,7), rep(3, 5)))
df$Distribute_By_ID = round(df$Percent * df$Sum_By_Group, 0)
df_round = aggregate(Distribute_By_ID ~ Group, data = df, sum)
names(df_round)[names(df_round) == 'Distribute_By_ID'] = 'Distribution_Post_Round'
df = left_join(df, df_round, by = 'Group')
df
  Group ID    Percent Sum_By_Group Distribute_By_ID Distribution_Post_Round
      A  1 0.41379775            7                3                       7
      A  2 0.38536684            7                3                       7
      A  3 0.01441757            7                0                       7
      A  4 0.06009567            7                0                       7
      A  5 0.07639965            7                1                       7
      A  6 0.01967257            7                0                       7
      A  7 0.03024995            7                0                       7
      B  8 0.38121452            3                1                       2
      B  9 0.08412180            3                0                       2
      B 10 0.43832789            3                1                       2
      B 11 0.01066575            3                0                       2
      B 12 0.08567005            3                0                       2

Большое спасибо за вашу помощь . Пожалуйста, дайте мне знать, если необходимы дополнительные разъяснения.

Answer 1

df %>%
  mutate(dividend = floor(Percent*Sum_By_Group),
         remainder= Percent*Sum_By_Group-dividend) %>%
  group_by(Group) %>%
  arrange(desc(remainder),.by_group=TRUE) %>%
  mutate(delivered=sum(dividend),
         rownumber=1:n(),
         lastdelivery=if_else(rownumber<=Sum_By_Group-delivered,1,0),
         Final=dividend+lastdelivery) %>%
  ungroup()

# A tibble: 12 x 10
   Group    ID Percent Sum_By_Group dividend remainder delivered rownumber lastdelivery Final
   <fct> <int>   <dbl>        <dbl>    <dbl>     <dbl>     <dbl>     <int>        <dbl> <dbl>
 1 A         1  0.414             7        2    0.897          4         1            1     3
 2 A         2  0.385             7        2    0.698          4         2            1     3
 3 A         5  0.0764            7        0    0.535          4         3            1     1
 4 A         4  0.0601            7        0    0.421          4         4            0     0
 5 A         7  0.0302            7        0    0.212          4         5            0     0
 6 A         6  0.0197            7        0    0.138          4         6            0     0
 7 A         3  0.0144            7        0    0.101          4         7            0     0
 8 B        10  0.438             3        1    0.315          2         1            1     2
 9 B        12  0.0857            3        0    0.257          2         2            0     0
10 B         9  0.0841            3        0    0.252          2         3            0     0
11 B         8  0.381             3        1    0.144          2         4            0     1
12 B        11  0.0107            3        0    0.0320         2         5            0     0

Это мое решение, без каких-либо других зависимостей, основанных на квоте Hare: я распределил все целые «места», затем я распределил оставшиеся «места» в порядке остатков. Столбец «Окончательный» тогда в порядке.

Примечание: похоже, дает те же результаты, что и другое решение с пакетом

Answer 2

Ого, кто знал, что кто-то уже написал пакет, который включает функцию для решения этой проблемы ... спасибо этой команде https://cran.r-project.org/web/packages/sfsmisc/index.html

Поскольку вы похоже, готовы использовать dplyr, надеюсь, этот дополнительный пакет того стоит, потому что он, безусловно, делает решение элегантным. 1013 * (v0.3.0)

Answer 3

Формулируя это как задачу целочисленной оптимизации:

library(CVXR)
A <- as.data.frame.matrix(t(model.matrix(~0+Group, df)))
prop <- df$Percent * df$Sum_By_Group
x <- Variable(nrow(df), integer=TRUE)
sums <- df$Sum_By_Group[!duplicated(df$Group)]
p <- Problem(Minimize(sum_squares(x - prop)), list(A %*% x == sums))
result <- solve(p)

df$Distribute_By_ID <- as.integer(round(result$getValue(x)))

вывод:

   Group ID    Percent Sum_By_Group
1      A  1 0.41379775            7
2      A  2 0.38536684            7
3      A  3 0.01441757            7
4      A  4 0.06009567            7
5      A  5 0.07639965            7
6      A  6 0.01967257            7
7      A  7 0.03024995            7
8      B  8 0.38121452            3
9      B  9 0.08412180            3
10     B 10 0.43832789            3
11     B 11 0.01066575            3
12     B 12 0.08567005            3