Всем привет, иногда возникает задача сравнивать наборы числовых данных с

различными справочниками.
Долго не мог понять, как в lapply использовать одновременно .SD и имя колонки.
Нашел следующее решение.
library(data.table)

# набор данных
df <- data.table(a = c(1,3,5),
b = c(10,30,NA))

# справочник с границами
frontiers <- data.table(variable = c("a","b","c"),
min = c(2,20,30),
max = c(4,40,65))
frontiers
#> variable min max
#> 1: a 2 4
#> 2: b 20 40
#> 3: c 30 65

# оценка параметров по границам
cols_to_define = paste0(names(df), "_grade" )
df[, (cols_to_define) := mapply(function(x,n){
fcase(x < frontiers[variable == n, min], "below",
x > frontiers[variable == n, max], "above",
x >= frontiers[variable == n, min] & x <= frontiers[variable == n, max], "fine",
default = NA_character_)
},
x = .SD,
n = names(.SD),
SIMPLIFY = FALSE
)]
df
#> a b a_grade b_grade
#> 1: 1 10 below below
#> 2: 3 30 fine fine
#> 3: 5 NA above <NA>

Нормально ли решать задачу так или это адский костыль и есть более красивые решения?

Неясна необходимость работы с колонками. Решение задачи в исходной постановке почти классическое. Если использовать dcast и melt, то второй вариант может оказаться даже быстрее. library(tidyverse) library(data.table) #> #> Присоединяю пакет: 'data.table' #> Следующие объекты скрыты от 'package:dplyr': #> #> between, first, last #> Следующий объект скрыт от 'package:purrr': #> #> transpose # набор данных df <- tibble(a = c(1,3,5), b = c(10,30,NA)) dt <- data.table(a = c(1,3,5), b = c(10,30,NA)) # справочник с границами frontiers <- data.table(variable = c("a","b","c"), min = c(2,20,30), max = c(4,40,65)) frontiers #> variable min max #> <char> <num> <num> #> 1: a 2 4 #> 2: b 20 40 #> 3: c 30 65 #> variable min max #> 1: a 2 4 #> 2: b 20 40 #> 3: c 30 65 # оценка параметров по границам f1 <- function(){ dt$a_grade <- NULL dt$b_grade <- NULL cols_to_define = paste0(names(df), "_grade" ) dt[, (cols_to_define) := mapply(function(x,n){ fcase(x < frontiers[variable == n, min], "below", x > frontiers[variable == n, max], "above", x >= frontiers[variable == n, min] & x <= frontiers[variable == n, max], "fine", default = NA_character_) }, x = .SD, n = names(.SD), SIMPLIFY = FALSE )] } f2 <- function(){ df %>% mutate(id = row_number()) %>% pivot_longer(cols = -id) %>% left_join(frontiers, by = c("name" = "variable")) %>% mutate(grade = if_else(between(value, min, max), "In", "Out")) %>% select(-min, -max) %>% pivot_wider(names_from = name, values_from = c(value, grade)) } bench::mark(f1(), f2(), check = FALSE) #> # A tibble: 2 × 6 #> expression min median `itr/sec` mem_alloc `gc/sec` #> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl> #> 1 f1() 11.4ms 12.1ms 81.7 3.24MB 4.19 #> 2 f2() 18.6ms 19.2ms 50.2 3.49MB 9.56