困難的數據操作來填充R數據框中的值

我有一個相當難以矢量化/加速問題的手。我能夠用一個可以縮放的嵌套for循環來解決這個問題。我正在使用的數據是NBA擁有數據，我正在分析它在多個NBA賽季（100K-1M）的行中，這在我的嵌套循環中非常緩慢（多分鐘）。我創建的測試數據突出問題：困難的數據操作來填充R數據框中的值

mydf = data.frame(id1 = c(100, 100, 100, 150, 150, 150), 
       id2 = c(110, 110, 110, 122, 122, 122), 
       P1 = c(1, 1, 1, 1, 2, 2), 
       P2 = c(2, 2, 2, 3, 3, 3), 
       O1 = c(4, 4, 4, 4, 4, 4), 
       O2 = c(5, 5, 6, 6, 6, 6), 
       A1 = 0, 
       A2 = 0, 
       A3 = 0, 
       A4 = 0, 
       A5 = 0, 
       A6 = 0)

有6個獨立用戶在該數據幀，（1-6），以及它們的ID出現在P1，P2，O1，O2和列。每個用戶也獲得自己的專欄，（A1-A6）。每當用戶在P1或P2列中出現在一行中時，它的相應列就會得到1.每當用戶出現在列O1或O2中的一行中時，它的相應列就會得到-1。我的for循環解決這個問題如下：

for (i in 1:nrow(mydf)) { 
    for (j in 3:4) { 
    tmp = paste0("A",as.character(mydf[i,j])) 
    mydf[i, which(colnames(mydf) == tmp)] = 1 
    } 

    for (j in 5:6) { 
    tmp = paste0("A",as.character(mydf[i,j])) 
    mydf[i, which(colnames(mydf) == tmp)] = -1 
    } 
}

我的實際數據幀具有P1-P5，O1-O5，大約300獨特的玩家ID。有關我如何加快速度的任何想法？

謝謝！

來源

2017-09-02 Canovice

關於快兩倍，你的版本對樣本數據集;不足之處是你需要指定的玩家

for (i in 1:6) { 
    mydf[paste0("A", i)] <- (i==mydf$P1 | i==mydf$P2) * 1 - 1* 
            (i==mydf$O1 | i==mydf$O2) 
}

這僅僅是一個快一點的樣品，數量卻是更容易適應不同的編號P/O列：

playercols <- function(mydf, nplayers, plus, minus) { 
    for (i in 1:nplayers) { 
    mydf[paste0("A", i)] <- rowSums(i==mydf[, plus]) - 
     rowSums(i==mydf[, minus]) 
    } 
    mydf 
} 

playercols(mydf, 6, 3:4, 5:6)

來源

2017-09-02 10:20:35

注意，我不太確定如果一個玩家ID在多個P/O列中，預期結果如何。第一個版本的最大值爲1，任何負值和正值都會產生0.第二個版本將所有+/- 1加起來。 –

嘿克里斯，感謝這個幫助。它看起來像第一種方法應該有單槓|而不是雙槓||。雙線條返回一個值，而它們應該爲循環的每次迭代返回一個值向量（因爲你的循環用每個循環填充整個列） - 我已經用單條線編輯了上面的代碼來反映這一點。 – Canovice

另外，它看起來像playercols函數更好的出於某種原因，當我添加兩個閉合花括號之間的返回（mydf）。 – Canovice

根據您的樣本數據，這應該工作：

library(dplyr); library(tidyr); library(tibble) 

mydf.calculated <- mydf %>% 

    # make row names explicit so that we can join back by row later 
    rownames_to_column("row.id") %>% 
    select(row.id, starts_with("P"), starts_with("O")) %>% 

    # convert to long format & define calculation based on whether P or O 
    gather(operation, A, -row.id) %>% 
    mutate(calculation = ifelse(grepl("P", operation), 1, -1)) %>% 

    # if there are multiple P and/or O operations on the same user in the same row, 
    # collapse into final calculated result 
    group_by(row.id, A) %>% 
    summarise(calculation = sum(calculation)) %>% 
    ungroup() %>% 

    # spread calculated results to respective user columns 
    mutate(A = paste0("A", A)) %>% 
    spread(A, calculation, fill = 0) %>% 

    # sort in original row order 
    arrange(row.id) %>% select(-row.id) 

# combine results 
cbind(mydf %>% select(-starts_with("A")), 
     mydf.calculated) 

    id1 id2 P1 P2 O1 O2 A1 A2 A3 A4 A5 A6 
1 100 110 1 2 4 5 1 1 0 -1 -1 0 
2 100 110 1 2 4 5 1 1 0 -1 -1 0 
3 100 110 1 2 4 6 1 1 0 -1 0 -1 
4 150 122 1 3 4 6 1 0 1 -1 0 -1 
5 150 122 2 3 4 6 0 1 1 -1 0 -1 
6 150 122 2 3 4 6 0 1 1 -1 0 -1

來源

2017-09-02 05:53:52

不是特別有效，但這個工程：

cA <- col(mydf[,7:12]) 
mydf[,7:12] <- (cA==mydf$P1)+(cA==mydf$P2)-(cA==mydf$O1)-(cA==mydf$O2) 

mydf 
    id1 id2 P1 P2 O1 O2 A1 A2 A3 A4 A5 A6 
1 100 110 1 2 4 5 1 1 0 -1 -1 0 
2 100 110 1 2 4 5 1 1 0 -1 -1 0 
3 100 110 1 2 4 6 1 1 0 -1 0 -1 
4 150 122 1 3 4 6 1 0 1 -1 0 -1 
5 150 122 2 3 4 6 0 1 1 -1 0 -1 
6 150 122 2 3 4 6 0 1 1 -1 0 -1

來源

2017-09-02 10:12:25

感謝分享 - 我應該在我的例子中指出，在我的實際數據中，用戶ID不是順序的。我的例子使用1-6，但我的數據是一個隨機的400 ID在1 - 5000範圍內的所有地方。我會嘗試編輯你的代碼來反映這一點。 – Canovice

@Canovice - 我剛剛添加了這個應該解決非順序ID問題的修改版本。 – www

測量了其他答案的運行時間後，這可能是最快的了。這是@ Glen_b的回答修改後的版本這是靈活的非順序編號：

vals <- gsub("^A","",names(mydf)[grep("^A",names(mydf))]), 
cA <- data.frame(sapply(vals,function(i) rep(i,length(vals)))), 
mydf[,grep("A",names(mydf))] <- (cA==mydf$P1)+(cA==mydf$P2)-(cA==mydf$O1)-(cA==mydf$O2)

輸出：

id1 id2 P1 P2 O1 O2 A1 A7 A3 A8 A5 A10 
1 100 110 1 7 10 5 1 1 0 0 -1 -1 
2 100 110 1 7 10 5 1 1 0 0 -1 -1 
3 100 110 5 7 1 8 -1 1 0 -1 1 0 
4 150 122 1 10 7 8 1 -1 0 -1 0 1 
5 150 122 3 3 5 7 0 -1 2 0 -1 0 
6 150 122 3 8 3 5 0 0 0 1 -1 0

這是我編輯以包括非順序編號的樣本數據：

mydf = data.frame(id1 = c(100, 100, 100, 150, 150, 150), 
       id2 = c(110, 110, 110, 122, 122, 122), 
       P1 = c(1, 1, 5, 1, 3, 3), 
       P2 = c(7, 7, 7, 10, 3, 8), 
       O1 = c(10, 10, 1, 7, 5, 3), 
       O2 = c(5, 5, 8, 8, 7, 5), 
       A1 = 0, 
       A7 = 0, 
       A3 = 0, 
       A8 = 0, 
       A5 = 0, 
       A10 = 0)

要測量運行時間，可以使用類似microbenchmark的軟件包：

require(microbenchmark) 

microbenchmark(
    vals <- gsub("^A","",names(mydf)[grep("^A",names(mydf))]), 
    cA <- data.frame(sapply(vals,function(i) rep(i,length(vals)))), 
    mydf[,grep("A",names(mydf))] <- (cA==mydf$P1)+(cA==mydf$P2)-(cA==mydf$O1)-(cA==mydf$O2) 
) 

Unit: microseconds 
    min  lq  mean median  uq  max neval cld 
    19.263 27.4365 44.48546 37.4500 48.158 150.556 100 a 
460.698 555.1930 869.30677 692.5255 1004.787 3343.197 100 b 
1378.804 1656.6080 2815.49635 2140.1545 3216.846 8664.538 100 c

來源

2017-09-04 02:14:16 www

困難的數據操作來填充R數據框中的值

回答

相關問題