Проблема с фильтром dplyr внутри функции в R - PullRequest
Новая
       75

Проблема с фильтром dplyr внутри функции в R

2 голосов
/ 05 мая 2020

У меня есть следующий набор данных: 

dat<-structure(list(X1979 = c(1.26884, 0.75802, 0.35127, -0.0679517, 
-4.34841, -0.312289, -5.02931, -2.49339, -12.9065, -2.90853, 
-1.02833, 0.333109, 1.70236, -2.44456, -1.83307, -0.982637, -2.14197, 
-4.1294, -3.98545, -6.26205, -5.56162, 0.0789091, 1.63146, -0.214938 
), X1980 = c(-1.32651, -0.0199441, -1.08583, 3.25939, 0.0402712, 
-3.22174, -0.859756, -3.30898, 1.0128, 0.847161, 2.75866, 1.93117, 
1.05851, 1.83372, -0.811736, -0.992584, -0.110012, 0.132343, 
2.21745, -1.48902, 0.111302, -3.77058, -3.65044, -2.41263)), class = 
"data.frame", row.names = 50:73)

Я хотел бы применить следующую функцию для каждого столбца в приведенных выше данных: 

  library(dplyr)
  library(tibble)
  library(zoo)


  test <- function(x){ 
  dat %>%
  rownames_to_column() %>%
  filter(V1 > 0 &
   rollsum(V1 > 0, 4, fill = NA, align = 
  "left") >= 3 &
   rollsum(V1, 4, fill = NA, align = 
  "left") > 1) %>%
  return(slice(1))
  }

 test(dat)

Я обнаружил ошибку, сообщающую, что V1 не найдено в данных. Итак, мой вопрос: как мне исправить эту функцию, чтобы она могла читать значения в столбце независимо от имени заголовка?

Я буду признателен за любую помощь по этому поводу.

Ответы [ 2 ]

4 голосов
/ 05 мая 2020

Нужно использовать аккуратную оценку. Дополнительная информация здесь: 

library(zoo)
library(rlang)
library(tidyverse)

dat <- structure(list(X1979 = c(1.26884, 0.75802, 0.35127, -0.0679517, 
                              -4.34841, -0.312289, -5.02931, -2.49339, -12.9065, -2.90853, 
                              -1.02833, 0.333109, 1.70236, -2.44456, -1.83307, -0.982637, -2.14197, 
                              -4.1294, -3.98545, -6.26205, -5.56162, 0.0789091, 1.63146, -0.214938 
), X1980 = c(-1.32651, -0.0199441, -1.08583, 3.25939, 0.0402712, 
             -3.22174, -0.859756, -3.30898, 1.0128, 0.847161, 2.75866, 1.93117, 
             1.05851, 1.83372, -0.811736, -0.992584, -0.110012, 0.132343, 
             2.21745, -1.48902, 0.111302, -3.77058, -3.65044, -2.41263)), class = 
  "data.frame", row.names = 50:73)

Используйте фигурные-фигурные {{}}

test <- function(dat, column_name){ 
  dat %>%
    rownames_to_column() %>%
    filter({{column_name}} > 0 &
             rollsum({{column_name}} > 0, 4, fill = NA, align = 
                       "left") >= 3 &
             rollsum({{column_name}}, 4, fill = NA, align = 
                       "left") > 1) %>%
    slice(1) -> result
    return(result)
}

test(dat, X1979)
#>   rowname  X1979   X1980
#> 1      50 1.2688 -1.3265

Используйте .data[[]] местоимение 

test2 <- function(dat, column_name){ 
  dat %>%
    rownames_to_column() %>%
    filter(.data[[column_name]] > 0 &
             rollsum(.data[[column_name]] > 0, 4, fill = NA, align = 
                       "left") >= 3 &
             rollsum(.data[[column_name]], 4, fill = NA, align = 
                       "left") > 1) %>%
    slice(1) -> result
  return(result)
}

out <- colnames(dat) %>% 
  set_names %>% 
  map_dfr(~ test2(dat, .x), .id = 'Col_ID')
out
#>   Col_ID rowname    X1979   X1980
#> 1  X1979      50   1.2688 -1.3265
#> 2  X1980      58 -12.9065  1.0128

Создано 2020-05- 05 с помощью пакета REPEX (v0.3.0)

2 голосов
/ 05 мая 2020

Чтобы продемонстрировать, что @NelsonGon упомянул в ссылке относительно нестандартной оценки, см. Приведенный ниже код. 

# if passing a string
test <- function(x) {
  my_v <- rlang::sym(x)

  out <- dat %>% 
    rownames_to_column() %>%
    filter(!!my_v > 0 &
             rollsum(!!my_v > 0, 4, fill = NA, align = 
                       "left") >= 3 &
             rollsum(!!my_v, 4, fill = NA, align = 
                       "left") > 1) %>% 
    slice(1)
    return(out)
}
test("X1979")

# if passing expression
test <- function(x) {
  my_v <- rlang::enquo(x)

  out <- dat %>% 
    rownames_to_column() %>%
    filter(!!my_v > 0 &
             rollsum(!!my_v > 0, 4, fill = NA, align = 
                       "left") >= 3 &
             rollsum(!!my_v, 4, fill = NA, align = 
                       "left") > 1) %>% 
    slice(1)
  return(out)
}
test(X1979)

Но, вероятно, лучше также передать data.frame в качестве аргумента в функция, вызывая ее z. 

test3 <- function(z, x) {
  my_v <- rlang::sym(x)

  out <- z %>% 
    rownames_to_column() %>%
    filter(!!my_v > 0 &
             rollsum(!!my_v > 0, 4, fill = NA, align = 
                       "left") >= 3 &
             rollsum(!!my_v, 4, fill = NA, align = 
                       "left") > 1) %>% 
    slice(1)
  return(out)
}
test3(dat, "X1979")
...