R：基于自定义距离函数和多个条件快速匹配记录

我在R中做了一些函数，根据自定义光谱相似性函数和所谓化合物保留指数（即洗脱时间）的匹配，将化学质谱（具有两个具有整数质量和强度的柱的矩阵）匹配到此类光谱库（参见此处示例）。为此，必须将每个记录的列表元素“RI”与库中的元素进行比较，当绝对偏差小于给定公差时，应将最佳光谱库匹配添加到我的记录中。下面是我为此编写的一些代码，但问题是它对于我来说太慢了（我通常有大约1000个样本光谱和200000个库光谱）。我尝试将其并行化，但似乎也没有多大帮助。我有没有想过如何使下面的代码更高效，例如使用更多的矢量化，或者使用内联C代码，或者其他一些R技巧？我知道这方面的一般建议，但不太明白在这种情况下如何轻松实现它（不幸的是，我还不太精通C）。。。有什么想法或建议吗？哦，是的，在使用

sflappy

时如何添加进度条？这可能有助于把我的光谱放在一个大的（稀疏的，有很多零点）的矩阵中，以避免谱相似函数中的<代码>合并< /代码>步骤，或者使用附加的标准，例如当查询谱中最大/最强烈的峰具有与库谱相同的质量时，只考虑谱。（或者包含在库频谱中的5个最大峰值中）？无论如何，任何关于如何加快此任务的想法都将不胜感激

编辑：我还有一个剩余的问题，那就是如何避免在函数addbestlibmatches1中创建样本记录REC的完整副本，而只更改存在库匹配的记录？此外，传递保留索引匹配的库记录的选择可能是无效的（在函数addbestlibmatch中）。有什么想法可以避免这种情况吗

# EXAMPLE DATA

rec1=list(RI=1100,spectrum=as.matrix(cbind(mz=c(57,43,71,41,85,56,55,70,42,84,98,99,39,69,58,113,156),int=c(999,684,396,281,249,173,122,107,94,73,51,48,47,47,37,33,32))))
randrec=function() list(RI=runif(1,1000,1200),spectrum=as.matrix(cbind(mz=seq(30,600,1),int=round(runif(600-30+1,0,999)))))

# spectral library
libsize=2000 # my real lib has 200 000 recs
lib=lapply(1:libsize,function(i) randrec())
lib=append(list(rec1),lib) 

# sample spectra
ssize=100 # I usually have around 1000
s=lapply(1:ssize,function(i) randrec())
s=append(s,list(rec1)) # we add the first library record as the last sample spectrum, so this should match



# SPECTRAL SIMILARITY FUNCTION

SpecSim=function (ms1,ms2,log=F) { 
  alignment = merge(ms1,ms2,by=1,all=T)
  alignment[is.na(alignment)]=0
  if (nrow(alignment)!=0) {
    alignment[,2]=100*alignment[,2]/max(alignment[,2]) # normalize base peak intensities to 100
    alignment[,3]=100*alignment[,3]/max(alignment[,3])
    if (log==T) {alignment[,2]=log2(alignment[,2]+1);alignment[,3]=log2(alignment[,3]+1)} # work on log2 intensity scale if requested
    u = alignment[,2]; v = alignment[,3]
    similarity_score = as.vector((u %*% v) / (sqrt(sum(u^2)) * sqrt(sum(v^2))))
    similarity_score[is.na(similarity_score)]=-1
    return(similarity_score)} else return(-1) }



# FUNCTION TO CALCULATE SIMILARITY VECTOR OF SPECTRUM WITH LIBRARY SPECTRA

SpecSimLib=function(spec,lib,log=F) {
  sapply(1:length(lib), function(i) SpecSim(spec,lib[[i]]$spectrum,log=log)) }



# FUNCTION TO ADD BEST MATCH OF SAMPLE RECORD rec IN SPECTRAL LIBRARY lib TO ORIGINAL RECORD
# we only compare spectra when list element RI in the sample record is within tol of that in the library
# when there is a spectral match > specsimcut within a RI devation less than tol,
# we add the record nrs in the library with the best spectral matches, the spectral similarity and the RI deviation to recs

addbestlibmatch=function(rec,lib,xvar="RI",tol=10,log=F,specsimcut=0.8) {
    nohit=list(record=-1,specmatch=NA,RIdev=NA)
    selected=abs(sapply(lib, "[[", xvar)-rec[[xvar]])<tol
    if (sum(selected)!=0) {
    specsims=SpecSimLib(rec$spectrum,lib[selected],log) # HOW CAN I AVOID PASSING THE RIGHT LIBRARY SUBSET EACH TIME?
    maxspecsim=max(specsims)
    if (maxspecsim>specsimcut) {besthsel=which(specsims==maxspecsim)[[1]] # nr of best hit among selected elements, in case of ties we just take the 1st hit
                                idbesth=which(selected)[[besthsel]] # record nr of best hit in library lib
                                return(modifyList(rec,list(record=idbesth,specsim=specsims[[besthsel]],RIdev=rec[[xvar]]-lib[[idbesth]][[xvar]])))}
                                else {return(rec)} } else {return(rec)}
}



# FUNCTION TO ADD BEST LIBRARY MATCHES TO RECORDS RECS

library(pbapply)
addbestlibmatches1=function(recs,lib,xvar="RI",tol=10,log=F,specsimcut=0.8) {
  pblapply(1:length(recs), function(i) addbestlibmatch(recs[[i]],lib,xvar,tol,log,specsimcut))
}

# PARALLELIZED VERSION
library(snowfall)
addbestlibmatches2=function(recs,lib,xvar="RI",tol=10,log=F,specsimcut=0.8,cores=4) {
  sfInit(parallel=TRUE,cpus=cores,type="SOCK")
  sfExportAll()
  sfLapply(1:length(recs), function(i) addbestlibmatch(recs[[i]],lib,xvar,tol,log,specsimcut))
  sfStop() 
}



# TEST TIMINGS

system.time(addbestlibmatches1(s,lib))
#|++++++++++++++++++++++++++++++++++++++++++++++++++| 100%
#user  system elapsed 
#83.60    0.06   83.82 

system.time(addbestlibmatches2(s,lib))
#user  system elapsed  - a bit better, but not much
#2.59    0.74   42.37 

#示例数据
rec1=列表（RI=1100，频谱=as.矩阵（cbind（mz=c（57,43,71,41,85,56,55,70,42,84,98,99,39,69,58113156），int=c（999684396281249173122107,94,73,51,48,47,37,33,32）））
randrec=function（）列表（RI=runif（110001200），spectrum=as.matrix（cbind（mz=seq（30600,1），int=round（runif（600-30+1,0999 '））））
#光谱库
libsize=2000#我真正的lib有200000个rec
lib=lappy（1:libsize，函数（i）randrec（））
lib=append（列表（rec1），lib）
#样品光谱
ssize=100#我通常有1000左右
s=lappy（1:ssize，函数（i）randrec（））
s=append（s，list（rec1））#我们添加第一个库记录作为最后一个样本光谱，因此这应该匹配
#谱相似函数
SpecSim=函数（ms1，ms2，log=F）{
对齐=合并（ms1、ms2、by=1、all=T）
对齐[is.na（对齐）]=0
如果（nrow（对齐）！=0）{
校准[，2]=100*校准[，2]/max（校准[，2]）#将基峰强度标准化为100
校准[，3]=100*校准[，3]/max（校准[，3]）
如果（log==T）{alignment[，2]=log2（alignment[，2]+1）；alignment[，3]=log2（alignment[，3]+1）}#根据要求使用log2强度标度
u=对齐[，2]；v=对齐[，3]
相似性得分=向量（（u%*%v）/（sqrt（sum（u^2））*sqrt（sum（v^2）））
相似性评分[is.na（相似性评分）]=-1
返回（相似性得分）}否则返回（-1）}
#函数计算光谱与库光谱的相似向量
SpecSimLib=函数（spec、lib、log=F）{
sapply（1:length（lib），function（i）SpecSim（spec，lib[[i]]$spectrum，log=log））}
#函数用于将光谱库库中样本记录rec的最佳匹配添加到原始记录
#我们仅在样本记录中的列表元素RI与库中的列表元素RI在tol范围内时比较光谱
#当RI值小于tol时，存在光谱匹配>光谱切割，
#我们将库中具有最佳光谱匹配、光谱相似性和RI偏差的记录nrs添加到recs
addbestlibmatch=函数（rec，lib，xvar=“RI”，tol=10，log=F，specsimcut=0.8）{
nohit=list（记录=-1，specmatch=NA，RIdev=NA）
selected=abs（sapply（lib，“[[”，xvar）-rec[[xvar]]）specsimcut{besthsel=which（specsims==maxspecsim）[[1]]#所选元素中的最佳命中数，如果是平局，我们只进行第一次命中
idbesth=哪个（选定）[[besthsel]]#记录库库库中最佳命中数
返回（modifyList（rec，list（record=idbesth，specsim=specsims[[besthsel]]，RIdev=rec[[xvar]]]-lib[[idbesth]][[xvar]]））
else{return（rec）}else{return（rec）}
}
#函数将最佳库匹配添加到记录记录
图书馆（pbapply）
addbestlibmatches1=函数（recs，lib，xvar=“RI”，tol=10，log=F，specsimcut=0.8）{
pblapply（1:length（recs），function（i）addbestlibmatch（recs[[i]]，lib，xvar，tol，log，specsimcut））
}
#并行化版本
图书馆（降雪）
addbestlibmatches2=函数（recs，lib，xvar=“RI”，tol=10，log=F，specsimcut=0.8，cores=4）{
sfInit（parallel=TRUE，cpu=cores，type=“SOCK”）
sfExportAll（）
sfLapply（1:length（recs），function（i）addbestlibmatch（recs[[i]]，lib，xvar，tol，log，specsimcut））
sfStop（）
}
#测试时间
系统时间（addbestlibmatches1（s，lib））
#|++++++++++++++++++++++++++++++++++++++++++++++++++| 100%
#用户系统运行时间
#83.60    0.06   83.82 
系统时间（addbestlibmatches2（s，lib））
#用户系统运行了—稍微好一点，但不多
#2.59    0.74   42.37 
 < p>不详细查看所有代码，我认为在不需要所有C++的情况下，SPECSIM函数还有改进的空间。您使用的是合并，它将矩阵强制转换为DATA帧。这对性能总是不利的。大多数代码时间可能在MurGe（）中。数据帧子集是慢的，矩阵或向量是快的

SpecSim2 <- function (ms1,ms2,log=F) {
  i <- unique(c(ms1[,1], ms2[,1]))
  y <- x <- numeric(length(i))
  x[match(ms1[,1], i)] <- ms1[, 2]
  y[match(ms2[,1], i)] <- ms2[, 2]
  x <- 100 * x / max(x)
  y <- 100 * y / max(y)
  if (log){
    x <- log2(x + 1)
    y <- log2(y + 1)
  }
  similarity.score <- x %*% y / (sqrt(sum(x^2)) * sqrt(sum(y^2)))
  if (is.na(similarity.score)){
    return(-1)
  } else {
    return(similarity.score)
  }
}

可能无法达到您需要的速度，但会更好
> system.time(addbestlibmatches1(s,lib))
  |++++++++++++++++++++++++++++++++++++++++++++++++++| 100%
   user  system elapsed 
   4.16    0.00    4.17

> system.time(addbestlibmatches1(s,lib))
  |++++++++++++++++++++++++++++++++++++++++++++++++++| 100%
   user  system elapsed 
  34.25    0.02   34.34 

selected <- outer(sRI, libRI, FUN = '-') < 10

SpecSimMat <- function(x, lib, log = F){
  stopifnot(require(matrixStats))
  x <- 100 * x / max(x)
  lib <- sweep(lib, 2, colMaxs(lib))
  x %*% lib / (sqrt(sum(x^2)) * sqrt(colSums(lib^2)))