Блог

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

Однако мне не удалось векторизовать какую-либо функцию, которая задает подмножество фрейма данных на основе входных данных функции

Пример

Например. Эта функция хорошо работает, когда она получает элементы

 test_funct <- function(sep_wid, sep_len) {
    iris %>% filter(Sepal.Width > sep_wid amp; Sepal.Length < sep_len) %>% .$Petal.Width %>% sum
}

test_funct(4, 6)

# [1] 0.7 # This works nicely
  

Но при попытке предоставить векторы в качестве входных данных для этой функции:

 sep_wid_vector <- c(4, 3.5, 3)
sep_len_vector <- c(6, 6, 6.5)


test_funct(sep_wid_vector, sep_len_vector)

[1] 9.1 
  

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

 # 0.7    4.2     28.5 

  

Для удобства здесь выводится так, как если бы все они выполнялись отдельно

 test_funct(4, 6) # 0.7
test_funct(3.5, 6) # 4.2
test_funct(3, 6.5) # 28.5

  

Как я могу векторизовать функцию, которая подмножествует данные на основе своих входных данных, чтобы она могла получать векторные входные данные?

Проблема в том, что filter принимает векторные входные данные, поэтому он будет перерабатывать векторы в Sepal.width и Sepal.length сравнениях.

Одним из способов сделать это было бы использовать map2 из purrr пакета:

 map2_dbl(sep_wid_vector, sep_len_vector, test_funct)
  

Конечно, вы могли бы затем обернуть это в функцию. Возможно, вы также захотите рассмотреть возможность передачи фрейма данных в качестве параметра функции.

Вы можете использовать Vectorize :

 tv <- Vectorize(test_funct)

tv(sep_wid_vector, sep_len_vector)
# [1]  0.7  4.2 28.5
  

По сути , это обертка вокруг mapply . Имейте в виду, что под капотом вы запускаете *apply функцию, которая является своего рода циклом

Вот один из способов использования sapply

 # function using sapply
test_funct <- function(sep_wid, sep_len) {
  sapply(seq_along(sep_wid), function(x) {
    sum(iris$Petal.Width[iris$Sepal.Width > sep_wid[x] amp; iris$Sepal.Length < sep_len[x]])
  })
}

# testing with single value
test_funct(4,6)
[1] 0.7

# testing with vectors
test_funct(sep_wid_vector, sep_len_vector)
[1]  0.7  4.2 28.5