Описание

Я пытаюсь освоить программирование на data.table и испытываю некоторые трудности с пониманием виктиметры по программированию на data.table.

В виктиметре, в разделе Вычисления на языке, приводится следующий пример на базовом R:

my_subset = function(data, col, val) {
  eval(substitute(subset(data, col == val)))
}
my_subset(iris, Species, "setosa")

Я пытаюсь понять, как адаптировать и расширить это, используя аргумент env = list() в data.table. Моя попытка воспроизвести это выглядит следующим образом:

my_subset <- function(data, col, val) {
    data <- data.table::as.data.table(data)
    data[x == val, env = list(x = as.name(col))]
}
my_subset(iris, "Species", "setosa")

1. Это, вероятно, показывает, насколько я не знаю, но почему “Species” должно быть в кавычках, в отличие от предыдущей функции my_subset()? Если я оставлю без кавычек, я получаю Ошибка: объект 'Species' не найден.

Расширяя, я бы хотел, возможно, создать столбец на основе определенного условия.

my_subset <- function(data, col, val, newcol) {
    data <- data.table::as.data.table(data)
    data[,
        y := data.table::fifelse(x == val, TRUE, FALSE),
        env = list(x = as.name(col), y = as.name(newcol))
    ]
}
results <- my_subset(iris, "Species", "setosa", "Test")
head(results)

   Sepal.Length Sepal.Width Petal.Length Petal.Width Species   Test
          <num>       <num>        <num>       <num>  <fctr> <lgcl>
1:          5.1         3.5          1.4         0.2  setosa   TRUE
2:          4.9         3.0          1.4         0.2  setosa   TRUE
3:          4.7         3.2          1.3         0.2  setosa   TRUE
4:          4.6         3.1          1.5         0.2  setosa   TRUE
5:          5.0         3.6          1.4         0.2  setosa   TRUE
6:          5.4         3.9          1.7         0.4  setosa   TRUE

Это также, похоже, работает как ожидалось. Далее, я хотел бы заменить == на оператор, заданный пользователем. Ссылаясь на этот ответ на SO, кажется, что сделать это можно следующим образом:

my_fun <- function(data, col, val, newcol, operator) {
    # к data.table
    data <- data.table::as.data.table(data)

    # класс col
    is_number <- data[, inherits(x, "integer") | inherits(x, "numeric"), env = list(x = as.name(col))]

    # допустимые операторы
    ops <- c("<", ">", "<=", ">=", "==", "!=", "%in%")
    if (!is_number) ops <- ops[-c(1:4)]
    if (!operator %in% ops) stop()

    # делаем дело
    data[,
        y := data.table::fifelse(.cond, TRUE, FALSE),
        env = list(
            y = as.name(newcol),
            .cond = call(operator, as.name(col), val)
        )
    ]

    # возвращаем
    return(data)
}
# работает
results <- my_fun(iris, "Species", c("setosa", "virginica"), "Test", "%in%")

# ошибки как и планировалось
results <- my_fun(iris, "Species", c("setosa", "virginica"), "Test", ">")

# работает
results <- my_fun(iris, "Sepal.Length", 5.2, "GreaterThan5.2", ">")

Дело в том, что это, кажется, чуть ли не возвращает к eval(parse(...)), от чего виктиметра специально предостерегает.

В примере

Для более реалистичного примера, я пытаюсь добавить функциональность в ggplot2 geom_smooths(). Используя некоторую из приведенной логики, я написал эту функцию:

gg_split_smooth_data <- function(model, xvar, split_point, operator) {
    # получение данных
    data <- insight::get_datagrid(model, length = 1000) |>
        data.table::as.data.table()

    # класс col
    is_number <- data[, inherits(x, "integer") | inherits(x, "numeric"), env = list(x = as.name(xvar))]
    if (!is_number) cli::cli_abort(c("x" = "{.val {xvar}} должен быть числовым."))

    # предсказание
    pred <- predict(model, se = TRUE, newdata = data)

    # добавляем предсказания в данные
    data <- data |>
        dplyr::mutate(
            p = pred$fit,
            se = pred$se.fit,
            lower = p - 1.96 * se,
            upper = p + 1.96 * se
        ) |>
        data.table::as.data.table()


    # допустимые операторы
    ops <- c("<", ">", "<=", ">=")
    if (!operator %in% ops) cli::cli_abort(c("x" = "{.val {operator}} не является допустимым оператором."))

    # делаем дело
    data[,
        Group := data.table::fifelse(.cond, TRUE, FALSE),
        env = list(
            .cond = call(operator, as.name(xvar), split_point)
        )
    ]

    # делим по группе
    data <- split(data, by = "Group")

    # построение
    plot <- ggplot2::ggplot() +
        ggplot2::geom_ribbon(
            ggplot2::aes(
                x = .data[[xvar]],
                ymin = lower,
                ymax = upper,
                fill = Group
            ),
            alpha = 0.3,
            data = data[[1]]
        ) +
        ggplot2::geom_ribbon(
            ggplot2::aes(
                x = .data[[xvar]],
                ymin = lower,
                ymax = upper,
                fill = Group
            ),
            alpha = 0.3,
            data = data[[2]]
        ) +
        ggplot2::geom_line(
            ggplot2::aes(
                x = .data[[xvar]],
                y = p,
                color = Group
            ),
            data = data[[1]]
        ) +
        ggplot2::geom_line(
            ggplot2::aes(
                x = .data[[xvar]],
                y = p,
                color = Group
            ),
            data = data[[2]]
        ) +
        ggplot2::geom_vline(xintercept = split_point)

    return(plot)
}

mgcv::gam(hp ~ s(mpg), data = mtcars) |>
    gg_split_smooth_data(
        xvar = "mpg",
        split_point = 23,
        operator = "<"
    )

Очевидно, что с этим есть множество проблем, но это иллюстрирует суть. Что ведет к

2. Есть ли альтернативы тому, чтобы пользователь передавал оператор в виде строки?

3. Каковы более эффективные подходы?

Я понимаю, что это скорее философский вопрос, поэтому буду признателен за любые ответы (tidyverse, base и т.д.)!