Как логически вычесть строки

Question

Мой ДФ выглядит примерно так:

data <- data.frame(
  "id" = c(2, 4, 5), 
  "paid" = c(80, 293.64, 157),
  "basic_fee" = c(500, 140.59, 21.49),
  "marketing_fee" = c(151.51, 10.12, 562.50),
  "utility_fee" = c(65, 99.29, 102.35),
stringsAsFactors = F)

Чего бы я хотел достичь, так это

final <- data.frame(
    "id" = c(2, 4, 5), 
    "paid" = c(80, 293.64, 157),
    "basic_fee" = c(500, 140.59, 21.49),
    "marketing_fee" = c(151.51, 10.12, 562.50),
    "utility_fee" = c(65, 99.29, 102.35),
    "paid_basic" = c(80, 140.59, 21.49),
    "paid_marketing" = c(0, 10.12, 135.51),
    "paid_utlity" = c(0, 99.29, 0),
    stringsAsFactors = F)

На самом деле логика между ними довольно проста. Для каждого идентификатора получите сумму оплаченной стоимости, затем «платите как можно больше» на оплату услуг с приоритетом в порядке - основной, маркетинговый, коммунальный. Обратите внимание, что никакая комиссия не может выплачивать сумму, превышающую ее фактическую стоимость.

Мой код работает, но он очень уродлив для повторяющихся частей кода. Теперь у меня есть еще более сложный датафрейм со 100+ столбцами. Я не хочу создавать код с еще более и более сложным кодом, если в нем еще тысячи строк.

final <- 
  data %>% 
  mutate(
    paid_basic = if_else(basic_fee - paid > 0, basic_fee - (basic_fee - paid), basic_fee),
    overpayment_basic = if_else(paid-paid_basic > 0, 1, 0),

    paid_marketing = if_else(overpayment_basic == 1, (paid-paid_basic), 0),
    paid_marketing = if_else(paid_marketing > marketing_fee, marketing_fee, paid_marketing),
    overpayment_marketing = if_else(paid-paid_basic-paid_marketing > 0, 1, 0),

    paid_utility = if_else(overpayment_marketing == 1, (paid-paid_basic-paid_marketing), 0),
    paid_utility = if_else(paid_utility > utility_fee, utility_fee, paid_utility)
)

Answer 1

Мой первоначальный ответ не был обобщен на произвольное количество строк, поэтому вот еще одна попытка:

r <- data$paid # keep track of remaining money
select(data, ends_with("_fee")) %>%
    set_names(sub("(.*)_.*", "paid_\\1", names(.))) %>%
    mutate_all( ~ {`<-`(x, map2_dbl(., r, ~ pmin(.x, .y))); `<<-`(r, r-x); x}) %>%
    bind_cols(data, .)

Что возвращает:

  id   paid basic_fee marketing_fee utility_fee paid_basic paid_marketing paid_utility
1  2  80.00    500.00        151.51       65.00      80.00           0.00         0.00
2  4 293.64    140.59         10.12       99.29     140.59          10.12        99.29
3  5 157.00     21.49        562.50      102.35      21.49         135.51         0.00

Вместо mutate я использую mutate_all, чтобы применить map2_dbl с pmin к каждому столбцу в подмножестве.

Answer 2

Я не уверен, что это намного менее сложно, чем ваше существующее решение, но вот один из способов получить дополнительные столбцы

library(tidyverse)

fee_data <- select_at(data, vars(contains('fee')))

fee_data %>% 
  accumulate(`+`) %>% 
  map2_df(data$paid + fee_data, ~ .y - .x) %>% 
  map2_df(fee_data, ~ pmax(0, pmin(.x, .y))) %>% 
  rename_all(~ paste0('paid_', sub('_fee', '', .x))) %>% 
  bind_cols(data, .)

#   id   paid basic_fee marketing_fee utility_fee paid_basic paid_marketing paid_utility
# 1  2  80.00    500.00        151.51       65.00      80.00           0.00         0.00
# 2  4 293.64    140.59         10.12       99.29     140.59          10.12        99.29
# 3  5 157.00     21.49        562.50      102.35      21.49         135.51         0.00