Как векторизовать функцию поднабора в R?

Question

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

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

Пример

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

test_funct <- function(sep_wid, sep_len) {
    iris %>% filter(Sepal.Width > sep_wid & 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

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

Answer 1

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

tv <- Vectorize(test_funct)

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

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

Answer 2

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

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

map2_dbl(sep_wid_vector, sep_len_vector, test_funct)

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

Answer 3

Вот один из способов использования 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] & 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