首页
学习
活动
专区
工具
TVP
发布
社区首页 >问答首页 >如何从逻辑上减去行

如何从逻辑上减去行
EN

Stack Overflow用户
提问于 2019-06-19 20:59:17
回答 2查看 64关注 0票数 1

我的df看起来有点像这样:

代码语言:javascript
复制
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)

我想要实现的是

代码语言:javascript
复制
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)

实际上,两者之间的逻辑非常简单。对于每个id,获取已付价值的金额,然后按优先顺序“尽可能多地支付”费用-基本费用、营销费用、效用费用。请注意,任何费用的支付金额都不能高于其实际价值。

我的代码下面工作,但它是非常丑陋的重复代码的一部分。现在我有了更复杂的包含100+列的数据帧。我不想创建更多更复杂的代码,如果有成千上万行的话。

代码语言:javascript
复制
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)
)
EN

回答 2

Stack Overflow用户

回答已采纳

发布于 2019-06-19 21:24:29

我不确定这是否比您现有的解决方案简单得多,但这里有一种方法可以获得额外的列

代码语言:javascript
复制
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
票数 1
EN

Stack Overflow用户

发布于 2019-06-19 21:34:18

我最初的答案不能推广到任意数量的行数,所以这里是另一个尝试:

代码语言:javascript
复制
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, .)

它返回:

代码语言:javascript
复制
  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将带有pminmap2_dbl应用到子集的每一列。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/56668247

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档