R - seek中的模糊融合有助于提高我的代码

时间:2015-04-04 17:38:59

标签: r parallel-processing data.table fuzzy-comparison stringdist

受到statar包中的实验fuzzy_join函数的启发,我自己编写了一个函数,它结合了精确和模糊(通过字符串距离)匹配。我必须做的合并工作非常大(导致多个字符串距离矩阵,小于10亿个单元格),我的印象是fuzzy_join函数写得不是很有效(关于内存)并行化是以一种奇怪的方式实现的(字符串距离矩阵的计算,如果有多个模糊变量,而不是字符串距离本身的计算并行化)。对于fuzzy_join函数,想法是在可能的情况下匹配精确变量(以保持矩阵更小),然后在这个精确匹配的组内进行模糊匹配。我实际上认为这个功能是不言自明的。我在这里发布它是因为我想得到一些反馈来改进它,因为我想我并不是唯一一个试图在R中做这样的事情的人(虽然我承认Python,SQL和类似的东西可能在这种情况下要更有效率。但是必须坚持使用最让人感觉最舒服的事情,并且使用相同的语言进行数据清理和准备就可重复性而言很好。

merge.fuzzy = function(a,b,.exact,.fuzzy,.weights,.method,.ncores) {
    require(stringdist)
    require(matrixStats)
    require(parallel)

    if (length(.fuzzy)!=length(.weights)) {
        stop(paste0("fuzzy and weigths must have the same length"))
    }

    if (!any(class(a)=="data.table")) {
        stop(paste0("'a' must be of class data.table"))
    }

    if (!any(class(b)=="data.table")) {
        stop(paste0("'b' must be of class data.table"))
    }

    #convert everything to lower
    a[,c(.fuzzy):=lapply(.SD,tolower),.SDcols=.fuzzy]
    b[,c(.fuzzy):=lapply(.SD,tolower),.SDcols=.fuzzy]

    a[,c(.exact):=lapply(.SD,tolower),.SDcols=.exact]
    b[,c(.exact):=lapply(.SD,tolower),.SDcols=.exact]

    #create ids
    a[,"id.a":=as.numeric(.I),by=c(.exact,.fuzzy)]
    b[,"id.b":=as.numeric(.I),by=c(.exact,.fuzzy)]


    c <- unique(rbind(a[,.exact,with=FALSE],b[,.exact,with=FALSE]))
    c[,"exa.id":=.GRP,by=.exact]

    a <- merge(a,c,by=.exact,all=FALSE)
    b <- merge(b,c,by=.exact,all=FALSE)

    ##############

    stringdi <- function(a,b,.weights,.by,.method,.ncores) {
        sdm      <- list()

        if (is.null(.weights)) {.weights <- rep(1,length(.by))}

        if (nrow(a) < nrow(b)) {
            for (i in 1:length(.by)) {
                sdm[[i]] <- stringdistmatrix(a[[.by[i]]],b[[.by[i]]],method=.method,ncores=.ncores,useNames=TRUE)
            }
        } else {
            for (i in 1:length(.by)) { #if a is shorter, switch sides; this enhances  parallelization speed
                sdm[[i]] <- stringdistmatrix(b[[.by[i]]],a[[.by[i]]],method=.method,ncores=.ncores,useNames=FALSE)
            }
        }

        rsdm = dim(sdm[[1]])
        csdm = ncol(sdm[[1]])
        sdm  = matrix(unlist(sdm),ncol=length(by))
        sdm  = rowSums(sdm*.weights,na.rm=T)/((0 + !is.na(sdm)) %*% .weights)
        sdm  = matrix(sdm,nrow=rsdm,ncol=csdm)

        #use ids as row/ column names
        rownames(sdm) <- a$id.a
        colnames(sdm) <- b$id.b

        mid           <- max.col(-sdm,ties.method="first")
        mid           <- matrix(c(1:nrow(sdm),mid),ncol=2)
        bestdis       <- sdm[mid] 

        res           <- data.table(as.numeric(rownames(sdm)),as.numeric(colnames(sdm)[mid[,2]]),bestdis)
        setnames(res,c("id.a","id.b","dist"))

        res
    }

    setkey(b,exa.id)
    distances = a[,stringdi(.SD,b[J(.BY[[1]])],.weights=.weights,.by=.fuzzy,.method=.method,.ncores=.ncores),by=exa.id]

    a    = merge(a,distances,by=c("exa.id","id.a"))
    res  = merge(a,b,by=c("exa.id","id.b"))


    res
}

以下几点很有意思:

  1. 我不太确定如何使用上面使用的data.table样式编码多个完全匹配的变量(我认为这是禁食选项)。
  2. 是否可以嵌套并行化?这意味着可以在字符串距离矩阵的计算之上使用并行foreach循环。
  3. 我也对使整个事情变得更有效率的想法感兴趣,即消耗更少的记忆。
  4. 也许你可以建议一个更大的现实世界&#34;数据集,以便我可以创建一个woking示例。不幸的是,我无法与你分享我的数据的小样本。
  5. 将来除了经典的左内连接之外,做其他事情也会很好。因此,非常感谢关于这个主题的想法。
  6. 欢迎您的所有评论!

0 个答案:

没有答案