来自键值 table 的动态 if-else "tests" 或 case_when "formulas"?

Dynamic if-else "tests" or case_when "formulas" from a key-value table?

我正在尝试在 R 中编写一个函数,该函数使用 "key-value" data.frame 分位数断点 return 基于输入值的分位数的权重跌进。下面是这些 data.frame 之一的示例:

key1 <- data.frame(Boundary = c(0.01, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09, 0.1, 
                               0.11, 0.12, 0.13, 0.14, 0.15, 0.16, 0.17, 0.22), 
                   Weight = c(0,1, 3.5, 8, 15, 25, 37.5, 51.5, 65, 76.5, 85.5, 
                              91.5, 95, 97.5,99, 100))

我可以使用硬编码解决方案实现我想要的输出,但我想要一个可以处理不同 "key-value" data.frame 的动态解决方案。

这是我的硬编码解决方案:

library(dplyr)

val_vec <- c(0.099, 0.181, 0.134)

getWeight <- function(val){

  w <- dplyr::case_when(
    val < 0.04 & val >= 0.00 ~ 0.0,
    val < 0.05 & val >= 0.04 ~ 1.0,
    val < 0.06 & val >= 0.05 ~ 3.5,
    val < 0.07 & val >= 0.06 ~ 8.0,
    val < 0.08 & val >= 0.07 ~ 15.0,
    val < 0.09 & val >= 0.08 ~ 25.0,
    val < 0.10 & val >= 0.09 ~ 37.5,
    val < 0.11 & val >= 0.10 ~ 51.5,
    val < 0.12 & val >= 0.11 ~ 65.0,
    val < 0.13 & val >= 0.12 ~ 75.5,
    val < 0.14 & val >= 0.13 ~ 85.5,
    val < 0.15 & val >= 0.14 ~ 91.5,
    val < 0.16 & val >= 0.15 ~ 97.5,
    val < 0.17 & val >= 0.16 ~ 99.0,
    val <= 0.22 & val >= 0.17 ~ 100.0)

   return(w)    
}

getWeight(val_vec)

我曾尝试编写一个动态解决方案,但经过多次修改后我无法让它提供正确的权重。

getWeight_Dynamic <- function(val, k = key1){

  qb <- c(0, k[["Boundary"]])
  w <- c()

  for(b in 1:length(qb)){

    if(val < qb[b+1] && val >= qb[b] ){
    w <- k[b-1, 2]
   } 
  }
  return(w)
}

sapply(val_vec, getWeight_Dynamic)

有人可以提供一种动态分配权重的方法,而无需单调乏味的硬编码吗?

为了进行测试,这是第二个示例键值数据框。我正在寻找的解决方案应该适用于 key1key2。谢谢。

key2 <- data.frame(Boundary = c(0.1, 0.16, 0.17, 0.18, 0.19, 0.2, 0.21, 0.22, 
                               0.23, 0.24, 0.25, 0.26, 0.27, 0.28, 0.29, 0.3, 
                               0.31, 0.32, 0.33, 0.330200000000004, 0.35, 0.42), 
                  Weight = c(0, 1, 2, 4, 7, 11, 16.5, 23.5, 32, 41.5, 51, 60, 
                             69, 77, 83.5, 89, 93, 95.5, 97, 98, 99, 100))

FindInterval 可以解决问题,请查看 options 以精确设置限制:

getWeight <- function(x,key){
  key$Weight[findInterval(x,key$Boundary)]
}
getWeight(0.14,key1)
[1] 91.5