Удобная функция dplyr для вычисления скользящего среднего

Задний план

Функция вычисляет движущуюся структуру и предлагает некоторые другие второстепенные виджеты, такие как возможность вернуть фрейм данных в исходном порядке или автоматически получить имя переменной для скользящего среднего. В большинстве реальных случаев использования аналогичных результатов можно легко достичь, используя комбинации обычных подозреваемых, таких как across, mutate и так далее. Однако меня интересовала реализация, которая:

  1. Достаточно общий и легко применимый к нескольким наборам данных
  2. Использует стандартные сказочные глаголы dplyr для облегчения использования в sparklyr, особенно при работе со старыми серверными модулями Spark, которые не поддерживают apply. Функция оказалась запутанной, поэтому я чувствую, что не смог достичь этой цели, но это побочный момент.

Искал обратную связь

  1. Лучший подход к созданию нескольких lag звонки. Через манипуляции со строками я прихожу к lag(var, n)... а затем выполните:

    dplyr::mutate(data_sorted,"{{val}}_mavg" := !!rlang::parse_expr(lag_call))
    

    Это кажется пустяком, и я был бы благодарен за предложения по улучшению.

  2. Есть ли элегантный способ принудительного вычисления в левой части :=. В настоящее время занимаюсь:

    if (res_val != "{{val}}_mavg") {
         data_avg <- dplyr::rename(res_val = "{{val}}_mavg")
    }
    

    Это работает, но однострочно, как оценка res_val а потом делать потенциально необходимую магию с кудрявый было бы здорово.

  3. Любые другие наблюдения


Функция

#' Add Moving Average for an Arbitrary Number of Intervals
#"https://codereview.stackexchange.com/questions/254621/#" The functions adds moving average for an arbitrary number of intervals. The
#'   data can be returned sorted or according to the original order.
#"https://codereview.stackexchange.com/questions/254621/#" @details The function can be used independently or within dplyr pipeline.
#"https://codereview.stackexchange.com/questions/254621/#" @param .data A tibble or data frame.
#' @param sort_cols Columns used for sorting passed in a manner consistent with
#'   code{link[dplyr]{arrange}}
#' @param val Column used to calculate moving average passed as bare column
#'   name or a character string.
#' @param res_val Resulting moving average, defaults to name of code{val}
#'   suffixed with code{_mavg}.
#' @param restore_order A logical, defaults to code{FALSE} if code{TRUE} it
#'   will restore original data order.
#"https://codereview.stackexchange.com/questions/254621/#" @return A tibble with appended moving average.
#' @export
#"https://codereview.stackexchange.com/questions/254621/#" @examples
#' add_moving_average(mtcars, sort_cols = c("mpg", "cyl"), val = hp, intervals = 2)
add_moving_average <-
    function(.data,
             sort_cols,
             val,
             intervals = 2,
             res_val = "{{val}}_mavg",
             restore_order = FALSE) {

        unique_id_name <- tail(make.unique(c(colnames(.data), "ID")), 1)
        data_w_index <- dplyr::mutate(.data, {{unique_id_name}} := dplyr::row_number())

        index_col_name <- tail(names(data_w_index), 1)

        # Create desired number of calls to get moving average calculation
        lag_calls <- paste0("lag(",  rlang::as_string(rlang::ensym(val)), ", ", 1:intervals, ")")
        lag_call <- paste(lag_calls, collapse = " + ")
        lag_call <- paste0("(", lag_call, ") / ", intervals)

        data_sorted <- dplyr::arrange(data_w_index, dplyr::across(sort_cols))

        data_avg <- dplyr::mutate(data_sorted,"{{val}}_mavg" := !!rlang::parse_expr(lag_call))

        if (res_val != "{{val}}_mavg") {
            data_avg <- dplyr::rename(data_avg, res_val = "{{val}}_mavg")
        }

        if (restore_order) {
            data_avg <- dplyr::arrange(data_avg, !!rlang::sym(index_col_name))
        }

        data_avg <- dplyr::select(data_avg, -dplyr::last_col(1))
        data_avg
    }

Тесты

add_moving_average(.data = mtcars, sort_cols = c("am", "gear"), val = disp, intervals = 3)
add_moving_average(.data = mtcars, sort_cols = c("am", "gear"), val = disp, intervals = 3)
add_moving_average(.data = mtcars, sort_cols = c("am", "gear"), val = disp, intervals = 3,
                   restore_order = TRUE)

0

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *