Dołącz do tabeli danych przez próbkowanie

Question

Mam kilka dużych zestawów danych, które próbuję połączyć. Stworzyłem zabawny przykład tego, co chcę robić. Mam trzy tabele:

require(data.table) 
set.seed(151) 
x <- data.table(a=1:100000) 
y <- data.table(b=letters[1:20],c=sample(LETTERS[1:4])) 
proportion <- data.table(expand.grid(a=1:100000,c=LETTERS[1:4])) 
proportion[,prop:=rgamma(4,shape = 1),by=a] 
proportion[,prop:=prop/sum(prop),by=a] 

Trzy stoły są x, y i proportion. Dla każdego elementu w x chcę pobrać próbkę z całej tabeli y używając prawdopodobieństw z tabeli proportion i połączyć je w inną tabelę. Metoda że wymyśliłem to:

temp <- setkey(setkey(x[,c(k=1,.SD)],k)[y[,c(k=1,.SD)],allow.cartesian=TRUE][,k:=NULL],a,c) 
temp <- temp[setkey(proportion,a,c)][,prop:=prop/.N,by=.(a,c)] # Uniform distribution within the same 'c' column group 
chosen_pairs <- temp[,.SD[sample(.N,5,replace=FALSE,prob = prop)],by=a] 

Ale ta metoda jest intensywnie wykorzystujących pamięć i powolny, ponieważ cross-łączy dwa tabeli, a potem z niej próbkę. Czy istnieje sposób na wykonanie tego zadania w sposób efektywny (pamięć i czas)?

Answer 1

Napotkałem podobny problem w pytaniu this. ja owinięty swoje rozwiązanie do funkcji dla lepszego porównania:

goreF <- function(x,y,proportion){ 
    temp <- setkey(setkey(x[, c(k = 1, .SD)], k)[y[,c(k = 1, .SD)], 
            allow.cartesian = TRUE][, k := NULL], 
      a, c) 
    temp <- temp[setkey(proportion, a, c)][, prop := prop/.N, by = .(a, c)] 
    chosen_pairs <- temp[, .SD[sample(.N, 5, replace = FALSE, prob = prop)], 
        by = a] 
    chosen_pairs 
} 

moje podejście:

myFunction <- function(x, y, proportion){ 
    temp <- setkey(setkey(x[, c(k = 1, .SD)], k)[y[,c(k = 1, .SD)], 
              allow.cartesian = TRUE][, k := NULL], 
      a, c) 
    temp <- temp[setkey(proportion, a, c)][, prop := prop/.N, by = .(a, c)] 
    chosen_pairs <- temp[, sample(.I, 5, replace = FALSE, prob = prop), by = a] 
    indexes <- chosen_pairs[[2]] 
    temp[indexes] 
} 

require(rbenchmark) 
benchmark(myFunction(x, y, proportion), goreF(x, y, proportion), 
     replications = 1, 
     columns = c("test", "replications", "elapsed", "relative", 
        "user.self", "sys.self")) 
          test replications elapsed relative user.self sys.self 
2  goreF(x, y, proportion)   1 19.83 21.323  19.35  0.13 
1 myFunction(x, y, proportion)   1 0.93 1.000  0.86  0.08 

Może tam można znaleźć więcej ulepszeń, będę aktualizować, jeśli znaleziono żadnych. Pierwsze dwie operacje wydają się zbyt skomplikowane, może można je skrócić, ale ponieważ nie widziałem, że mają wpływ na czasy obliczeń, nie przepisałem ich.

Aktualizacja:

Jak wskazano w pytaniu wspomniałem na początku, można wpaść w kłopoty z myFunction, jeśli grupy będzie zawierać tylko jeden element. Więc zmodyfikowałem to na podstawie komentarzy z tego posta.

myFunction2 <- function(x, y, proportion){ 
    temp <- setkey(setkey(x[, c(k = 1, .SD)], k)[y[,c(k = 1, .SD)], 
               allow.cartesian = TRUE][, k := NULL], 
       a, c) 
    temp <- temp[setkey(proportion, a, c)][, prop := prop/.N, by = .(a, c)] 
    indexes <- temp[, .I[sample(.N, 5, replace = T, prob = prop)], by = a] 
    indexes <- indexes[[2]] 
    temp[indexes] 
} 

benchmark(myFunction(x, y, proportion), myFunction2(x, y, proportion), 
      replications = 5, 
      columns = c("test", "replications", "elapsed", "relative", 
         "user.self", "sys.self")) 

          test replications elapsed relative user.self sys.self 
1 myFunction(x, y, proportion)   5 6.61 1.064  6.23  0.36 
2 myFunction2(x, y, proportion)   5 6.21 1.000  5.71  0.26 

Widzimy marginalną poprawę prędkości.