Нечеткое слияние в R - ищу помощи в улучшении моего кода

Вдохновленный экспериментальной функцией fuzzy_join из пакета statar, я сам написал функцию, которая сочетает в себе точную и нечеткую (по строке расстояния) сопоставление. Задача слияния, которую мне нужно выполнить, довольно большая (в результате получается несколько матриц расстояний между строками с чуть меньше одного миллиарда ячеек), и у меня сложилось впечатление, что функция 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. Может быть, вы можете предложить более крупный набор данных из «реального мира», чтобы я мог создать интересный пример. К сожалению, я не могу поделиться с вами даже небольшими выборками своих данных.
  5. В будущем было бы неплохо сделать что-нибудь еще, кроме классического левого внутреннего соединения. Также очень ценятся идеи по этой теме.

Все ваши комментарии приветствуются!


person chameau13    schedule 04.04.2015    source источник
comment
Пробуем ваш код (спасибо) и получаю следующую ошибку с моими данными ... `Ошибка в rownames<-`(`*tmp*`, value = c(31, 33, 34, 48, 75, 98, 103, : length of 'dimnames' [1] not equal to array extent . Не думаешь, ты знаешь, где мне искать?   -  person drstevok    schedule 27.07.2015
comment
запрос функции github.com/Rdatatable/data.table/issues/636   -  person jangorecki    schedule 21.02.2019
comment
для людей, которые все еще видят это, вы можете попробовать пакет fuzzyjoin   -  person Arthur Yip    schedule 06.01.2021