Передача строкового аргумента функции в качестве имени столбца - PullRequest
1 голос
/ 06 марта 2020

Мне нужно написать функцию, которая использует строковый аргумент в теле для создания имени столбцов. Например,

dt1 <- data.table( Col_1999_L = c(6,7,8,9,10),
                  Col_1999_R = c(1,-2,3,-4,5),
                  Col_2001_L = c(-8-3,5, 2,-1),
                  Col_2001_R = c(-1,2,-3,4,5)
)

Здесь 1999, 2001 действительно представляют годы. Мой вывод должен быть таким же, как в dt2, где я создаю новые столбцы, где проверяются некоторые условия.

dt2 <- dt1 %>% 
  select(c("Col_1999_L", "Col_1999_R")) %>% 
  mutate(
    New1 = if_else(Col_1999_L >= 0, "pos", "neg"),
    New2 = case_when(
      Col_1999_L >=0 & Col_1999_R >=0 ~ "pos",
      Col_1999_L >=0 & Col_1999_R < 0 ~ "neg",
    ))
dt2

Мне действительно нужно написать функцию, которая создает для каждого года таблицу, подобную df2.

Я пробовал что-то вроде этого (что неправильно):

my_function <- function(dt, Year) {
dt %>%  
mutate(
      New1 = if_else(Col_"Jahr"_L >= 0, "pos", "neg"),
      New2 = case_when(
        Col_"Year"_L >=0 & Col_"Year"_R >=0 ~ "pos",
        Col_"Year"_L >=0 & Col_"Year"_R < 0 ~ "neg"))
}

my_function(dt1, 1999)

Любая помощь о том, как написать это правильно? Спасибо

Ответы [ 2 ]

2 голосов
/ 06 марта 2020

Мы можем paste значения, преобразовать в sym бол и затем оценить (!!). Если у нас есть созданная строка, предпочтительным способом tidyverse является преобразование в sym bol и затем оценка.

library(dplyr)
my_function <- function(dt, Year) {
   nm1 <- rlang::sym(paste0("Col_", Year, "_R"))
   nm2 <- rlang::sym(paste0("Col_", Year, "_L"))
   dt %>%  
   mutate(
       New1 = if_else(!! nm2 >= 0, "pos", "neg"),
       New2 = case_when(
         !!nm2 >=0 & !!nm1 >=0 ~ "pos",
        !!nm2 >=0 & !!nm1 < 0 ~ "neg"))
    }

my_function(dt1, 1999)
#    Col_1999_L Col_1999_R Col_2001_L Col_2001_R New1 New2
#1:          6          1         -8         -1  pos  pos
#2:          7         -2         -3          2  pos  neg
#3:          8          3          5         -3  pos  pos
#4:          9         -4          2          4  pos  neg
#5:         10          5         -1          5  pos  pos

Или, если мы передадим полное имя столбца без кавычек, мы сможем использовать оператор curly-curly ({{}})

 my_function <- function(dt, colnm1, colnm2) {
      dt %>%
         mutate(New1 = if_else({{colnm2}} > 0, "pos", "neg"),
                New2 = case_when({{colnm2}} >= 0 & {{colnm1}} >=0 ~ "pos",
                      {{colnm2}} >= 0 & {{colnm1}} < 0 ~ "neg"))
  }


my_function(dt1, Col_1999_R, Col_1999_L)
#   Col_1999_L Col_1999_R Col_2001_L Col_2001_R New1 New2
#1:          6          1         -8         -1  pos  pos
#2:          7         -2         -3          2  pos  neg
#3:          8          3          5         -3  pos  pos
#4:          9         -4          2          4  pos  neg
#5:         10          5         -1          5  pos  pos

data

dt1 <- data.table( Col_1999_L = c(6,7,8,9,10),
                  Col_1999_R = c(1,-2,3,-4,5),
                  Col_2001_L = c(-8, -3,5, 2,-1),
                  Col_2001_R = c(-1,2,-3,4,5)
)
1 голос
/ 06 марта 2020

Если вы не знакомы с операторами sym bol и bang bang, вы можете использовать get:

my_function <- function(dt,year){
  R <- sprintf("Col_%d_R",year) # same as paste0("Col_",year,"_R") but simplified
  L <- sprintf("Col_%d_L",year)
  dt %>% 
  mutate(
    New1 = if_else(get(R,dt) >= 0, "pos", "neg"),  # although get(R) works, use get(R,dt)
    New2 = case_when(
      get(L,dt) >=0 & get(R,dt) >=0 ~ "pos",
      get(L,dt)>=0 & get(R,dt) < 0 ~ "neg",
    ))
}

my_function(dt1,1999)
  Col_1999_L Col_1999_R Col_2001_L Col_2001_R New1 New2
1          6          1         -8         -1  pos  pos
2          7         -2         -3          2  neg  neg
3          8          3          5         -3  pos  pos
4          9         -4          2          4  neg  neg
5         10          5         -1          5  pos  pos
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...