Zusammenfügen aller Kombinationen einer Spalte aus einem data.frame mit allen Kombinationen einer Spalte eines anderen data.frames basierend auf einer Bedingung

Question

Ich brauche etwas Weisheit!

Ich habe zwei Datenrahmen, wie:

test1 <- data.frame(let = replicate(100, paste(sample(LETTERS[1:12] , 3) , collapse ="") ) , num = sample(1:500 , 100 , replace = FALSE)) 
test2 <- data.frame(let = replicate(100, paste(sample(LETTERS[13:26] , 4) , collapse ="") ) , num = sample(1:500 , 100 , replace = FALSE)) 

head(test1) 
# let num 
# 1 KDA 430 
# 2 IHB 41 
# 3 GAB 473 
# 4 HKJ 335 
# 5 LCK 261 
# 6 EIK 500 

head(test2) 
# let num 
# 1 ZUYW 153 
# 2 PRNW 263 
# 3 OTQS 355 
# 4 NYRW 87 
# 5 ZYST 365 
# 6 TXRN 287 

Nun, ich alle Kombinationen von Zeichenketten aus test1 (dh test1 $ lassen) mit allen Kombinationen von Strings von test2 einfügen möchten, aber nur, wenn die Differenz test1 $ num und test2 $ num ist < = 100.

eine Möglichkeit, dies zu tun ist:

test.merg <- NULL 
i <- 1; j <- 1 
for(i in 1:dim(test1)[1]) { 
    for(j in 1:dim(test2)[1] ) { 
    if(abs(test1[i,]$num - test2[j,]$num) <= 100 ){ 
     test.merg <- c(test.merg ,paste(test1[i,]$let , test2[j,]$let , sep="." )) 
     } 
    j <- j+ 1 
    } 
    i <- i+ 1 
} 
head(test.merg) 
#[1] "KDA.OTQS" "KDA.ZYST" "KDA.TVRX" "KDA.VYRQ" "KDA.XRQS" "KDA.WSUR" 

Dies funktioniert gut, aber natürlich meine tatsächliche Datenmenge unterscheidet sich ein Und es dauert sehr lange, dies zu tun. Ich bin mir sicher, dass es einen effizienteren Weg dafür geben muss. Versuchte die Familie Funktionen anwenden verwenden, aber der einzige Weg, ich denken konnte, sie zu verwenden ist:

test1.1 <- paste(test1$let , test1$num ,sep = "_") 
test2.1 <- paste(test2$let , test2$num ,sep = "_") 

test.merg.1 <- unlist(lapply(test1.1 , FUN = function(x) {lapply( 
    test2.1 , FUN = function(y) { 
    if(abs(as.numeric(str_split_fixed(x , "_" , 2)[,2]) - as.numeric(str_split_fixed(y , "_" , 2)[,2])) <= 100){ 
     paste(str_split_fixed(x , "_" , 2)[,1] , str_split_fixed(y , "_" , 2)[,1], sep = ".") 
    } 
}) 
}) 
) 

head(test.merg.1) 
# [1] "KDA.OTQS" "KDA.ZYST" "KDA.TVRX" "KDA.VYRQ" "KDA.XRQS" "KDA.WSUR" 

Dies schon die Zeit, die ziemlich viel, fast 1/4., Aber es wäre schön, wenn es genommen reduziert kann effizienter gemacht werden. Ganz zu schweigen davon, wenn es einen komplett anderen und besseren Weg gibt, dann wird es fantastisch.

Vielen Dank!

Answer 1

Eine Kombination aus outer Aussagen hier arbeiten

outer(test1$let, test2$let, "paste", sep=".")[abs(outer(test1$num, test2$num, "-")) <= 100] 

# [1] "DEF.VOXZ" "FHJ.VOXZ" "CHB.VOXZ" "JBH.VOXZ" etc 

Reproduzierbare Daten

set.seed(1) 
test1 <- data.frame(let = replicate(100, paste(sample(LETTERS[1:12] , 3) , collapse ="") ) , num = sample(1:500 , 100 , replace = FALSE)) 
test2 <- data.frame(let = replicate(100, paste(sample(LETTERS[13:26] , 4) , collapse ="") ) , num = sample(1:500 , 100 , replace = FALSE)) 

Benchmark

OP <- function() { 
test.merg <- NULL 
i <- 1; j <- 1 
for(i in 1:dim(test1)[1]) { 
    for(j in 1:dim(test2)[1] ) { 
    if(abs(test1[i,]$num - test2[j,]$num) <= 100 ){ 
     test.merg <- c(test.merg ,paste(test1[i,]$let , test2[j,]$let , sep="." )) 
     } 
    j <- j+ 1 
    } 
    i <- i+ 1 
} 
head(test.merg) 
} 

myfun <- function() { 
outer(test1$let, test2$let, "paste", sep=".")[abs(outer(test1$num, test2$num, "-")) <= 100] 
} 

library(microbenchmark) 
microbenchmark(OP(), myfun(), times=10L) 

Unit: milliseconds 
    expr  min   lq  mean  median   uq  max neval 
    OP() 4877.0017 4928.447303 5014.859718 5017.653519 5056.110679 5236.55990 10 
myfun() 5.8398 5.951762 8.501438 6.709145 7.842536 25.16273 10 

Es ist fast 500x schneller

Answer 2

so etwas wie das?

Hinweis: Wenn Ihr Datensatz wirklich "riesig" ist, wie Sie sagen, wird Ihr Computer das nicht mögen, aber wenn Sie jede mögliche Kombination wollen, sehe ich keinen anderen Weg.

res <- merge(test1 %>% rename_all(paste0,1), 
      test2 %>% rename_all(paste0,2)) %>% 
    filter(abs(num1-num2) <= 100) %>% 
    mutate(str = paste(let1,let2,sep="_")) 
# let1 num1 let2 num2  str 
# 1 DJE 82 VNQU 181 DJE_VNQU 
# 2 JLE 238 VNQU 181 JLE_VNQU 
# 3 EGI 220 VNQU 181 EGI_VNQU 
# 4 KED 130 VNQU 181 KED_VNQU 
# 5 CJF 81 VNQU 181 CJF_VNQU 
# 6 KCH 235 VNQU 181 KCH_VNQU 
# ... 

head(res$str) 
#[1] "DJE_VNQU" "JLE_VNQU" "EGI_VNQU" "KED_VNQU" "CJF_VNQU" "KCH_VNQU"