Блог

У меня есть функция, и я хочу добавить к вектору переменных некоторые переменные в некоторых конкретных случаях. Позже это переходит к формулам регрессии

Пример кода:

 some_function <- function (df,mdl){ 
  
  vars <- c("var1", "var2", "var3")
  vars <- case_when(mdl== "model1" ~ vars<-("var3", "var4", vars),
                    mdl== "model2" ~ vars<-("var4", "var5", vars))
  
  target_col <- "count"
  target_formula <- as.formula(sprintf("%s ~ %s", 
                                       target_col, 
                                       paste(vars, collapse = "   ")))
}
 

mdl — это аббревиатура, составленная из текста, который должен представлять различные модели, их насчитывается около 8-10

Вы можете определить model1 / model2 в списке, затем map с помощью as.formula :

 library(purrr)
library(glue)

vars <- c("var1", "var2", "var3")
target <- "count"
models <- list(model1 = c("var3", "var4", vars),
               model2 = c("var4", "var5", vars))

map(models, ~as.formula(glue("{target} ~ {paste(., collapse = '   ')}")))
 

Вывод:

 $model1
count ~ var3   var4   var1   var2   var3
<environment: 0x7fec25b8b770>

$model2
count ~ var4   var5   var1   var2   var3
<environment: 0x7fecf096b560>
 

Не выполняйте присваивание внутри case_when , это почти никогда не стоит пытаться. Вместо этого попробуйте это:

 some_function <- function (df,mdl){ 
  newvars <- dplyr::case_when(
    mdl == "model1" ~ c("var3", "var4"),
    mdl == "model2" ~ c("var4", "var5")
  )
  vars <- c("var1", "var2", "var3", newvars)
  # something else here
  vars
}

some_function(mtcars, "model1")
# [1] "var1" "var2" "var3" "var3" "var4"
some_function(mtcars, "model2")
# [1] "var1" "var2" "var3" "var4" "var5"
 

Кажется, это нормально, но есть две вещи, которые можно улучшить.

1. Первый повторяется "var3" , возможно, мы можем добавить vars <- unique(vars) к функции.
2. case_when на самом деле предназначен для векторизованной замены вложенных ifelse (или dplyr::if_else ), где вложенность работает, но может затруднить отслеживание / поддержку. Из-за этого это говорит о том, что mdl длина может быть больше 1. Но когда мы передаем аргумент длины 2:

    some_function(mtcars, c("model1", "model2"))
   # [1] "var1" "var2" "var3" "var3" "var5"
    

   Первое сравнение в case_when находит, что mdl == "model1" соответствует первому вектору, но оно использует только первый из c("var3","var4") . Далее, если мы передадим еще много, то получим ошибки о несовместимых длинах векторов.

Я подозреваю, что вы намереваетесь mdl иметь длину 1, и в этом случае у вас, вероятно, есть несколько других номеров моделей, и вы хотите добавить набор дополнительных переменных к значениям по умолчанию. Возможно, это в конечном итоге то, что вы хотите?

 some_function <- function (df, mdl){ 
  newvars <- switch(
    mdl[1],
    model1 = c("var3", "var4"),
    model2 = c("var4", "var5"),
    stop("unrecognized model: ", sQuote(mdl))
  )
  vars <- c("var1", "var2", "var3", newvars)
  # something else here
  vars
}

some_function(mtcars, "model1")
# [1] "var1" "var2" "var3" "var3" "var4"
some_function(mtcars, "model2")
# [1] "var1" "var2" "var3" "var4" "var5"
some_function(mtcars, "model3")
# Error in some_function(mtcars, "model3") : unrecognized model: 'model3'
 

Мы можем использовать reformulate для создания моделей в base R

 vars <- c("var1", "var2", "var3")
target <- "count"
models <- list(model1 = c("var3", "var4", vars),
           model2 = c("var4", "var5", vars))
lapply(models, reformulate, response = target)
 

-вывод

 #$model1
#count ~ var3   var4   var1   var2   var3
#<environment: 0x7f92c7658ed8>

#$model2
#count ~ var4   var5   var1   var2   var3
#<environment: 0x7f92c7649a88>
 

Его можно обернуть в a function и использовать условия с if/else , а ввод набора данных для функции, похоже, не используется в сообщении OP

 some_function <- function (df,mdl){ 

 vars <- c("var1", "var2", "var3")
 vars <- if(mdl == "model1") {
            c(vars, "var4")
    } else c(vars, "var5")
 


 target_col <- "count"
 reformulate(vars, response = target)
}
 
 

-тестирование

 some_function(iris, "model1")
#count ~ var1   var2   var3   var4
#<environment: 0x7f92f0c77370>

some_function(iris, "model2")
#count ~ var1   var2   var3   var5
#<environment: 0x7f92f0ce6db8>