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

Viewed 54

I am trying to write a function in R that uses a "key-value" data.frame of quantile breakpoints to return a weight based on the quantile that an input value falls into. Here is an example of one of these data.frames:

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))

I can achieve my desired output with a hard-coded solution, but I would like a dynamic solution that can handle different "key-value" data.frames.

Here is my hard-coded solution:

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)

I have tried to write a dynamic solution, but after much tinkering I can't get it to provide the correct weights.

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)

Could someone provide a way to dynamically assign weights, without the tedium of hardcoding?

For testing, here is a second example key-value data frame. The solution I am seeking should work with both key1 and key2. Thanks.

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))
1 Answers

FindInterval will do the trick, have a look at the options to set precisely the limits:

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