根据条件将一个 data.frame 的列的所有组合与另一个 data.frame 的列的所有组合粘贴在一起

Question

我需要一些智慧！

我有两个数据框，比如：

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

现在，我想将 test1 中的所有字符串组合（即 test1$let）与 test2 中的所有字符串组合粘贴在一起，但前提是 test1$num 和 test2$num 的差异 <= 100。

一种方法是：

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"

这很好用，但当然我的实际数据集不同而且很大，而且需要很长时间才能完成。我确信必须有一种更有效的方法来做到这一点。尝试使用应用系列功能，但我能想到的唯一使用方法是：

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"

这已经减少了相当多的时间，几乎减少了1/4，但如果能提高效率就太好了。更不用说，如果有一种完全不同且更好的方法来做到这一点，那就太棒了。

谢谢！

Answer 1

是这样的吗？

注意：如果您的数据集真的如您所说 "huge"，您的计算机不会喜欢那样，但如果您想要所有可能的组合，我看不到任何其他方式。

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"

Answer 2

outer 语句的组合在这里起作用

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

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

可重现的数据

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

基准

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

快了将近 500 倍

根据条件将一个 data.frame 的列的所有组合与另一个 data.frame 的列的所有组合粘贴在一起

Pasting together all combinations of a column from one data.frame with all combinations of a column of another data.frame based on a condition

r

apply

nested-loops