R：快速对数据框的子集执行操作，然后在没有内部函数的情况下重新聚合结果

时间：2016-01-28 14:35:33

标签： r dplyr

我们有一个非常大的数据框df，可以按因子分割。在此拆分创建的数据框的每个子集上，我们需要执行操作以增加该子集的行数，直到它为某个length。然后，我们rbind子集以获得更大版本的df。

有没有办法在不使用内部函数的情况下快速完成此操作？

假设我们的子集操作（在单独的.R文件中）是：

foo <- function(df) { magic }

我们想出了几种方法：

1）

df <- split(df, factor)
df <- lapply(df, foo)
rbindlist(df)

2）

assign('list.df', list(), envir=.GlobalEnv) 
assign('i', 1, envir=.GlobalEnv)

dplyr::group_by(df, factor)
dplyr::mutate(df, foo.list(df.col))
df <- rbindlist(list.df)
rm('list.df', envir=.GlobalEnv)
rm('i', envir=.GlobalEnv)

(In a separate file)
foo.list <- function(df.cols) {
    magic; 
    list.df[[i]] <<- magic.df
    i <<- i + 1
    return(dummy)
}

第一种方法的问题是时间问题。 lapply只需要很长时间才能真正理想（使用我们的数据集大约需要一个小时）。

第二种方法的问题是极其篡改用户全局环境的不良副作用。它明显更快，但如果可以的话，这是我们宁愿避免的。

我们也试过传入列表并计算变量，然后尝试使用父环境中的变量substitute它们（一种黑客来解决R缺乏传递引用）。

我们已经查看了一些可能相关的SO问题（R applying a function to a subset of a data frame，Calculations on subsets of a data frame，R: Pass by reference等等）但是没有一个问题能够解决我们的问题。

如果您想运行代码，可以复制和粘贴以下内容：

 x <- runif(n=10, min=0, max=3)
 y <- sample(x=10, replace=FALSE)
 factors <- runif(n=10, min=0, max=2)
 factors <- floor(factors)
 df <- data.frame(factors, x, y)

df现在看起来像这样（长度10）： Original df 

 ## We group by factor, then run foo on the groups.

 foo <- function(df.subset) {
   min <- min(df.subset$y)
   max <- max(df.subset$y)

   ## We fill out df.subset to have everything between the min and
   ## max values of y. Then we assign the old values of df.subset
   ## to the corresponding spots.

   df.fill <- data.frame(x=rep(0, max-min+1),
                         y=min:max,
                         factors=rep(df.subset$factors[1], max-min+1))
   df.fill$x[which(df.subset$y %in%(min:max))] <- df.subset$x
   df.fill
 }

所以我可以在第一种方法中使用我的示例代码来构建一个新的df（长度为18）： New df

4 个答案:

答案 0 :(得分：5)

使用data.table由于快速的功能，这不会花费很长时间。如果可以，请重写您的函数以使用特定变量。拆分应用组合处理可以提高性能：

library(data.table)
system.time(
df2 <- setDT(df)[,foo(df), factors]
)
#   user  system elapsed 
#   1.63    0.39    2.03

答案 1 :(得分：3)

使用data.table的另一种变体。首先获取min(y):max(y)部分，然后加入+更新：

require(data.table)
ans = setDT(df)[, .(x=0, y=min(y):max(y)), by=factors
              ][df, x := i.x, on=c("factors", "y")][]
ans
#     factors          x  y
#  1:       0 1.25104362  1
#  2:       0 0.16729068  2
#  3:       0 0.00000000  3
#  4:       0 0.02533907  4
#  5:       0 0.00000000  5
#  6:       0 0.00000000  6
#  7:       0 1.80547980  7
#  8:       1 0.34043937  3
#  9:       1 0.00000000  4
# 10:       1 1.51742163  5
# 11:       1 0.15709287  6
# 12:       1 0.00000000  7
# 13:       1 1.26282241  8
# 14:       1 2.88292354  9
# 15:       1 1.78573288 10

答案 2 :(得分：2)

皮埃尔和罗兰已经提供了很好的解决方案 如果案例不仅在时间上而且在内存中都具有可扩展性，您可以在多个远程R实例之间传播数据。
在大多数基本设置中，它只需要Rserve / RSclient，因此不需要非CRAN deps。

跨R实例传播数据

为了便于重现，下面的示例将在单个localhost计算机上启动两个R实例。您需要在远程计算机上启动Rserve节点才能实现真正的可伸缩性。 

# start R nodes
library(Rserve)
port = 6311:6312
invisible(sapply(port, function(port) Rserve(debug = FALSE, port = port, args = c("--no-save"))))

# populate data
set.seed(123)
x = runif(n=5e6,min=0, max=3)
y = sample(x=5e6,replace=FALSE)
factors = runif(n=5e6, min=0, max=2)
factors = floor(factors)
df = data.frame(factors, x, y)

# connect Rserve nodes
library(RSclient)
rscl = sapply(port, function(port) RS.connect(port = port))

# assign chunks to R nodes
sapply(seq_along(rscl), function(i) RS.assign(rscl[[i]], name = "x", value = df[df$factors == (i-1),]))

# assign magic function to R nodes
foo = function(df) df
sapply(rscl, RS.assign, name = "foo", value = foo)

远程计算机上的所有进程可以并行执行（使用wait=FALSE和RS.collect），这还可以减少计算时间。

使用lapply + RS.eval 

# sequentially
l = lapply(rscl, RS.eval, foo(x))
rbindlist(l)

# parallely
invisible(sapply(rscl, RS.eval, foo(x), wait=FALSE))
l = lapply(rscl, RS.collect)
rbindlist(l)

使用big.data.table::rscl.*

big.data.table包在RSclient::RS.*函数上提供了很少的包装器，允许它们接受R节点的连接列表。
他们没有以任何方式使用data.table，因此可以有效地应用于可以分块的data.frame，vector或任何R类型。下面的示例使用基本的data.frame。

library(big.data.table)

# sequentially
l = rscl.eval(rscl, foo(x), simplify=FALSE)
rbindlist(l)

# parallely
invisible(rscl.eval(rscl, foo(x), wait=FALSE))
l = rscl.collect(rscl, simplify=FALSE)
rbindlist(l)

使用big.data.table

此示例要求将节点上的数据存储为data.tables，但提供了一些方便的api和许多其他功能。 

library(big.data.table)
rscl.require(rscl, "data.table")
rscl.eval(rscl, is.data.table(setDT(x))) # is.data.table to suppress collection of `setDT` results

bdt = big.data.table(rscl = rscl)
# parallely by default
bdt[, foo(.SD), factors]
# considering we have data partitioned using `factors` field, the `by` is redundant in that case
bdt[, foo(.SD)]
# optionally use `[[` to access R nodes environment directly
bdt[[expr = foo(x)]]

清洁工作区

# disconnect
rscl.close(rscl)

# shutdown nodes started from R
l = lapply(setNames(nm = port), function(port) tryCatch(RSconnect(port = port), error = function(e) e, warning = function(w) w))
invisible(lapply(l, function(rsc) if(inherits(rsc, "sockconn")) RSshutdown(rsc)))

答案 3 :(得分：1)

我认为你的功能不按预期工作。它依赖于y被命令。

尝试使用data.table join和分组：

library(data.table)
setDT(df)
df2 <- df[, .SD[data.table(y=seq(.SD[, min(y)], .SD[, max(y)], by = 1)), .SD, 
                  on = "y"], #data.table join
                    by = factors] #grouping
df2[is.na(x), x:= 0]
setkey(df2, factors, y, x)
相关问题
最新问题