Question

我希望我的函数能够为我的一个参数（在本例中为CC）的不同值生成值，以便我可以轻松地将其转换为数据框。

这是我正在使用的代码：

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

当我调用函数时，这就是

> 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

Answer 1

我不是100％理解，但是我想您想遍历每个cc值。我使用apply函数进行循环。

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

Answer 2

该函数被编写为接受标量参数，但是您可以像这样对它进行矢量化：

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

或使用sapply：

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

请注意，dur，cc_lag和extended是在问题中显示的函数主体中未使用的参数。即使传递了dur，如果该语句返回，它也会在第一个if语句中立即被NULL覆盖。另外，根本没有引用cc_lag和extended。如果年龄在40到50之间，则可能打算将dur参数作为默认参数，因为这些年龄没有其他处理，但实际上在这种情况下会返回NULL。该功能本身需要根据您的需要进行固定，而问题中没有对此进行描述。

重写功能

1）这是尝试对其进行重写的尝试。首先使用截止值创建一个m矩阵。行对应于cc，列对应于age。通过将cc和age放入数据框中并提取出来，确保它们的长度相同。然后将m和cc的索引计算到age中。请注意，age可能不对应任何索引，因此在这种情况下请将其索引设置为NA。如果是这种情况，请返回dur，否则返回在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）这种尝试在精神上与您所遇到的问题更接近。它适用于标量，然后我们使用Vectorize对其进行矢量化。尽管很乏味，但从简单性的角度来看可能是首选。

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

Answer 3

我认为这里是if (cc < 15)引起的警告，因为cc不是单个元素而是向量。因此，您遇到了类似if (c(TRUE, FALSE, FALSE))的问题。由于如果只需要一个条件，则仅显示第一个条件，这是正确的。

如果要评估cc的所有元素，可以检出all或any之类的函数。

我想说的话：

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

可能的解决方法可能是这样

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)

Answer 4

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

如何获得R函数以返回多个参数值

4 个答案:

重写功能