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为＆lt; = 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"

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

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

这样的事情？

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

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的列的所有组合与基于条件

2 个答案: