Manipulation de données difficile pour remplir des valeurs dans une trame R

Question

J'ai ce qui semble être un problème assez difficile à vectoriser/accélérer. Je suis capable de résoudre le problème avec une boucle forcée imbriquée qui évolue lentement. Les données avec lesquelles je travaille sont les données de possession de la NBA, et je les analyse sur plusieurs lignes de la NBA (100K - 1M), ce qui est très lent (plusieurs minutes) dans ma boucle imbriquée. J'ai créé des données de test pour mettre en évidence le problème:

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) 

Il y a 6 utilisateurs uniques dans cette trame de données, (1-6), et leurs papiers d'identité apparaissent dans les colonnes P1, P2, O1 et O2. Chaque utilisateur a également sa propre colonne (A1-A6). Chaque fois qu'un utilisateur apparaît dans une rangée dans les colonnes P1 ou P2, sa colonne respective obtient un 1. Chaque fois qu'un utilisateur apparaît dans une rangée dans les colonnes O1 ou O2, sa colonne respective obtient un -1. Mon boucle for pour résoudre ce problème est la suivante:

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 
    } 
} 

Mon dataframe réelle a P1-P5, O1-O5 et environ 300 ID de joueur uniques. Des pensées sur comment je peux accélérer cela?

Merci!

Answer 1

deux fois plus vite que votre version sur l'ensemble d'échantillons de données; l'inconvénient est que vous devez spécifier le nombre de joueurs

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

Ceci est seulement un peu plus vite sur l'échantillon, mais il est plus facile à adapter à différents nombres de colonnes 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) 

Answer 2

Sur la base de données d'échantillons, cela devrait fonctionner:

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 

Answer 3

Pas particulièrement efficace mais cela fonctionne:

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 

Answer 4

Après avoir mesuré les temps d'exécution des autres réponses, cela pourrait être le plus rapide encore. Il est une version modifiée de la réponse de @ Glen_b qui est flexible pour ID non séquentielles:

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) 

Sortie:

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 

Voici les données de l'échantillon I modifié pour inclure les ID non séquentielles:

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) 

Pour mesurer le temps d'exécution, vous pouvez utiliser un package comme 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