Количество конкретных последовательностей в векторе

Question

Даны два вектора: «образец» и «след».Вопрос: Как часто встречается «паттерн» в «тропе»?Пример:

pattern <- c (1,2,3) </p>

trail <- c (7,1,4,2,9,2,3) </p>

Правильное решение: 2 (то есть 1,2,3 и 1,2,3; "2" встречается дважды в середине).

Я пытался:

getPerformance <- function(pattern,trail) {
  tmp <- 0
  for(i in 1:length(pattern)) {
    for(j in 1:length(trail)) {
      if(pattern[i]==trail[j]) {

        if(i<length(pattern)) {
          sum(pattern[i:length(pattern)]) 
        }
        tmp <- 1 * getPerformance(pattern[i:length(pattern)],trail[j:length(trail)])
      }
    }
  }
  return(tmp)
}

Но эта функция не завершается.Конечно, нерекурсивные решения приветствуются.Спасибо за любую помощь!

Answer 1

n_subseq = function(trail, pattern) {
  # generate all subsets of the elements of `trail` in `pattern`
  # of `length(pattern)`
  # preserving order (as combn does)
  # that are all equal to `pattern`
  sum(combn(
    x = trail[trail %in% pattern],
    m = length(pattern),
    FUN = function(x) all(x == pattern)
  ))
}

n_subseq(trail = c(7, 1, 4, 2, 9, 2, 3), pattern = 1:3)
# [1] 2

n_subseq(c(1, 2, 2, 3, 3), 1:3)
# [1] 4

Answer 2

Во-первых, мы можем игнорировать элементы, которые не отображаются в pattern:

tt = trail[trail %in% pattern]

Затем я бы сделал это рекурсивное решение:

count_patt = function(p, v){
  # stop if done searching
  if (length(p) == 0L) return(0L)

  # find matches
  w  = which(v == p[1L])

  # report matches if done searching
  if (length(p) == 1L) return(length(w))

  # otherwise, search for subsequent matches    
  pn = p[-1L]
  sum(vapply(w, function(wi) count_patt(pn, tail(v, -wi)), FUN.VALUE = 0L))
}

count_patt(pattern, tt)
# [1] 2

---

Другая рекурсивная идея:

count_patt2 = function(p, v){
  # succeed if there's nothing to search for
  if (length(p) == 0L) return(1L)

  # find match
  w = match(p[1L], v)

  # fail if not found
  if (is.na(w)) return(0L)

  # if found, define rest of searchable vector
  tv = tail(v, -w)

  # count if same pattern is found later
  count_same = count_patt(p, tv)

  # or if rest of pattern is found later
  count_next = count_patt(p[-1L], tv)

  count_same + count_next
}

count_patt2(pattern, trail)
# [1] 2

---

Если элементы pattern различны, я думаю, это также работает:

v = na.omit(match(trail, pattern))
prod(table(v[v == cummax(v)]))*(length(pattern) == length(v)) 
# [1] 2

---

Простой тест (пока тольковключая @ функцию Грегора):

set.seed(1)
v0 = 1:9
nv = 200L
np = 5L

vec  = sample(v0, nv, replace=TRUE)
patt = sample(v0, np, replace=TRUE)

system.time(res_count2 <- count_patt2(patt, vec))
#    user  system elapsed 
#    0.56    0.00    0.56
system.time(res_count1 <- count_patt(patt, vec))
#    user  system elapsed 
#    0.60    0.00    0.61 
system.time(res_subseq <- n_subseq(vec, patt))
#    user  system elapsed 
#   25.89    0.15   26.16 

length(unique(c(res_subseq, res_count1, res_count2))) == 1L
# [1] TRUE

Комментарии. Я считаю res_subseq Грегора более читабельным, чем мой.Я уверен, что есть более эффективные рекурсивные решения.

Answer 3

Вы можете использовать rle в качестве прокси:

max(rle(trail[trail %in% pattern])$lengths)
[1] 2