使用 mutate 将 tibble 的多个变量传递给函数会产生 NA?
Pass multiple variables of a tibble to a function using mutate produces NA's?
请指教,我有以下简单功能:
mifflin_equation <- function(gender = "M",
w_kg = 50,
h_cm = 180,
age = 40,
activity_type = "sedentary") {
activity_types <- c("sedentary", "light", "moderate", "active")
if (!(tolower(activity_type) %in% activity_types)) {
activity_type <- "sedentary"
}
activity_trans_table <- tibble(type = activity_types,
activity_coeff = c(1.2, 1.375,
1.55, 1.725))
activity_coeff <- activity_trans_table$activity_coeff[activity_trans_table$type == tolower(activity_type)]
common_equation <- (10 * w_kg) + (6.25 * h_cm) - (5 * age)
if (gender == "M") {
return((common_equation + 5) * activity_coeff)
} else if (gender == "F") {
return((common_equation - 161) * activity_coeff)
}
}
我正在构建一些选项:
age <- seq.int(30,90)
h <- seq.int(150, 200)
w <- seq.int(40, 150)
activity <- c("sedentary", "light", "moderate", "active")
gender <- c("M", "F")
all_options <- expand.grid(age = age, h = h, w = w, activity = activity, gender = gender)
但是当我尝试 dplyr::mutate 上述函数的计算字段时,我得到了第一个计算 ok 和所有 NA:
mifflin_options <- all_options %>%
dplyr::mutate(mifflin_eq_calories = mifflin_equation(gender = gender,
w_kg = w,
h_cm = h,
age = age,
activity_type = activity))
我知道如果只有一个变量我应该使用 sapply
,但这里的解决方案是什么?
这里有一些选项可以帮助您获得预期的输出
library(dplyr)
library(purrr)
temp <- head(all_options)
1) rowwise
temp %>%
rowwise() %>%
mutate(mifflin_eq_calories = mifflin_equation(gender = gender,
w_kg = w,
h_cm = h,
age = age,
activity_type = activity))
2) pmap
temp %>% mutate(mifflin_eq_calories = pmap_dbl(
list(gender, w, h, age, activity), mifflin_equation))
3) 基础 R mapply
mapply(mifflin_equation, temp$gender, temp$w, temp$h, temp$age, temp$activity)
4) Vectorize
你的函数
new_fun <- Vectorize(mifflin_equation)
4a) 使用 mutate
申请
temp %>%
mutate(mifflin_eq_calories = new_fun(gender = gender,
w_kg = w,
h_cm = h,
age = age,
activity_type = activity))
4b) 或者直接
new_fun(temp$gender, temp$w, temp$h, temp$age, temp$activity)
5) data.table
library(data.table)
setDT(temp)[, ans:= mifflin_equation(gender, w, h, age, activity),by = 1:nrow(temp)]
我们可以使用 Map
来自 base R
temp <- head(all_options)
unlist(do.call(Map, c(f = mifflin_equation, temp)))
请指教,我有以下简单功能:
mifflin_equation <- function(gender = "M",
w_kg = 50,
h_cm = 180,
age = 40,
activity_type = "sedentary") {
activity_types <- c("sedentary", "light", "moderate", "active")
if (!(tolower(activity_type) %in% activity_types)) {
activity_type <- "sedentary"
}
activity_trans_table <- tibble(type = activity_types,
activity_coeff = c(1.2, 1.375,
1.55, 1.725))
activity_coeff <- activity_trans_table$activity_coeff[activity_trans_table$type == tolower(activity_type)]
common_equation <- (10 * w_kg) + (6.25 * h_cm) - (5 * age)
if (gender == "M") {
return((common_equation + 5) * activity_coeff)
} else if (gender == "F") {
return((common_equation - 161) * activity_coeff)
}
}
我正在构建一些选项:
age <- seq.int(30,90)
h <- seq.int(150, 200)
w <- seq.int(40, 150)
activity <- c("sedentary", "light", "moderate", "active")
gender <- c("M", "F")
all_options <- expand.grid(age = age, h = h, w = w, activity = activity, gender = gender)
但是当我尝试 dplyr::mutate 上述函数的计算字段时,我得到了第一个计算 ok 和所有 NA:
mifflin_options <- all_options %>%
dplyr::mutate(mifflin_eq_calories = mifflin_equation(gender = gender,
w_kg = w,
h_cm = h,
age = age,
activity_type = activity))
我知道如果只有一个变量我应该使用 sapply
,但这里的解决方案是什么?
这里有一些选项可以帮助您获得预期的输出
library(dplyr)
library(purrr)
temp <- head(all_options)
1) rowwise
temp %>%
rowwise() %>%
mutate(mifflin_eq_calories = mifflin_equation(gender = gender,
w_kg = w,
h_cm = h,
age = age,
activity_type = activity))
2) pmap
temp %>% mutate(mifflin_eq_calories = pmap_dbl(
list(gender, w, h, age, activity), mifflin_equation))
3) 基础 R mapply
mapply(mifflin_equation, temp$gender, temp$w, temp$h, temp$age, temp$activity)
4) Vectorize
你的函数
new_fun <- Vectorize(mifflin_equation)
4a) 使用 mutate
temp %>%
mutate(mifflin_eq_calories = new_fun(gender = gender,
w_kg = w,
h_cm = h,
age = age,
activity_type = activity))
4b) 或者直接
new_fun(temp$gender, temp$w, temp$h, temp$age, temp$activity)
5) data.table
library(data.table)
setDT(temp)[, ans:= mifflin_equation(gender, w, h, age, activity),by = 1:nrow(temp)]
我们可以使用 Map
来自 base R
temp <- head(all_options)
unlist(do.call(Map, c(f = mifflin_equation, temp)))