Один из вариантов - использовать agrep с lapply, чтобы найти индексы статей журнала, которые отличаются на ≤10% (по умолчанию для agrep, который можно изменить с помощью max.distance аргумент), затем возьмите первую статью каждой и векторизуйте ее, используя sapply, получите индексы unique, длину вектора и оберните tapply вокруг всего этого, чтобы выбрать количество "разнородных" статей внутри каждого журнала.
tapply(data$PAPER, data$JOURNAL, FUN=function(x) {
length(unique(sapply(lapply(x, function(y) agrep(y, x) ), "[", 1))
} )
# 0001-1231 0001-1232
# 6 8
Для версии dplyr, которая возвращает результаты в более хорошем формате, я поместил приведенный выше код в функцию, затем использовал group_by(), за которым следует summarise().
dissimilar <- function(x, distance=0.1) {
length(unique(sapply(lapply(x, function(y)
agrep(y, x, max.distance = distance) ), "[", 1)))
}
При определении «отличного» в соответствии с документацией agrep.
library(dplyr)
data2 %>%
group_by(JOURNAL) %>%
summarise(n=dissimilar(PAPER))
# A tibble: 2 x 2
JOURNAL n
<chr> <int>
1 0001-1231 6
2 0001-1232 8
Однако для более крупного набора данных, например, содержащего тысячи журналов и более 450 000 статей, выше будет довольно медленно (около 10-15 минут на моем 2,50 ГГц Intel). Я понял, что функция dissimilar неоправданно сравнивает каждый ряд с каждым другим, что бессмысленно. В идеале каждый ряд должен сравниваться только с самим собой и со всеми оставшимися рядами . Например, первый журнал содержит 5 очень похожих статей в строках 8-12. Одно использование agrep в строке № 8 возвращает все 5 индексов, и, следовательно, нет необходимости сравнивать строки 9-12 с любыми другими. Поэтому я заменил lapply на a для l oop, и теперь процесс занимает всего 2-3 минуты с набором данных из 450 000 строк.
dissimilar <- function(x, distance=0.1) {
lst <- list() # initialise the list
k <- 1:length(x) # k is the index of PAPERS to compare with
for(i in k){ # i = each PAPER, k = itself and all remaining
lst[[i]] <- agrep(x[i], x[k], max.distance = distance) + i - 1
# + i - 1 ensures that the original index in x is maintained
k <- k[!k %in% lst[[i]]] # remove elements which are similar
}
lst <- sapply(lst, "[", 1) # take only the first of each item in the list
length(na.omit(lst)) # count number of elements
}
Теперь разверните исходный примерный набор данных так, чтобы 450 000 записей, содержащих около 18 000 журналов, каждая из которых содержит около 25 статей.
n <- 45000
data2 <- do.call("rbind", replicate(round(n/26), data, simplify=FALSE))[1:n,]
data2$JOURNAL[27:n] <- rep(paste0("0002-", seq(1, n/25)), each=25)[1:(n-26)]
data2 %>%
group_by(JOURNAL) %>%
summarise(n=dissimilar(PAPER))
# A tibble: 18,001 x 2
JOURNAL n
<chr> <int>
1 0001-1231 6 # <-- Same
2 0001-1232 8
3 0002-1 14
4 0002-10 14
5 0002-100 14
6 0002-1000 13
7 0002-10000 14
8 0002-10001 14
9 0002-10002 14
10 0002-10003 14
# ... with 17,991 more rows
Задача состоит в том, чтобы найти способ еще больше ускорить процесс.