R: tăng tốc "nhóm theo" hoạt động

Question

Tôi có một mô phỏng có tổng hợp lớn và kết hợp các bước ngay ở giữa. Tôi prototyped quá trình này bằng cách sử dụng chức năng ddply() của plyr mà hoạt động tuyệt vời cho một tỷ lệ phần trăm lớn nhu cầu của tôi. Nhưng tôi cần bước tổng hợp này nhanh hơn vì tôi phải chạy mô phỏng 10K. Tôi đã mở rộng mô phỏng song song nhưng nếu bước này nhanh hơn thì tôi có thể giảm đáng kể số lượng nút cần thiết.

Dưới đây là một việc đơn giản hóa hợp lý về những gì tôi đang cố gắng để làm:

library(Hmisc) 

# Set up some example data 
year <- sample(1970:2008, 1e6, rep=T) 
state <- sample(1:50, 1e6, rep=T) 
group1 <- sample(1:6, 1e6, rep=T) 
group2 <- sample(1:3, 1e6, rep=T) 
myFact <- rnorm(100, 15, 1e6) 
weights <- rnorm(1e6) 
myDF <- data.frame(year, state, group1, group2, myFact, weights) 

# this is the step I want to make faster 
system.time(aggregateDF <- ddply(myDF, c("year", "state", "group1", "group2"), 
        function(df) wtd.mean(df$myFact, weights=df$weights) 
           ) 
      ) 

Tất cả các lời khuyên hoặc gợi ý được đánh giá cao!

Answer 1

Thay vì khung dữ liệu R bình thường, bạn có thể sử dụng một khung dữ liệu bất biến mà trả về con trỏ với bản gốc khi bạn tập hợp con và có thể nhanh hơn nhiều:

idf <- idata.frame(myDF) 
system.time(aggregateDF <- ddply(idf, c("year", "state", "group1", "group2"), 
    function(df) wtd.mean(df$myFact, weights=df$weights))) 

# user system elapsed 
# 18.032 0.416 19.250 

Nếu tôi đã viết một chức năng plyr tùy chỉnh chính xác với tình hình này, tôi muốn làm một cái gì đó như thế này:

system.time({ 
    ids <- id(myDF[c("year", "state", "group1", "group2")], drop = TRUE) 
    data <- as.matrix(myDF[c("myFact", "weights")]) 
    indices <- plyr:::split_indices(seq_len(nrow(data)), ids, n = attr(ids, "n")) 

    fun <- function(rows) { 
    weighted.mean(data[rows, 1], data[rows, 2]) 
    } 
    values <- vapply(indices, fun, numeric(1)) 

    labels <- myDF[match(seq_len(attr(ids, "n")), ids), 
    c("year", "state", "group1", "group2")] 
    aggregateDF <- cbind(labels, values) 
}) 

# user system elapsed 
# 2.04 0.29 2.33 

Thật nhanh hơn nhiều bởi vì nó tránh sao chép dữ liệu, chỉ giải nén các tập hợp con cần thiết cho mỗi tính khi nó được tính toán. Việc chuyển đổi dữ liệu thành dạng ma trận cho phép tăng tốc độ khác vì việc đặt ma trận nhanh hơn nhiều so với việc đặt khung dữ liệu.

Answer 2

Bạn đang sử dụng phiên bản mới nhất của plyr (lưu ý: điều này đã không làm cho nó cho tất cả các gương CRAN chưa)? Nếu vậy, bạn chỉ có thể chạy song song.

Dưới đây là ví dụ llply, nhưng giống nhau nên áp dụng đối với ddply:

x <- seq_len(20) 
    wait <- function(i) Sys.sleep(0.1) 
    system.time(llply(x, wait)) 
    # user system elapsed 
    # 0.007 0.005 2.005 

    library(doMC) 
    registerDoMC(2) 
    system.time(llply(x, wait, .parallel = TRUE)) 
    # user system elapsed 
    # 0.020 0.011 1.038 

Edit:

Vâng, cách tiếp cận lặp khác là tồi tệ hơn, vì vậy điều này có lẽ đòi hỏi hoặc là (a) C/Mã C++ hoặc (b) xem xét lại cơ bản hơn về cách bạn đang thực hiện nó. Tôi thậm chí không thử sử dụng by() vì điều đó rất chậm trong trải nghiệm của tôi.

groups <- unique(myDF[,c("year", "state", "group1", "group2")]) 
system.time(
aggregateDF <- do.call("rbind", lapply(1:nrow(groups), function(i) { 
    df.tmp <- myDF[myDF$year==groups[i,"year"] & myDF$state==groups[i,"state"] & myDF$group1==groups[i,"group1"] & myDF$group2==groups[i,"group2"],] 
    cbind(groups[i,], wtd.mean(df.tmp$myFact, weights=df.tmp$weights)) 
})) 
) 

aggregateDF <- data.frame() 
system.time(
for(i in 1:nrow(groups)) { 
    df.tmp <- myDF[myDF$year==groups[i,"year"] & myDF$state==groups[i,"state"] & myDF$group1==groups[i,"group1"] & myDF$group2==groups[i,"group2"],] 
    aggregateDF <- rbind(aggregateDF, data.frame(cbind(groups[i,], wtd.mean(df.tmp$myFact, weights=df.tmp$weights)))) 
} 
) 

Answer 3

tôi sẽ cấu với cơ sở R

g <- with(myDF, paste(year, state, group1, group2)) 
x <- with(myDF, c(tapply(weights * myFact, g, sum)/tapply(weights, g, sum))) 
aggregateDF <- myDF[match(names(x), g), c("year", "state", "group1", "group2")] 
aggregateDF$V1 <- x 

Trên máy tính của tôi phải mất 5sec so sánh với 67sec với mã gốc.

EDIT Chỉ cần phát hiện tốc độ gia tăng khoảng cách với rowsum chức năng:

g <- with(myDF, paste(year, state, group1, group2)) 
X <- with(myDF, rowsum(data.frame(a=weights*myFact, b=weights), g)) 
x <- X$a/X$b 
aggregateDF2 <- myDF[match(rownames(X), g), c("year", "state", "group1", "group2")] 
aggregateDF2$V1 <- x 

Phải mất 3 giây!

Answer 4

Tôi thường sử dụng một vector chỉ số với tapply khi chức năng được áp dụng có nhiều args vector:

system.time(tapply(1:nrow(myDF), myDF[c('year', 'state', 'group1', 'group2')], function(s) weighted.mean(myDF$myFact[s], myDF$weights[s]))) 
# user system elapsed 
# 1.36 0.08 1.44 

tôi sử dụng một wrapper đơn giản đó là tương đương nhưng ẩn chứa sự lộn xộn:

tmapply(list(myDF$myFact, myDF$weights), myDF[c('year', 'state', 'group1', 'group2')], weighted.mean) 

---

Đã chỉnh sửa để bao gồm tmapply để nhận xét bên dưới:

tmapply = function(XS, INDEX, FUN, ..., simplify=T) { 
    FUN = match.fun(FUN) 
    if (!is.list(XS)) 
    XS = list(XS) 
    tapply(1:length(XS[[1L]]), INDEX, function(s, ...) 
    do.call(FUN, c(lapply(XS, `[`, s), list(...))), ..., simplify=simplify) 
} 

Answer 5

Tiếp tục tăng tốc 2x và mã ngắn gọn hơn:

library(data.table) 
dtb <- data.table(myDF, key="year,state,group1,group2") 
system.time( 
    res <- dtb[, weighted.mean(myFact, weights), by=list(year, state, group1, group2)] 
) 
# user system elapsed 
# 0.950 0.050 1.007 

bài đầu tiên của tôi, vì vậy hãy thoải mái;)

---

Từ data.table v1.9.2, setDT chức năng được xuất khẩu mà sẽ chuyển đổi data.frame đến data.tablebằng cách tham chiếu (phù hợp với cách data.table parlance - tất cả các chức năng set* sửa đổi đối tượng theo tham chiếu). Điều này có nghĩa, không cần sao chép không cần thiết, và do đó nhanh chóng. Bạn có thể thời gian, nhưng nó sẽ là cẩu thả.

require(data.table) 
system.time({ 
    setDT(myDF) 
    res <- myDF[, weighted.mean(myFact, weights), 
      by=list(year, state, group1, group2)] 
}) 
# user system elapsed 
# 0.970 0.024 1.015 

Đây là như trái ngược với 1,264 giây với dung dịch OP của trên, nơi data.table(.) được sử dụng để tạo dtb.