Найти наиболее повторяющуюся последовательность строк в R-кадре

Question

Предположим, у меня есть фрейм данных, который выглядит следующим образом

    ITEM
  1  X
  2  A
  3  B
  4  C
  5  A
  6  F
  7  U
  8  A
  9  B
 10  C
 11  F
 12  U

как мне получить наиболее распространенную последовательность строк.В этом случае наиболее распространенной последовательностью будет A,B,C, поскольку она появляется в строках 2–4 и 8–10.

Я уже попробовал функцию rle, а также некоторые решения, найденные здесь,и мне не повезло.Могу ли я иметь предложение, подсказку или рекомендацию пакета?

Answer 1

Вот альтернативный подход, основанный на цикле, который все еще не особенно масштабируем, но быстрее, чем другое решение, поскольку вектор для поиска удлиняется.

  x <- paste0(df$ITEM, collapse = "")
  nc <- nchar(x)
  m <- matrix("", nc, nc)
  min.p.length <- 2 # Minimum character length of patterns returned 
  for (i in 1:nc) {
    for (j in 1:nc)
      if ((j >= i) & (j - i <= nc/2) & (j - i >= min.p.length - 1))
        m[i, j] <- substring(x, i, j)
  }

  tab <- table(m[m > 0])
  tab[which(tab == max(tab))]

 AB ABC  BC  FU 
  2   2   2   2 

Answer 2

A tidyverse раствор, смешанный с вложенными apply функциями.Решение обобщено и сообщит о наиболее частой нетривиальной последовательной последовательности, которая появляется по крайней мере дважды - связь переходит к более длинной последовательности.

library(tidyverse)

# Data
x <- data.frame(ITEM = c("X", "A", "B", "C", "A", "F", "U", "A", "B", "C", "F", "U"), stringsAsFactors = F)

# convert x to vector
y <- x$ITEM

# Create list to check for sequence of each length 2 through n/2
l <- lapply(2:floor(length(y)/2), function(a) sapply(1:a, function(x) y[(0 + x):(length(y) - a + x)])) %>% 
  lapply(as.data.frame) %>% 
  setNames(sapply(2:(length(.) + 1), function(a) paste0("Consecutive", a)))

# Show most frequent sequence(s), choosing the longest
lapply(1:length(l), function(x) (as.data.frame(table(do.call(paste, l[[x]])), stringsAsFactors = F) %>% 
                                   dplyr::mutate(length = nchar(Var1)) %>% 
                                   dplyr::filter(length == max(length) & Freq == max(Freq) & Freq > 1)) ) %>% 
  .[which(sapply(., nrow) > 0)] %>% 
  dplyr::bind_rows() %>% 
  dplyr::filter(Freq == max(Freq)) %>% 
  dplyr::filter(length == max(length)) %>% 
  dplyr::rename(Sequence = Var1) %>% 
  dplyr::select(-length)

#  Sequence Freq
#1    A B C    2

Answer 3

Полагаю, вы хотите самую длинную неперекрывающуюся подстроку.Здесь есть хорошее объяснение решения динамического программирования здесь .

x = c("X", "A", "B", "C", "A", "F", "U", "A", "B", "C", "F", "U")
n = length(x)
m1 = sapply(x, function(i) sapply(x, function(j) as.integer(i == j)))
diag(m1) = 0
m1[lower.tri(m1)] = 0
m1
#   X A B C A F U A B C F U
# X 0 0 0 0 0 0 0 0 0 0 0 0
# A 0 0 0 0 1 0 0 1 0 0 0 0
# B 0 0 0 0 0 0 0 0 1 0 0 0
# C 0 0 0 0 0 0 0 0 0 1 0 0
# A 0 0 0 0 0 0 0 1 0 0 0 0
# F 0 0 0 0 0 0 0 0 0 0 1 0
# U 0 0 0 0 0 0 0 0 0 0 0 1
# A 0 0 0 0 0 0 0 0 0 0 0 0
# B 0 0 0 0 0 0 0 0 0 0 0 0
# C 0 0 0 0 0 0 0 0 0 0 0 0
# F 0 0 0 0 0 0 0 0 0 0 0 0
# U 0 0 0 0 0 0 0 0 0 0 0 0

m2 = m1
for (i in 2:nrow(m1)){
    for (j in 2:nrow(m1)){
        if (m1[i-1, j-1] == 1 & m1[i, j] == 1){
            if (j - i > m2[i - 1, j - 1]){
                m2[i, j] = m2[i - 1, j - 1] + m2[i, j]
                m2[i - 1, j - 1] = 0
            } else {
                m2[i, j] = 0
            }
        }
    }
}
m2
#   X A B C A F U A B C F U
# X 0 0 0 0 0 0 0 0 0 0 0 0
# A 0 0 0 0 1 0 0 0 0 0 0 0
# B 0 0 0 0 0 0 0 0 0 0 0 0
# C 0 0 0 0 0 0 0 0 0 3 0 0
# A 0 0 0 0 0 0 0 1 0 0 0 0
# F 0 0 0 0 0 0 0 0 0 0 0 0
# U 0 0 0 0 0 0 0 0 0 0 0 2
# A 0 0 0 0 0 0 0 0 0 0 0 0
# B 0 0 0 0 0 0 0 0 0 0 0 0
# C 0 0 0 0 0 0 0 0 0 0 0 0
# F 0 0 0 0 0 0 0 0 0 0 0 0
# U 0 0 0 0 0 0 0 0 0 0 0 0

ans_len = max(m2)
inds = c(which(m2 == ans_len, arr.ind = TRUE)[,2])
lapply(inds, function(ind) x[(ind - ans_len + 1):ind])
# [[1]]
# [1] "A" "B" "C"