创建自定义函数以避免极端速率

Question

我想创建一个自定义函数来避免极端的利率，在我的例子中，降低到2％，相反（增加利率）不是问题。

为此，我有一个数据集：

# Dataset
area <- c("A","A","A","A","B","B","B","B","C","C","C","C")
dates <- c("05-01-2024","10-01-2024","18-01-2024","01-02-2024",
"05-01-2024","10-01-2024","18-01-2024","01-02-2024","05-01-2024",
"10-01-2024","18-01-2024", "01-02-2024")
response <- c(63,68,82,85,77,71,60,50,79,78,77,76)
my.ds <- data.frame(area = area, dates = dates, response = response)

我需要一个自定义函数，如果最后一个日期低于 2%，那么新值仅减少 2%，如果该值增加或降低到 2%，则无需执行任何操作。 我尝试这样做：

mutate(my.ds, response = ifelse(c(0, abs(diff(response))) < abs(response * .02), lag(response),  response),  .by = area)

但不起作用。

我想要的

new.my.ds

，一定是：

# my.ds.new
#  area      dates response
#1    A 2024-01-05       63
#2    A 2024-01-10       68
#3    A 2024-01-18       82
#4    A 2024-02-01       85
#5    B 2024-01-05       77
#6    B 2024-01-10       76
#7    B 2024-01-18       75
#8    B 2024-02-01       74
#9    C 2024-01-05       79
#10   C 2024-01-10       78
#11   C 2024-01-18       77
#12   C 2024-02-01       76

请问有什么帮助吗？

Answer 1

试试这个：

# Custom function to cap changes in response
cap_response <- function(response, threshold = 0.02) {
  capped_response <- response
  for (i in 2:length(response)) {
    change <- response[i] - response[i - 1]
    limit <- response[i - 1] * threshold
    if (change < -limit) {
      capped_response[i] <- response[i - 1] * (1 - threshold)
    }
  }
  return(ceiling(capped_response))
}

# Apply the function using mutate and group_by
new.my.ds <- my.ds %>%
  group_by(area) %>%
  mutate(response = cap_response(response)) %>%
  ungroup()