How to get R function to return multiple values of parameters

Question

I would like that my function would produce values for different values of one of my parameters (in this case CC), so that I can easily turn this into a dataframe.

Here is the code I am using:

ub_duration <- function(age, cc = c(12, 18, 24), cc_lag, dur, 
                        extended) {
    dur = if (age < 30){
        if (cc < 15) return(150)
        if (cc >= 15 & cc < 24) return(210)
        if (cc >= 24) return(330)
    }
    dur = if (age >= 30 & age < 40){
        if (cc < 15) return(180)
        if (cc >= 15 & cc < 24) return(330)
        if (cc >= 24) return(420)
    }
    dur = if (age >= 50){
        if (cc < 15) return(270)
        if (cc >= 15 & cc < 24) return(480)
        if (cc >= 24) return(540)
    }
    return(dur) 
}

When I call the function, this is what get

> ub_duration(25,c(12, 18, 24),0)
[1] 150
Warning message:
In if (cc < 15) return(150) :
the condition has length > 1 and only the first element will be used

Possible duplicate of [Interpreting "condition has length > 1" warning from \`if\` function](https://stackoverflow.com/questions/14170778/interpreting-condition-has-length-1-warning-from-if-function). When you're testing a condition using a vector of length greater than one, you'll want to use `ifelse()` rather than `if`. See `help("ifelse")`. You'll also need nested `ifelse()` calls. As an example, you can change `if (cc < 15) return(150); if (cc >= 15 & cc < 24) return(210); if (cc >= 24) return(330)` to `ifelse(cc < 15, 150, ifelse(cc < 24, 210, 330))`. — duckmayr, May 26 '19 at 14:42

score 1 · Answer 1 · answered May 26 '19 at 14:36

I'm not 100% I understand, but I'm guessing you want to loop over each cc value. I use the apply function to do the looping.

ub_duration0 <- function(age, cc) {
dur = if (age < 30){
if (cc < 15) return(150)
if (cc >= 15 & cc < 24) return(210)
if (cc >= 24) return(330)
}
dur = if (age >= 30 & age < 40){
if (cc < 15) return(180)
if (cc >= 15 & cc < 24) return(330)
if (cc >= 24) return(420)
}
dur = if (age >= 50){
if (cc < 15) return(270)
if (cc >= 15 & cc < 24) return(480)
if (cc >= 24) return(540)
}
return(dur)
}
ub_duration <- function(age, cc = c(12, 18, 24)) {
  sapply(cc, function(x) ub_duration0(age,x))}

> ub_duration(25,c(12, 18, 24))
[1] 150 210 330

G. Grothendieck · Answer 2 · 2019-05-26T17:05:54.143

The function was written to accept scalar arguments but you can vectorize it like this:

Vectorize(ub_duration)(25, c(12, 18, 24), dur = 0)
## [1] 150 210 330

or use sapply:

sapply(c(12, 18, 24), ub_duration, age = 25, dur = 0)
## [1] 150 210 330

Note that dur, cc_lag and extended are arguments that are not used in the body of the function shown in the question. Even if dur is passed it is immediately overwritten with NULL in the first if statement if that statement returns. Also, cc_lag and extended are not referenced at all. Perhaps you intended that the dur argument is the default if the ages are between 40 and 50 since those ages are not otherwise handled but in fact it returns NULL in that case. The function itself needs to be fixed depending on what you want and that was not described in the question.

Rewriting Function

1) Here is an attempt at rewriting it. First create an m matrix with the cutoff values. The rows correspond to cc and the columns to age. Ensure that cc and age are the same length by putting them into a data frame and extracting them back out. Then compute the indexes into m for cc and age. Note that it is possible that an age does not correspond to any index so in that case set its index to NA. If that is the case return dur and otherwise return the value looked up in m.

ub_duration2 <- function(age, cc, dur = 0) {
  m <- matrix(c(150, 210, 310,
    180, 330, 420,
    270, 400, 540), 3, dimnames = list(cc = 1:3, age = 1:3))
  d <- data.frame(age, cc)
  age <- d$age
  cc <- d$cc
  cc.ix <- 1 + (cc >= 15) + (cc >= 24) 
  age.ix <- 1 * (age < 30) + 2 * (age >= 30 & age < 40) + 3 * (age > 50)
  age.ix[age.ix == 0] <- NA
  ifelse(is.na(age.ix), dur, m[cbind(cc.ix, age.ix)])
}
ub_duration2(25,c(12, 18, 24))
## [1] 150 210 310

2) This attempt is closer in spirit to what you have in the question. It works on scalars and then we use Vectorize to vectorize it. Although tedious it may be preferred in terms of simplicity.

ub_duration_scalar <- function(age, cc, dur = 0) {
    if (age < 30) {
        if (cc < 15) 150
        else if (cc < 24) 210
        else 330
    } else if (age < 40) {
        if (cc < 15) 180
        else if (cc < 24) 330
        else 420
    } else if (age >= 50) {
        if (cc < 15) 270
        else if (cc < 24) 480
        else 540
    } else dur
}
ub_duration3 <- Vectorize(ub_duration_scalar)

ub_duration3(25,c(12, 18, 24))
## [1] 150 210 310

TinglTanglBob · Answer 3 · 2019-05-26T14:58:53.590

I think the warning is caused here if (cc < 15) because cc is not a single element but a vector. So you're having something like if (c(TRUE, FALSE, FALSE)). Since if needs one single condition it pics only the first one, which is true.

If you want to evaluate all elements of cc togehter you could check out functions like all or any.

for a little illustration of what i want to say:

if(c(TRUE, TRUE, FALSE))
{
  print("Entered if")
  # do something
} else {print("Entered else")}
# output:
# [1] "Entered if"
# Warning message:
# In if (c(TRUE, TRUE, FALSE)) { :
# the condition has length > 1 and only the first element will be used


if(c(FALSE, TRUE, FALSE))
{
 print("Entered if")
 # do something
} else {print("Entered else")}
# output:
# [1] "Entered else"
# Warning message:
# In if (c(FALSE, TRUE, FALSE)) { :
# the condition has length > 1 and only the first element will be used

a possible workaround might be something like this

ub_duration <- function(age, cc = c(12, 18, 24), cc_lag, dur, 
                        extended) {
# create matrix countaining the desired values  
outcome_matrix = data.frame("age_under_30" = c(150, 210, 330), "age_30_to_40" = c(180, 330, 420), "age_over_40" = c(270, 480, 540))  
# reduced the highest age limit from 50 to 40. Not sure if this is intendet, but otherwise there would be an undefined gap for age 40 to 50
# check which column is needed for the given age value
coldedect = sum(c(30, 40)<=age)+1
# check wich rows are needed for the given cc values
rowdedect = sapply(cc, function(f) sum(c(14, 24)<=f)+1)    
# select values and return them 
return(outcome_matrix[rowdedect, coldedect])  
}  

ub_duration(25,c(12, 18, 24),0)

score 0 · Answer 4 · answered May 26 '19 at 20:04

ub_duration1 = function(age,cc){
    cc_cat = findInterval(cc,c(15,24))+1
    age_cat =findInterval(age,c(30,40,50))+1
    cc = cbind(c(150,210,330),c(180,330,420),NA,c(270,480,540))
    cc[cc_cat,age_cat]
}

ub_duration(25,c(12, 18, 24))
[1] 150 210 330

How to get R function to return multiple values of parameters

4 Answers4

Rewriting Function