簡化包含多個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？我會把細節留給你。