Вдохновленный экспериментальной функцией 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
}
Следующие моменты были бы интересны:
- Я не совсем уверен, как кодировать несколько переменных с точным соответствием в стиле
data.table
, который я использовал выше (который, как мне кажется, является быстрым вариантом). - Возможно ли вложенное распараллеливание? Это означает, что можно использовать параллельный цикл foreach поверх вычисления матриц расстояний между строками.
- Меня также интересуют идеи относительно того, как сделать все это более эффективным, то есть потреблять меньше памяти.
- Может быть, вы можете предложить более крупный набор данных из «реального мира», чтобы я мог создать интересный пример. К сожалению, я не могу поделиться с вами даже небольшими выборками своих данных.
- В будущем было бы неплохо сделать что-нибудь еще, кроме классического левого внутреннего соединения. Также очень ценятся идеи по этой теме.
Все ваши комментарии приветствуются!
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