R - 迭代地应用变量列表的函数
R - iteratively apply a function of a list of variables
我的目标是创建一个函数，当循环遍历数据框的多个变量时，将 return 一个包含每个变量每个级别的百分比和 95% 置信区间的新数据框。
例如，如果我将此函数应用于 mtcars 数据框中的 "cyl" 和 "am"，我希望将其作为最终结果：
variable level ci.95
1 cyl 4 34.38 (19.50, 53.11)
2 cyl 6 21.88 (10.35, 40.45)
3 cyl 8 43.75 (27.10, 61.94)
4 am 0 59.38 (40.94, 75.5)
5 am 1 40.62 (24.50, 59.06)
到目前为止，我的函数似乎适用于单个变量；但是，我有两个问题希望社区可以帮助我解决：
常规 R 化我的代码。我仍然是R新手。我已经阅读了足够多的帖子，知道 R 爱好者通常不鼓励使用 for 循环，但我仍然很难使用 apply 函数（在大多数情况下这似乎是 for 循环的替代方法）。
将此函数应用于变量列表 - 生成一个数据框，其中包含每个变量每个级别的函数的 returned 值。
到目前为止我的代码是这样的：
t1.props <- function(x, data = NULL) {
# Grab dataframe and/or variable name
if(!missing(data)){
var <- data[,deparse(substitute(x))]
} else {
var <- x
}
# Grab variable name for use in ouput
var.name <- substitute(x)
# Omit observations with missing data
var.clean <- na.omit(var)
# Number of nonmissing observations
n <- length(var.clean)
# Grab levels of variable
levels <- sort(unique(var.clean))
# Create an empty data frame to store values
out <- data.frame(variable = NA,
level = NA,
ci.95 = NA)
# Estimate prop, se, and ci for each level of the variable
for(i in seq_along(levels)) {
prop <- paste0("prop", i)
se <- paste0("se", i)
log.prop <- paste0("log.trans", i)
log.se <- paste0("log.se", i)
log.l <- paste0("log.l", i)
log.u <- paste0("log.u", i)
lcl <- paste0("lcl", i)
ucl <- paste0("ucl", i)
# Find the proportion for each level of the variable
assign(prop, sum(var.clean == levels[i]) / n)
# Find the standard error for each level of the variable
assign(se, sd(var.clean == levels[i]) /
sqrt(length(var.clean == levels[i])))
# Perform a logit transformation of the original percentage estimate
assign(log.prop, log(get(prop)) - log(1 - get(prop)))
# Transform the standard error of the percentage to a standard error of its
# logit transformation
assign(log.se, get(se) / (get(prop) * (1 - get(prop))))
# Calculate the lower and upper confidence bounds of the logit
# transformation
assign(log.l,
get(log.prop) -
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
assign(log.u,
get(log.prop) +
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
# Finally, perform inverse logit transformations to get the confidence bounds
assign(lcl, exp(get(log.l)) / (1 + exp(get(log.l))))
assign(ucl, exp(get(log.u)) / (1 + exp(get(log.u))))
# Create a combined 95% CI variable for easy copy/paste into Word tables
ci.95 <- paste0(round(get(prop) * 100, 2), " ",
"(", sprintf("%.2f", round(get(lcl) * 100, 2)), ",", " ",
round(get(ucl) * 100, 2), ")")
# Populate the "out" data frame with values
out <- rbind(out, c(as.character(var.name), levels[i], ci.95))
}
# Remove first (empty) row from out
# But only in the first iteration
if (is.na(out[1,1])) {
out <- out[-1, ]
rownames(out) <- 1:nrow(out)
}
out
}
data(mtcars)
t1.props(cyl, mtcars)
感谢您提供的任何帮助或建议。
您正在使用的所有函数的好处是它们已经矢量化（sd 和 qt 除外，但您可以使用 [=14= 轻松地将它们矢量化以获得特定参数]).这意味着您可以将向量传递给它们而无需编写单个循环。我遗漏了你函数中处理输入准备和输出美化的部分。
t1.props <- function(var, data=mtcars) {
N <- nrow(data)
levels <- names(table(data[,var]))
count <- unclass(table(data[,var])) # counts
prop <- count / N # proportions
se <- sqrt(prop * (1-prop)/(N-1)) # standard errors of props.
lprop <- log(prop) - log(1-prop) # logged prop
lse <- se / (prop*(1-prop)) # logged se
stat <- Vectorize(qt, "df")(0.975, N-1) # tstats
llower <- lprop - stat*lse # log lower
lupper <- lprop + stat*lse # log upper
lower <- exp(llower) / (1 + exp(llower)) # lower ci
upper <- exp(lupper) / (1 + exp(lupper)) # upper ci
data.frame(variable=var,
level=levels,
perc=100*prop,
lower=100*lower,
upper=100*upper)
}
因此，唯一明确的 applying/looping 出现在您将函数应用于多个变量时，如下所示
## Apply your function to two variables
do.call(rbind, lapply(c("cyl", "am"), t1.props))
# variable level perc lower upper
# 4 cyl 4 34.375 19.49961 53.11130
# 6 cyl 6 21.875 10.34883 40.44691
# 8 cyl 8 43.750 27.09672 61.94211
# 0 am 0 59.375 40.94225 75.49765
# 1 am 1 40.625 24.50235 59.05775
就代码中的循环而言，它在效率方面并不是特别重要，但您可以看到当代码简洁时阅读起来会容易得多 - 应用函数提供了很多简单的一线解决方案。
我认为您的代码中最重要的更改是 assign 和 get 的使用。相反，您可以将变量存储在列表或其他数据结构中，并在需要时使用 setNames、names<- 或 names(...) <- 来命名组件。
您也可以保持功能基本完整并使用lapply覆盖它：
vars <- c("cyl", "am")
lapply(vars, t1.props, data=mtcars)
[[1]]
variable level ci.95
1 cyl 4 34.38 (19.50, 53.11)
2 cyl 6 21.88 (10.35, 40.45)
3 cyl 8 43.75 (27.10, 61.94)
[[2]]
variable level ci.95
1 am 0 59.38 (40.94, 75.5)
2 am 1 40.62 (24.50, 59.06)
并将它们全部组合成一个数据框：
lst <- lapply(vars, t1.props, data=mtcars)
do.call(rbind,lst)
数据
您必须将 var 和 var.name 作业简化为：
t1.props <- function(x, data = NULL) {
# Grab dataframe and/or variable name
if(!missing(data)){
var <- data[,x]
} else {
var <- x
}
# Grab variable name for use in ouput
var.name <- x
# Omit observations with missing data
var.clean <- na.omit(var)
# Number of nonmissing observations
n <- length(var.clean)
# Grab levels of variable
levels <- sort(unique(var.clean))
# Create an empty data frame to store values
out <- data.frame(variable = NA,
level = NA,
ci.95 = NA)
# Estimate prop, se, and ci for each level of the variable
for(i in seq_along(levels)) {
prop <- paste0("prop", i)
se <- paste0("se", i)
log.prop <- paste0("log.trans", i)
log.se <- paste0("log.se", i)
log.l <- paste0("log.l", i)
log.u <- paste0("log.u", i)
lcl <- paste0("lcl", i)
ucl <- paste0("ucl", i)
# Find the proportion for each level of the variable
assign(prop, sum(var.clean == levels[i]) / n)
# Find the standard error for each level of the variable
assign(se, sd(var.clean == levels[i]) /
sqrt(length(var.clean == levels[i])))
# Perform a logit transformation of the original percentage estimate
assign(log.prop, log(get(prop)) - log(1 - get(prop)))
# Transform the standard error of the percentage to a standard error of its
# logit transformation
assign(log.se, get(se) / (get(prop) * (1 - get(prop))))
# Calculate the lower and upper confidence bounds of the logit
# transformation
assign(log.l,
get(log.prop) -
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
assign(log.u,
get(log.prop) +
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
# Finally, perform inverse logit transformations to get the confidence bounds
assign(lcl, exp(get(log.l)) / (1 + exp(get(log.l))))
assign(ucl, exp(get(log.u)) / (1 + exp(get(log.u))))
# Create a combined 95% CI variable for easy copy/paste into Word tables
ci.95 <- paste0(round(get(prop) * 100, 2), " ",
"(", sprintf("%.2f", round(get(lcl) * 100, 2)), ",", " ",
round(get(ucl) * 100, 2), ")")
# Populate the "out" data frame with values
out <- rbind(out, c(as.character(var.name), levels[i], ci.95))
}
# Remove first (empty) row from out
# But only in the first iteration
if (is.na(out[1,1])) {
out <- out[-1, ]
rownames(out) <- 1:nrow(out)
}
out
}
我的目标是创建一个函数，当循环遍历数据框的多个变量时，将 return 一个包含每个变量每个级别的百分比和 95% 置信区间的新数据框。
例如，如果我将此函数应用于 mtcars 数据框中的 "cyl" 和 "am"，我希望将其作为最终结果：
variable level ci.95
1 cyl 4 34.38 (19.50, 53.11)
2 cyl 6 21.88 (10.35, 40.45)
3 cyl 8 43.75 (27.10, 61.94)
4 am 0 59.38 (40.94, 75.5)
5 am 1 40.62 (24.50, 59.06)
到目前为止，我的函数似乎适用于单个变量；但是，我有两个问题希望社区可以帮助我解决：
常规 R 化我的代码。我仍然是R新手。我已经阅读了足够多的帖子，知道 R 爱好者通常不鼓励使用
for循环，但我仍然很难使用 apply 函数（在大多数情况下这似乎是for循环的替代方法）。将此函数应用于变量列表 - 生成一个数据框，其中包含每个变量每个级别的函数的 returned 值。
到目前为止我的代码是这样的：
t1.props <- function(x, data = NULL) {
# Grab dataframe and/or variable name
if(!missing(data)){
var <- data[,deparse(substitute(x))]
} else {
var <- x
}
# Grab variable name for use in ouput
var.name <- substitute(x)
# Omit observations with missing data
var.clean <- na.omit(var)
# Number of nonmissing observations
n <- length(var.clean)
# Grab levels of variable
levels <- sort(unique(var.clean))
# Create an empty data frame to store values
out <- data.frame(variable = NA,
level = NA,
ci.95 = NA)
# Estimate prop, se, and ci for each level of the variable
for(i in seq_along(levels)) {
prop <- paste0("prop", i)
se <- paste0("se", i)
log.prop <- paste0("log.trans", i)
log.se <- paste0("log.se", i)
log.l <- paste0("log.l", i)
log.u <- paste0("log.u", i)
lcl <- paste0("lcl", i)
ucl <- paste0("ucl", i)
# Find the proportion for each level of the variable
assign(prop, sum(var.clean == levels[i]) / n)
# Find the standard error for each level of the variable
assign(se, sd(var.clean == levels[i]) /
sqrt(length(var.clean == levels[i])))
# Perform a logit transformation of the original percentage estimate
assign(log.prop, log(get(prop)) - log(1 - get(prop)))
# Transform the standard error of the percentage to a standard error of its
# logit transformation
assign(log.se, get(se) / (get(prop) * (1 - get(prop))))
# Calculate the lower and upper confidence bounds of the logit
# transformation
assign(log.l,
get(log.prop) -
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
assign(log.u,
get(log.prop) +
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
# Finally, perform inverse logit transformations to get the confidence bounds
assign(lcl, exp(get(log.l)) / (1 + exp(get(log.l))))
assign(ucl, exp(get(log.u)) / (1 + exp(get(log.u))))
# Create a combined 95% CI variable for easy copy/paste into Word tables
ci.95 <- paste0(round(get(prop) * 100, 2), " ",
"(", sprintf("%.2f", round(get(lcl) * 100, 2)), ",", " ",
round(get(ucl) * 100, 2), ")")
# Populate the "out" data frame with values
out <- rbind(out, c(as.character(var.name), levels[i], ci.95))
}
# Remove first (empty) row from out
# But only in the first iteration
if (is.na(out[1,1])) {
out <- out[-1, ]
rownames(out) <- 1:nrow(out)
}
out
}
data(mtcars)
t1.props(cyl, mtcars)
感谢您提供的任何帮助或建议。
您正在使用的所有函数的好处是它们已经矢量化（sd 和 qt 除外，但您可以使用 [=14= 轻松地将它们矢量化以获得特定参数]).这意味着您可以将向量传递给它们而无需编写单个循环。我遗漏了你函数中处理输入准备和输出美化的部分。
t1.props <- function(var, data=mtcars) {
N <- nrow(data)
levels <- names(table(data[,var]))
count <- unclass(table(data[,var])) # counts
prop <- count / N # proportions
se <- sqrt(prop * (1-prop)/(N-1)) # standard errors of props.
lprop <- log(prop) - log(1-prop) # logged prop
lse <- se / (prop*(1-prop)) # logged se
stat <- Vectorize(qt, "df")(0.975, N-1) # tstats
llower <- lprop - stat*lse # log lower
lupper <- lprop + stat*lse # log upper
lower <- exp(llower) / (1 + exp(llower)) # lower ci
upper <- exp(lupper) / (1 + exp(lupper)) # upper ci
data.frame(variable=var,
level=levels,
perc=100*prop,
lower=100*lower,
upper=100*upper)
}
因此，唯一明确的 applying/looping 出现在您将函数应用于多个变量时，如下所示
## Apply your function to two variables
do.call(rbind, lapply(c("cyl", "am"), t1.props))
# variable level perc lower upper
# 4 cyl 4 34.375 19.49961 53.11130
# 6 cyl 6 21.875 10.34883 40.44691
# 8 cyl 8 43.750 27.09672 61.94211
# 0 am 0 59.375 40.94225 75.49765
# 1 am 1 40.625 24.50235 59.05775
就代码中的循环而言，它在效率方面并不是特别重要，但您可以看到当代码简洁时阅读起来会容易得多 - 应用函数提供了很多简单的一线解决方案。
我认为您的代码中最重要的更改是 assign 和 get 的使用。相反，您可以将变量存储在列表或其他数据结构中，并在需要时使用 setNames、names<- 或 names(...) <- 来命名组件。
您也可以保持功能基本完整并使用lapply覆盖它：
vars <- c("cyl", "am")
lapply(vars, t1.props, data=mtcars)
[[1]]
variable level ci.95
1 cyl 4 34.38 (19.50, 53.11)
2 cyl 6 21.88 (10.35, 40.45)
3 cyl 8 43.75 (27.10, 61.94)
[[2]]
variable level ci.95
1 am 0 59.38 (40.94, 75.5)
2 am 1 40.62 (24.50, 59.06)
并将它们全部组合成一个数据框：
lst <- lapply(vars, t1.props, data=mtcars)
do.call(rbind,lst)
数据
您必须将 var 和 var.name 作业简化为：
t1.props <- function(x, data = NULL) {
# Grab dataframe and/or variable name
if(!missing(data)){
var <- data[,x]
} else {
var <- x
}
# Grab variable name for use in ouput
var.name <- x
# Omit observations with missing data
var.clean <- na.omit(var)
# Number of nonmissing observations
n <- length(var.clean)
# Grab levels of variable
levels <- sort(unique(var.clean))
# Create an empty data frame to store values
out <- data.frame(variable = NA,
level = NA,
ci.95 = NA)
# Estimate prop, se, and ci for each level of the variable
for(i in seq_along(levels)) {
prop <- paste0("prop", i)
se <- paste0("se", i)
log.prop <- paste0("log.trans", i)
log.se <- paste0("log.se", i)
log.l <- paste0("log.l", i)
log.u <- paste0("log.u", i)
lcl <- paste0("lcl", i)
ucl <- paste0("ucl", i)
# Find the proportion for each level of the variable
assign(prop, sum(var.clean == levels[i]) / n)
# Find the standard error for each level of the variable
assign(se, sd(var.clean == levels[i]) /
sqrt(length(var.clean == levels[i])))
# Perform a logit transformation of the original percentage estimate
assign(log.prop, log(get(prop)) - log(1 - get(prop)))
# Transform the standard error of the percentage to a standard error of its
# logit transformation
assign(log.se, get(se) / (get(prop) * (1 - get(prop))))
# Calculate the lower and upper confidence bounds of the logit
# transformation
assign(log.l,
get(log.prop) -
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
assign(log.u,
get(log.prop) +
qt(.975, (length(var.clean == levels[i]) - 1)) * get(log.se))
# Finally, perform inverse logit transformations to get the confidence bounds
assign(lcl, exp(get(log.l)) / (1 + exp(get(log.l))))
assign(ucl, exp(get(log.u)) / (1 + exp(get(log.u))))
# Create a combined 95% CI variable for easy copy/paste into Word tables
ci.95 <- paste0(round(get(prop) * 100, 2), " ",
"(", sprintf("%.2f", round(get(lcl) * 100, 2)), ",", " ",
round(get(ucl) * 100, 2), ")")
# Populate the "out" data frame with values
out <- rbind(out, c(as.character(var.name), levels[i], ci.95))
}
# Remove first (empty) row from out
# But only in the first iteration
if (is.na(out[1,1])) {
out <- out[-1, ]
rownames(out) <- 1:nrow(out)
}
out
}