简化包含多个ifelse语句的重复代码

Question

我在考虑一项潜在的政策变更，如果它们符合特定条件，组织（OrgID）将花费其现有的补助金。该数据是三列，和这里的前六行：

OrgID Amount Group 
1  1 5782457 Group1 
2  2 2280221 Group3 
3  3 3260741 Group4 
4  4 3869420 Group1 
5  5 3950578 Group1 
6  6 2058883 Group2 

这会发生，每年一次，条件是基于哪个组的组织是在（Group），和它们的当前余额（Amount） 。具体来说，

对于Group = Group1
- 如果Amount为$ 500,000或以下，所有的钱可以花
- 如果Amount超过$ 500,000时，这些钱50％可以度过。

对于Group = Group2
- 如果Amount为$ 300,000或以下，所有的钱可以花
- 如果Amount超过$ 30万时，钱30％可以度过。

对于Group = Group3
- 如果Amount为$ 100,000或以下，所有的钱可以花
- 如果Amount超过$ 100,000时，这些钱10％可以度过。

对于Group = Group4
- 没有钱可以在任何条件下花费。

我想知道每年在未来五年后剩余的总钱，所以我转向dplyr包，写道：

mydata <- 
    mydata %>% 
    mutate(ReleaseOne = 
       ifelse(Group == "Group1", 
         ifelse(Amount <= 500000, Amount, 
          round(Amount*0.50, 2)), 
         ifelse(Group == "Group2", 
          ifelse(Amount <= 300000, Amount, 
            round(Amount*0.30, 2)), 
          ifelse(Group == "Group3", 
            ifelse(Amount <= 100000, Amount, 
              round(Amount*0.10, 2)), 0)))) %>% 
    mutate(RemainOne = 
       Amount - ReleaseOne) 
... 
mydata <- 
    mydata %>% 
    mutate(ReleaseFive = 
       ifelse(Group == "Group1", 
         ifelse(RemainFour <= 500000, RemainFour, 
          round((RemainFour)*0.50, 2)), 
         ifelse(Group == "Group2", 
          ifelse(RemainFour <= 300000, RemainFour, 
            round((RemainFour)*0.30, 2)), 
          ifelse(Group == "Group3", 
            ifelse(RemainFour <= 100000, RemainFour, 
              round((RemainFour)*0.10, 2)), 0)))) %>% 
    mutate(RemainFive = 
       RemainFour - ReleaseFive) 

因此，我只是重复相同的块的代码五次，但每次更改以“释放”和“剩余”开头的变量名称（即RemaimOne到RemainTwo,ReleaseOne到ReleaseTwo等）。

这样做很好，但它很杂乱。有没有一种方法可以用自定义函数简化它，例如可能包括for和while循环？

另外，知道多少年才会有价值，直到组1,2和3中的所有组织达到Amount = 0;但是，我知道如何做到这一点的唯一方法是不断重复上述内容，直到数量达到零。

数据被命名为mydata.txt，可在GitHub上的this link上找到。

Answer 1

您可以创建一个单独的数据帧进行比较与 -

grp_data <- data.frame("Group" = c("Group1", "Group2", "Group3", "Group4"), 
         "threshold" = c(500000,300000,100000,0), 
         "percent" = c(0.5, 0.3, 0.1, 0)) 
mydata$allowed <- sapply(seq(nrow(mydata)), function(x) 
         { 
          ifelse(mydata[x, "Amount"] >= 
           grp_data[grp_data$Group == mydata[x, "Group"], "threshold"], 
           grp_data[grp_data$Group == mydata[x, "Group"], "percent"] * mydata[x, "Amount"], 
           mydata[x, "Amount"]) 
         }) 

Answer 2

这里有一个小功能应该做的伎俩 - 我把它稍微更一般的为好。它不轮，但我相信如果你愿意，你可以编辑它。

extrap = function(data, 
        threshhold = c(5e5, 3e5, 1e5, 0), 
        below = c(1, 1, 1, 1), 
        above = c(.5, .3, .1, 0), 
        n = 4) { 
    res = list() 
    x = data$Amount 
    g = as.numeric(data$Group) 
    for (i in 1:n) { 
     x = x * above[g]^(x > threshhold[g]) * below[g]^(x <= threshhold[g]) 
     res[[i]] = x 
    } 
    names(res) = paste0("Release_", 1:n) 
    return(bind_cols(data, res)) 
} 

运行它您在问题共享的数据的head：

extrap(dd) 
# OrgID Amount Group Release_1 Release_2 Release_3 Release_4 
# 1  1 5782457 Group1 2891228.5 1445614.25 722807.12 361403.56 
# 2  2 2280221 Group3 228022.1 22802.21 22802.21 22802.21 
# 3  3 3260741 Group4  0.0  0.00  0.00  0.00 
# 4  4 3869420 Group1 1934710.0 967355.00 483677.50 483677.50 
# 5  5 3950578 Group1 1975289.0 987644.50 493822.25 493822.25 
# 6  6 2058883 Group2 617664.9 185299.47 185299.47 185299.47 

它依赖于Group是在所述数据帧中的factor，并且该threshhold，below，和above输入向量对应于Group因子的级别。为了使它更通用，我添加了一个below矢量，在你的情况下它总是0？我有点困惑Group4，也许above值应该是1？我会把细节留给你。