按列表对 data.frame 进行子集，并按行对每个部分应用函数答案

【问题标题】：Subset a data.frame by list and apply function on each part, by rows按列表对 data.frame 进行子集，并按行对每个部分应用函数
【发布时间】：2011-01-22 00:19:08
【问题描述】：

这似乎是一个典型的plyr 问题，但我有不同的想法。这是我要优化的功能（跳过for 循环）。

# dummy data
set.seed(1985)
lst <- list(a=1:10, b=11:15, c=16:20)
m <- matrix(round(runif(200, 1, 7)), 10)
m <- as.data.frame(m)


dfsub <- function(dt, lst, fun) {
    # check whether dt is `data.frame`
    stopifnot (is.data.frame(dt))
    # check if vectors in lst are "whole" / integer
    # vector elements should be column indexes
    is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)  abs(x - round(x)) < tol
    # fall if any non-integers in list
    idx <- rapply(lst, is.wholenumber)
    stopifnot(idx)
    # check for list length
    stopifnot(ncol(dt) == length(idx))
    # subset the data
    subs <- list()
    for (i in 1:length(lst)) {
            # apply function on each part, by row
            subs[[i]] <- apply(dt[ , lst[[i]]], 1, fun)
    }
    # preserve names
    names(subs) <- names(lst)
    # convert to data.frame
    subs <- as.data.frame(subs)
    # guess what =)
    return(subs)
}

现在是一个简短的演示......实际上，我将解释我主要打算做什么。我想通过list 对象中收集的向量对data.frame 进行子集化。由于这是心理研究中伴随数据处理的函数代码的一部分，您可以将m 视为人格问卷（10 个科目，20 个变量）的结果。列表中的向量包含定义问卷子量表（例如人格特征）的列索引。每个分量表由几个项目定义（data.frame 中的列）。如果我们假设每个分量表的分数只不过是行值的sum（或其他一些函数）（每个主题的问卷那部分的结果），你可以运行：

> dfsub(m, lst, sum)
    a  b  c
1  46 20 24
2  41 24 21
3  41 13 12
4  37 14 18
5  57 18 25
6  27 18 18
7  28 17 20
8  31 18 23
9  38 14 15
10 41 14 22

我看了一眼这个函数，我必须承认这个小循环根本没有破坏代码......但是，如果有更简单/有效的方法，请告诉我！

【问题讨论】：

标签： list r apply dataframe lapply

【解决方案1】：

加载plyr包后，替换

subs <- list()
    for (i in 1:length(lst)) {
            # apply function on each part, by row
            subs[[i]] <- apply(dt[ , lst[[i]]], 1, fun)
    }

与

subs <- llply(lst,function(x) apply(dt[,x],1,fun))

【讨论】：

感谢您的回复！好吧，llply 方法确实缩短了代码，但是之前的函数有一定的“杠杆作用”——它只依赖于base 包。我已经声明了一个微不足道的杠杆，因为我安装的第一个包是plyr 和reshape。
哦，我误会了！以为你想使用 plyr。你只需要使用 lapply 而不是 llply： subs
不，你没看错！这只是偏好问题...我发现我必须使用lapply...sapply 提供字符向量作为输出。

【解决方案2】：

我会采用不同的方法并将所有内容都保存为数据框，以便您可以使用合并和 ddply。我想您会发现这种方法更通用一些，并且更容易检查每个步骤是否正确执行。

# Convert everything to long data frames
m$id <- 1:nrow(m)

library(reshape)
obs <- melt(m, id = "id")
obs$variable <- as.numeric(gsub("V", "", obs$variable))

varinfo <- melt(lst)
names(varinfo) <- c("variable", "scale")

# Merge and summarise
obs <- merge(obs, varinfo, by = "variable")

ddply(obs, c("id", "scale"), summarise, 
  mean = mean(value), 
  sum = sum(value))

【讨论】：

【解决方案3】：

@Hadley，我检查了您的回复，因为它非常简单易记（除了它是更通用的解决方案之外）。但是，这是我的不那么长的脚本，它只需要 base 包（这是微不足道的，因为我在安装 R 之后安装了 plyr 和 reshape）。现在，这里是来源：

dfsub <- function(dt, lst, fun) {
        # check whether dt is `data.frame`
        stopifnot (is.data.frame(dt))
        # convert data.frame factors to numeric
        dt <- as.data.frame(lapply(dt, as.numeric))
        # check if vectors in lst are "whole" / integer
        # vector elements should be column indexes
        is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)  abs(x - round(x)) < tol
        # fall if any non-integers in list
        idx <- rapply(lst, is.wholenumber)
        stopifnot(idx)
        # check for list length
        stopifnot(ncol(dt) == length(idx))
        # subset the data
        subs <- list()
        for (i in 1:length(lst)) {
                # apply function on each part, by row
                subs[[i]] <- apply(dt[ , lst[[i]]], 1, fun)
        }
        names(subs) <- names(lst)
        # convert to data.frame
        subs <- as.data.frame(subs)
        # guess what =)
        return(subs)
}

【讨论】：

【解决方案4】：

对于您的具体示例，单行解决方案是 sapply(lst,function(x) rowSums(m[,x]))（尽管您可能会添加更多行来检查有效输入并输入列名）。

您还有其他更通用的应用吗？或者这可能是YAGNI 的情况？

【讨论】：