R-迭代地应用变量列表的函数 [英] R - iteratively apply a function of a list of variables

问题描述

我的目标是创建一个函数，当该函数在一个数据帧的多个变量上循环时，将返回一个新的数据帧，其中包含每个变量每个级别的百分比和95％置信区间.

My goal is to create a function that, when looped over multiple variables of a data frame, will return a new data frame containing the percents and 95% confidence intervals for each level of each variable.

例如，如果我将此功能应用于mtcars数据帧中的"cyl"和"am"，我希望将其作为最终结果:

As an example, if I applied this function to "cyl" and "am" from the mtcars data frame, I would want this as the final result:

  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) 

到目前为止，我的功能似乎适用于单个变量；但是，我有两个问题希望社区能够为我提供帮助:

So, far I have function that seems to work for a single variable; however, I have two issues that I'm hoping the community can help me with:

1. 常规R修改我的代码.我仍然是R新手.我已经阅读了足够多的帖子，知道R爱好者通常不鼓励使用for循环，但是我仍然非常难以使用apply函数(在大多数情况下，它似乎是for循环的替代方法).

1. General R-ifying my code. I'm still an R novice. I've read enough posts to know that R enthusiasts generally discourage using for loops, but I still really struggle with using the apply functions (which seems to be the alternative to for loops in most cases).

将此函数应用于变量列表-产生一个单个数据框，其中包含该函数针对每个变量的每个级别返回的值.

Applying this function to a list of variables - resulting in a single data frame containing the returned values from the function for each level of each variable.

到目前为止，这里是我使用代码的地方:

Here's where I'm at with my code so far:

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)

感谢您提供的任何帮助或建议.

I appreciate any help or advice you have to offer.

推荐答案

您还可以使函数保持完整，并在其上使用lapply:

You can also keep the function mainly intact and use lapply over it:

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)

然后将它们全部合并为一个数据帧:

And combine them all into one data frame with:

lst <- lapply(vars, t1.props, data=mtcars)
do.call(rbind,lst)

数据

您必须将var和var.name分配简化为:

You must simplify the var and var.name assignments to:

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
}

这篇关于R-迭代地应用变量列表的函数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！