Поиск образца в матрице в R

У меня есть 8 x n матрица, например

set.seed(12345)
m <- matrix(sample(1:50, 800, replace=T), ncol=8)
head(m)

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]   37   15   30    3    4   11   35   31
[2,]   44   31   45   30   24   39    1   18
[3,]   39   49    7   36   14   43   26   24
[4,]   45   31   26   33   12   47   37   15
[5,]   23   27   34   29   30   34   17    4
[6,]    9   46   39   34    8   43   42   37

Я хотел бы найти определенный шаблон в матрице, например, я хотел бы знать, где я могу найти 37, а затем в следующей строке 10 и 29, а строка после 42

Это происходит, например, в строках 57:59 указанной выше матрицы

m[57:59,]
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]  *37   35    1   30   47    9   12   39
[2,]    5   22  *10  *29   13    5   17   36
[3,]   22   43    6    2   27   35  *42   50

A (возможно, неэффективное) решение состоит в том, чтобы получить все строки, содержащие 37 с

sapply(1:nrow(m), function(x){37 %in% m[x,]})

И затем используйте несколько циклов для проверки других условий.

Как я могу написать эффективную функцию для этого, которая может быть обобщена на любой заданный пользователем шаблон (не обязательно более трех строк с возможными "дырами" с переменным количеством значений в каждой строке и т.д.).

ИЗМЕНИТЬ: ответить на различные комментарии

  • Мне нужно найти EXACT-шаблон
  • Порядок в той же строке не имеет значения (если в каждой строке можно упорядочить более простые значения)
  • Строки должны быть смежными.
  • Я хочу получить (начальную) позицию всего возвращенного шаблона (т.е. если шаблон присутствует несколько раз в матрице, я хочу несколько возвращаемых значений).
  • Пользователь вводит шаблон через графический интерфейс, мне еще предстоит решить, как это сделать. Например, для поиска вышеуказанного шаблона он может написать что-то вроде

37;10,29;42

Где ; представляет новую строку, а , разделяет значения в одной строке. Аналогично мы можем искать

50,51;;75;80,81

Значение 50 и 51 в строке n, 75 в строке n + 2 и 80 и 81 в строке n + 3

ОТВЕТЫ

Ответ 1

Вот обобщенная функция:

PatternMatcher <- function(data, pattern, idx = NULL) {
  p <- unlist(pattern[1])
  if(is.null(idx)){
    p <- unlist(pattern[length(pattern)])
    PatternMatcher(data, rev(pattern)[-1], 
                   idx = Filter(function(n) all(p %in% intersect(data[n, ], p)),
                                1:nrow(data)))
  } else if(length(pattern) > 1) {
    PatternMatcher(data, pattern[-1], 
                   idx = Filter(function(n) all(p %in% intersect(data[n, ], p)), 
                                idx - 1))
  } else
    Filter(function(n) all(p %in% intersect(data[n, ], p)), idx - 1)
}

Это рекурсивная функция, которая уменьшает pattern на каждой итерации и проверяет только строки, которые идут сразу после тех, которые указаны в предыдущей итерации. Структура списка позволяет передавать шаблон удобным способом:

PatternMatcher(m, list(37, list(10, 29), 42))
# [1] 57
PatternMatcher(m, list(list(45, 24, 1), 7, list(45, 31), 4))
# [1] 2
PatternMatcher(m, list(1,3))
# [1] 47 48 93

Изменить: Идея функции выше кажется прекрасной: проверьте все строки для вектора pattern[[1]] и получите индексы r1, затем проверьте строки r1+1 для pattern[[2]] и получите r2 и т.д. Но на первом этапе при переходе через все строки требуется очень много времени. Конечно, каждый шаг занимает много времени, например, m <- matrix(sample(1:10, 800, replace=T), ncol=8), т.е. когда изменений индексов r1, r2 нет... Итак, вот еще один подход, здесь PatternMatcher выглядит очень похоже, но есть еще одна функция matchRow для нахождения строки, которые имеют все элементы vector.

matchRow <- function(data, vector, idx = NULL){
  if(is.null(idx)){
    matchRow(data, vector[-1], 
             as.numeric(unique(rownames(which(data == vector[1], arr.ind = TRUE)))))
  } else if(length(vector) > 0) {
    matchRow(data, vector[-1], 
             as.numeric(unique(rownames(which(data[idx, , drop = FALSE] == vector[1], arr.ind = TRUE)))))
  } else idx
}
PatternMatcher <- function(data, pattern, idx = NULL) {
  p <- pattern[[1]]
  if(is.null(idx)){
    rownames(data) <- 1:nrow(data)
    p <- pattern[[length(pattern)]]
    PatternMatcher(data, rev(pattern)[-1], idx = matchRow(data, p))
  } else if(length(pattern) > 1) {
    PatternMatcher(data, pattern[-1], idx = matchRow(data, p, idx - 1))
  } else
    matchRow(data, p, idx - 1)
}

Сравнение с предыдущей функцией:

library(rbenchmark)
bigM <- matrix(sample(1:50, 800000, replace=T), ncol=8)
benchmark(PatternMatcher(bigM, list(37, c(10, 29), 42)), 
          PatternMatcher(bigM, list(1, 3)), 
          OldPatternMatcher(bigM, list(37, list(10, 29), 42)), 
          OldPatternMatcher(bigM, list(1, 3)), 
          replications = 10,
          columns = c("test", "elapsed"))
#                                                  test elapsed
# 4                 OldPatternMatcher(bigM, list(1, 3))   61.14
# 3 OldPatternMatcher(bigM, list(37, list(10, 29), 42))   63.28
# 2                    PatternMatcher(bigM, list(1, 3))    1.58
# 1       PatternMatcher(bigM, list(37, c(10, 29), 42))    2.02

verybigM1 <- matrix(sample(1:40, 8000000, replace=T), ncol=20)
verybigM2 <- matrix(sample(1:140, 8000000, replace=T), ncol=20)
benchmark(PatternMatcher(verybigM1, list(37, c(10, 29), 42)), 
          PatternMatcher(verybigM2, list(37, c(10, 29), 42)), 
          find.combo(verybigM1, convert.gui.input("37;10,29;42")),
          find.combo(verybigM2, convert.gui.input("37;10,29;42")),          
          replications = 20,
          columns = c("test", "elapsed"))
#                                                      test elapsed
# 3 find.combo(verybigM1, convert.gui.input("37;10,29;42"))   17.55
# 4 find.combo(verybigM2, convert.gui.input("37;10,29;42"))   18.72
# 1      PatternMatcher(verybigM1, list(37, c(10, 29), 42))   15.84
# 2      PatternMatcher(verybigM2, list(37, c(10, 29), 42))   19.62

Также теперь аргумент pattern должен быть как list(37, c(10, 29), 42) вместо list(37, list(10, 29), 42). И наконец:

fastPattern <- function(data, pattern)
  PatternMatcher(data, lapply(strsplit(pattern, ";")[[1]], 
                    function(i) as.numeric(unlist(strsplit(i, split = ",")))))
fastPattern(m, "37;10,29;42")
# [1] 57
fastPattern(m, "37;;42")
# [1] 57  4
fastPattern(m, "37;;;42")
# [1] 33 56 77

Ответ 2

Это легко читается и, как мы надеемся, достаточно обобщающе для вас:

has.37 <- rowSums(m == 37) > 0
has.10 <- rowSums(m == 10) > 0
has.29 <- rowSums(m == 29) > 0
has.42 <- rowSums(m == 42) > 0

lag <- function(x, lag) c(tail(x, -lag), c(rep(FALSE, lag)))

which(has.37 & lag(has.10, 1) & lag(has.29, 1) & lag(has.42, 2))
# [1] 57

Изменить: вот обобщение, которое может использовать положительные и отрицательные задержки:

find.combo <- function(m, pattern.df) {

   lag <- function(v, i) {
      if (i == 0) v else
      if (i > 0)  c(tail(v, -i), c(rep(FALSE, i))) else
      c(rep(FALSE, -i), head(v, i))
   }

   find.one <- function(x, i) lag(rowSums(m == x) > 0, i)
   matches  <- mapply(find.one, pattern.df$value, pattern.df$lag)
   which(rowSums(matches) == ncol(matches))

}

Протестировано здесь:

pattern.df <- data.frame(value = c(40, 37, 10, 29, 42),
                         lag   = c(-1,  0,  1,  1,  2))

find.combo(m, pattern.df)
# [1] 57

Edit2: после редактирования OP, относящегося к входу GUI, вот функция, которая преобразует вход GUI в функцию pattern.df my find.combo, ожидает:

convert.gui.input <- function(string) {
   rows   <- strsplit(string, ";")[[1]]
   values <- strsplit(rows,   ",")
   data.frame(value = as.numeric(unlist(values)),
              lag = rep(seq_along(values), sapply(values, length)) - 1)
}

Протестировано здесь:

find.combo(m, convert.gui.input("37;10,29;42"))
# [1] 57

Ответ 3

Поскольку у вас есть целое число, вы можете преобразовать свою матрицу в строку и использовать регулярное выражение

ss <- paste(apply(m,1,function(x) paste(x,collapse='-')),collapse=' ')
## some funny regular expression
pattern <- '[^ \t]+[ \t]{1}[^ \t]+10[^ \t]+29[^ \t]+[ \t]{1}[^ \t]+42'
regmatches(ss,regexpr(pattern ,text=ss))
[1] "37-35-1-30-47-9-12-39 5-22-10-29-13-5-17-36 22-43-6-2-27-35-42"

 regexpr(pattern ,text=ss)
[1] 1279
attr(,"match.length")
[1] 62
attr(,"useBytes")
[1] TRUE

Чтобы увидеть это в действии, посмотрите this.

Редактировать Динамически конструировать шаблон

searchep <- '37;10,29;42'       #string given by the user
str1 <- '[^ \t]+[ \t]{1}[^ \t]+' 
str2 <- '[^ \t]'
hh <- gsub(';',str1,searchep)
pattern <- gsub(',',str2,hh)
pattern
[1] "37[^ \t]+[ \t]{1}[^ \t]+10[^ \t]29[^ \t]+[ \t]{1}[^ \t]+42"

test for searchep <- '37;10,29;;40'  ## we skip a line here 

pattern
[1] "37[^ \t]+[ \t]{1}[^ \t]+10[^ \t]29[^ \t]+[ \t]{1}[^ \t]+[^ \t]+[ \t]{1}[^ \t]+40"
regmatches(ss,regexpr(pattern ,text=ss))
"37-35-1-30-47-9-12-39 5-22-10-29-13-5-17-36 22-43-6-2-27-35-42-50 12-31-24-40"

Редактирование результатов теста

matrix.pattern <- function(searchep='37;10,29;42' ){
 str1 <- '[^ \t]+[ \t]{1}[^ \t]+' 
 str2 <- '[^ \t]+'
 hh <- gsub(';',str1,searchep)
 pattern <- gsub(',',str2,hh)
 res <- regmatches(ss,regexpr(pattern ,text=ss))
}

system.time({ss <- paste(apply(bigM,1,function(x) paste(x,collapse='-')),collapse=' ')
             matrix.pattern('37;10,29;42')})
   user  system elapsed 
   2.36    0.01    2.40

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

system.time(matrix.pattern('37;10,29;42'))
   user  system elapsed 
   0.71    0.02    0.72

Ответ 4

Может быть, это поможет кому-то, но что касается ввода, я думал о следующем:

PatternMatcher <- function(data, ...) {
  Selecting procedure here.
}

PatternMatcher(m, c(1, 37, 2, 10, 2, 29, 4, 42))

Вторая часть, поданная в функцию, состоит из строки, в которой она должна начинаться, после чего следует значение, а затем вторая строка и второе значение. Вы также можете сказать, например, 8-я строка после начальной строки со значением 50.

Вы можете даже расширить это, чтобы задать конкретные координаты X, Y для каждого значения (так что 3 элемента переданы функции за значение).

Ответ 5

Edit: Теперь я добавил более обобщенную функцию:

Здесь одно решение, которое дает все возможные комбинации: я получаю все позиции всех четырех чисел, затем использую expand.grid для получения всех комбинаций позиций, а затем filter the meaningless, проверяя, равна ли каждая строка матрицы равным соответствующая строка сортированной матрицы.

set.seed(12345)
m <- matrix(sample(1:50, 800, replace=T), ncol=8)
head(m)
get_grid <- function(in_mat, vec_num) {
    v.idx <- sapply(vec_num, function(idx) {
        which(apply(in_mat, 1, function(x) any(x == idx)))
    })
    out <- as.matrix(expand.grid(v.idx))
    colnames(out) <- NULL
    out
}

out <- get_grid(m, c(37, 10, 29, 42))
out.s <- t(apply(out, 1, sort))

idx <- rowSums(out == out.s)
out.f <- out[idx==4, ]

> dim(out.f)
[1] 2946    4

> head(out.f)
     [,1] [,2] [,3] [,4]
[1,]    1   22   28   36
[2,]    4   22   28   36
[3,]    6   22   28   36
[4,]    9   22   28   36
[5,]   11   22   28   36
[6,]   13   22   28   36

Это индексы строк вхождения чисел в этом порядке (37, 10, 29, 42).

Из этого вы можете проверить любую комбинацию, которую вы хотите. Например, запрошенную комбинацию можно выполнить с помощью:

cont.idx <- apply(out.f, 1, function(x) x[1] == x[2]-1 & x[2] == x[4]-1)
> out.f[cont.idx,]
[1] 57 58 58 59

Ответ 6

Здесь один из способов: sapply:

which(sapply(seq(nrow(m)-2),
             function(x)
               isTRUE(37 %in% m[x,] & 
                      which(10 == m[x+1,]) < which(29 == m[x+1,]) & 
                      42 %in% m[x+2,])))

Результат содержит все номера строк, в которых начинается последовательность:

[1] 57