R - Bessere Leistung für Summe mit mehreren Bedingungen

Question

Mit zwei Datenrahmen:

1. URLSMMG mit 374 Beobachtungen
2. pagesVisited mit 99120 Beobachtungen

ich die folgende Funktion sum alle Werte von pagesVisited verwenden die zwei Bedingungen erfüllen, wobei das Ergebnis in eine neue Spalte in URLSMMG:

gebracht wird

# Calculate pageviews from MMG 
for (i in 1:nrow(URLSMMG)) { 
     URLSMMG$pageviewsMMGClick[i] <- sum(pagesVisited[ 
     which(pagesVisited[,11] == URLSMMG$URLWithoutParameters[i] & 
     grepl(paste0("ic=", URLSMMG$Code[i]), pagesVisited$evar3) == TRUE),3]) 
} 

Messung der Ausführungszeit der Funktion, sagt die Funktion dauert etwa 4 Minuten zu beenden. Ich bin zufrieden mit dem Ergebnis, da die Ausgabe die erwartete ist, aber ich bin mir nicht sicher, ob ich die Berechnung mit der schnellsten Methode mache. Kennt jemand einen anderen Weg, dies in kürzerer Zeit zu tun?

Answer 1

sollte folgende viel schneller sein:

## temporary vectors 
pagesVisited11 <- pagesVisited[, 11] 
URLWithoutParameters <- URLSMMG$URLWithoutParameters 
Code <- URLSMMG$Code 
evar3 <- gsub("ic=", "", pagesVisited$evar3) 
pagesVisited3 <- pagesVisited[, 3] 
pageviewsMMGClick <- numeric(nrow(URLSMMG)) 

## only touch vector inside loop 
for (i in 1:nrow(URLSMMG)) { 
    cond1 <- pagesVisited11 == URLWithoutParameters[i] 
    cond2 <- grepl(Code[i], evar3) 
    pageviewsMMGClick[i] <- sum(pagesVisited3[cond1 & cond2]) 
    } 

## append new column to URLSMMG in the end 
URLSMMG$pageviewsMMGClick <- pageviewsMMGClick 

Kommentare:

1. Für eine maximale Speichereffizienz, nicht innerhalb einer Schleife nicht Datenrahmen berühren. Deshalb extrahiere ich alle relevanten Vektoren vor der Schleife und verwende nur Vektoren innerhalb der Schleife;
2. Ich habe die == TRUE und which entfernt, da es keine Notwendigkeit gibt;
3. Ich habe auch paste0 innerhalb der Schleife fallengelassen; stattdessen entfernte ich von evar3 außerhalb der Schleife. Auf diese Weise vermeiden Sie bei jeder Iteration das teure paste0.

Answer 2

Hier sind einige Variablen, in erster Linie aus Gründen der Klarheit, aber im Fall von pv_code einen Anruf aus einer Iteration Hissen so dass es einmal durchgeführt wird statt 100 von Zeiten.

pv_url <- pagesVisited[, 11] 
pv_code <- sub("ic=", "", pagesVisited$evar3) 
pv_click <- pagesVisited[, 3] 

Jede besuchte Seite gehört zu einer Gruppe

grp <- match(pv_url, URLSMMG$URLWithoutParameters) 

Wir dies ein Faktor machen, und beinhalten alle URLWithoutParameters als Ebenen. Dies macht den Code robust URLs, die erscheinen nicht in pv_url

grp <- factor(grp, levels=seq_len(nrow(URLSMMG))) 

Wir in einigen Zeilen nur interessiert sind

keep <- pv_code == URLSMMG$Code[grp] 

Wir würden jetzt gerne pv_click und Summe von Gruppe filtern

(die entsprechende Zeile im ursprünglichen Code URLSMMG$pageviewsMMGClick[i] <- ... kopiert den gesamten Datumsrahmen jedes Mal, wenn ein Zeilenelement aktualisiert wird, a nd ist sehr ineffizient; Es wäre besser, eine temporäre Variable click = integer(nrow(URLSMMG) vorzubelegen, während der Schleife click[i] <- ... zu füllen und URLSMMG einmal am Ende zu aktualisieren, oder einfach sapply() zu verwenden, anstatt sich über die Vorbelegung von Anzeigen zu sorgen.

Als Funktion haben wir

fun <- function(url, url_code, pv_url, pv_code, pv_click) { 
    stopifnot(!any(duplicated(url))) 
    grp <- factor(match(pv_url, url), levels=seq_along(url)) 
    keep <- pv_code == url_code[grp] 
    unname(sapply(split(pv_click[keep], grp[keep]), sum)) 
} 

Hier ist ein kurzer Test für Richtigkeit

url <-  c("A", "B", "C") 
url_code <- c(1, 1, 1) 

pv_url <- c("A", "A", "A", "C") 
pv_code <- c(1, 1, 2, 1) 
pv_click <- c(5, 6, 7, 8) 

mit Ausgang

> fun(url, url_code, pv_url, pv_code, pv_click) 
[1] 11 0 8 

Für Leistung, hier Daten von der gleichen Größe wie in der ursprüngliche Frage

url <-  as.character(1:374) 
url_code <- sample(3, 374, TRUE) 

pv_url <- sample(url, 99120, TRUE) 
pv_code <- sample(url_code, 99120, TRUE) 
pv_click <- rep(1, 99120) 

und das Timing

> system.time(xx <- fun(url, url_code, pv_url, pv_code, pv_click)) 
    user system elapsed 
    0.036 0.000 0.035 

Diese im Vergleich zum Original ein 10000X Beschleunigungs zu sein scheint.

Answer 3

Hier ist ein Ansatz basierend auf Datenmanipulationsoperationen anstelle von Schleifen. Das Paket data.table bietet erhebliche Beschleunigung bei der Arbeit mit großen Datenmengen.

Hinweis: Im Beispielcode nehme ich an, dass die Namen der Spalten 3 und 11 von pagesViewedclicks bzw. url sind.

library(data.table) 
library(stringi) 
library(dplyr) 

# use data.table for speed 
dt1 <- data.table(URLSMGG, key = "URLWithoutParameters") 
dt2 <- data.table(pagesVisited, key = "url") 

# generate the values used for the grepl-equivalent stri_detect_fixed 
dt1[, ic_code := paste0("ic=", Code)] 

viewsums <- dt2[dt1 # join the page data to the matching urls 
    ][stri_detect_fixed(evar3, ic_code), # keep rows where ic_code is found in evar3 
     list(views = sum(clicks)), by = "url"] # sum the clicks for each url 

# join the summed views to the url data 
URLSMGG <- left_join(URLSMGG, viewsums, by = c("URLWithoutParameters" = "url")) %>% 
    mutate(views = ifelse(is.na(views), 0, views)) 

Mit den gleichen Testdaten wie Martin Morgan, hier ist die Leistung dieses Ansatzes. Ich habe zwei verschiedene Szenarien, eine, wo die grepl-ähnliche Suche von evar3 erforderlich ist, und eine andere ohne es.

# preparing the testing data (succintly written by Martin Morgan) 
urls <-  as.character(1:374) 
url_code <- sample(1:3, 374, TRUE) 

pv_url <- sample(urls, 99120, TRUE) 
pv_code <- sample(url_code, 99120, TRUE) 
pv_click <- rep(1, 99120) 

# and the corresponding data.frames 
URLSMGG <- data.frame(URLWithoutParameters = urls, ic_code = url_code) 
pagesVisited <- data.frame(url = pv_url, evar3 = pv_code, clicks = pv_click) 

Die erste Implementierung, wo eine String-Suche durchgeführt wird:

f1 <- function() 
{ 
    # use data.table for speed 
    dt1 <- data.table(URLSMGG, key = "URLWithoutParameters") 
    dt2 <- data.table(pagesVisited, key = "url") 

    viewsums <- dt2[dt1 # join the page data to the matching urls 
     ][stri_detect_fixed(evar3, ic_code), # keep rows where ic_code is found in evar3 
      list(views = sum(clicks)), by = "url"] # sum the clicks for each url 

    # join the summed views to the url data 
    left_join(URLSMGG, viewsums, by = c("URLWithoutParameters" = "url")) %>% 
     mutate(views = ifelse(is.na(views), 0, views)) 
} 

Das zweite Szenario, in dem wir beide einfach direkt auf der URL und der Code kann mitmachen: die

f2 <- function() 
{ 
    # use data.table for speed 
    dt1 <- data.table(URLSMGG, key = c("URLWithoutParameters", "ic_code")) 
    dt2 <- data.table(pagesVisited, key = c("url", "evar3")) 

    # join the page data, matching urls and codes, and then sum clicks by url 
    viewsums <- dt2[dt1, list(views = sum(clicks)), by = "url"] 

    # join the summed views to the url data 
    left_join(URLSMGG, viewsums, by = c("URLWithoutParameters" = "url")) %>% 
     mutate(views = ifelse(is.na(views), 0, views)) 
} 

Und schließlich Leistung:

library(microbenchmark) 
microbenchmark(f1(), f2()) 
#  Unit: milliseconds 
#  expr  min  lq  mean median  uq  max neval 
#  f1() 61.148200 62.919882 64.68540 64.396362 66.160684 70.65989 100 
#  f2() 7.532806 7.784006 10.40422 7.979846 8.579847 175.83275 100 

(Diese Zeiten beziehen sich auf einen Intel Core i5-4460 und können oder können nicht mit anderen Ergebnissen vergleichbar sein)