Фильтрация данных по второму значению по значению

Question

У меня всегда были проблемы с петлями, поэтому я спрашиваю здесь. 2 кадра данных. 1 очень большой и 1 намного меньше. Примеры версий ниже.

Dataframe 1

ID        Value
1         apples
1         apples
1         bananas
1         grapes
1         mangoes
1         oranges
1         grapes
1         apples
1         grapes
2         apples
2         apples
2         passionfruits
2         bananas
2         apples
2         apples
2         passionfruits
2         grapes
2         mangoes
2         apples
3         apples
3         bananas
3         oranges
3         apples
3         grapes
3         grapes
3         passionfruits
3         passionfruits
3         oranges
4         apples
4         oranges
4         mangoes
4         bananas
4         grapes
4         grapes
4         grapes
4         apples
4         oranges
4         grapes
4         mangoes
4         mangoes
4         apples
4         oranges
5         passionfruits
5         apples
5         oranges
5         oranges
5         mangoes
5         grapes
5         apples
5         bananas

Dataframe 2

Value
apples
apples
bananas
grapes
mangoes
mangoes
grapes
apples
apples

Различные идентификаторы в кадре данных 1 рассматриваются как наборы. Фрейм данных 2 во всей полноте будет приблизительно или точно соответствовать одному из наборов. Я знаю, что достаточно кода для фильтрации, используя весь фрейм данных 2, чтобы соответствовать 1. Но это не то, что мне нужно. Я требую, чтобы он последовательно фильтровал значение по значению с прикрепленными условиями. Условием должно быть соответствие предыдущего значения.

Так что в этом примере с первым значением ничего не происходит, потому что все идентификаторы имеют «яблоки». Второе значение = «яблоки», учитывая, что предыдущее значение = «яблоки» отфильтровывает ID = 4, поскольку оно не содержит «яблок», встречающихся дважды подряд. Теперь в отфильтрованном кадре данных 1 мы ищем третье значение и так далее. Он останавливается только тогда, когда 1 набор идентификаторов остается в кадре данных 1. Так что в этом случае после 3-й итерации. Результат должен быть

Dataframe 1

ID        Value
1         apples
1         apples
1         bananas
1         grapes
1         mangoes
1         oranges
1         grapes
1         apples
1         grapes

Answer 1

Мы можем объединить Value для каждого ID, используя разделитель токенов (скажем, #), а затем написать пользовательскую функцию, которая сравнивает, сколько последовательных токенов было найдено. Наконец, выберите данные для ID, которые получили максимальное совпадение.

library(dplyr)

# This function matches and count tokens separated by `#`
# matched_count ("a#b#c","a#e#c#d")  will return 1
matched_count <- function(x, y){
  x_v <- strsplit(x, split = "#")[[1]]
  y_v <- strsplit(y, split = "#")[[1]]
  max_len <- max(length(x_v), length(y_v))
  length(x_v) <- max_len
  length(y_v) <- max_len
  sum(x_v==y_v,na.rm = TRUE)
}    


Dataframe1 %>% group_by(ID) %>%
  mutate(CompStr = paste0(Value, collapse="#")) %>% #collapse values for ID
  mutate(CompStrdf2 = paste0(Dataframe2$Value, collapse="#")) %>% 
  mutate(max_match = matched_count(CompStr, CompStrdf2)) %>%
  ungroup() %>%
  filter(max_match == max(max_match)) %>%
  select(ID, Value)

# ID Value  
# <int> <chr>  
# 1     1 apples 
# 2     1 apples 
# 3     1 bananas
# 4     1 grapes 
# 5     1 mangoes
# 6     1 oranges
# 7     1 grapes 
# 8     1 apples 
# 9     1 grapes 

Answer 2

Я предлагаю превратить Values в каждой группе в строку и сравнить их расстояние редактирования строки. adist - Вычислить приблизительное расстояние между символьными векторами. Расстояние - это обобщенное расстояние Левенштейна (правка), дающее минимально возможное взвешенное количество вставок, удалений и замен, необходимых для преобразования одной строки в другую.

string_edit_dist <- function(vec1, vec2) {
    c(adist(paste0(vec1, collapse=""), paste0(vec2, collapse="")))
}    

ind <- which.min(sapply(seq_along(unique(df1$ID)), function(i) string_edit_dist(df1$Value[df1$ID==i], df2$Value)))
df1[df1$ID==ind, ]

  # ID   Value
# 1  1  apples
# 2  1  apples
# 3  1 bananas
# 4  1  grapes
# 5  1 mangoes
# 6  1 oranges
# 7  1  grapes
# 8  1  apples
# 9  1  grapes

Вот string_edit_distance для каждой группы

sapply(seq_along(unique(df1$ID)), function(i) string_edit_dist(df1$Value[df1$ID==i], df2$Value))
# 7 35 45 46 27

Answer 3

Возможный подход с data.table (адаптация из моего ответа здесь ):

# load packages
library(data.table)

# create a function which calculates match-score with 'df2$Value'
maxscore <- function(x, y) {
  m <- mapply('==', shift(x, type = 'lead', n = 0:(length(y) - 1)), y)
  max(rowSums(m, na.rm = TRUE))
}

# calculate the match-score for each group
# and filter out the other groups
setDT(df1)[, score := maxscore(Value, df2$Value), by = ID
           ][score == max(score)][, score := NULL][]

, что дает:

   ID   Value
1:  1  apples
2:  1  apples
3:  1 bananas
4:  1  grapes
5:  1 mangoes
6:  1 oranges
7:  1  grapes
8:  1  apples
9:  1  grapes

---

Вы также можете использовать эту функцию в dplyr -цепи (но вам все равно понадобится пакет data.table для shift -функции):

library(dplyr)
df1 %>% 
  group_by(ID) %>% 
  mutate(m = maxscore(Value, df2$Value)) %>% 
  ungroup() %>% 
  filter(m == max(m)) %>% 
  select(-m)

Альтернативная реализация maxscore -функции (вдохновленный ответом @ doscendo здесь ):

maxscore2 <- function(x, y) {
  w <- which(x == y[1])
  v <- sapply(w, function(i) sum(x[i:(i+(length(y)-1))] == y, na.rm = TRUE))
  max(v)
}