Поиск определенных строк в массиве с использованием R

Question

Я пытаюсь найти, если есть быстрый способ поиска определенных строк в массивах в R, как игра Boggle, за исключением того, что вы знаете слово upfront.

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

Say для простого примера у вас есть массив вида:

> G  
A, Q, A, Q, Q, 
A, Q, P, Q, Q, 
Q, Q, P, L, Q, 
Q, Q, Q, E, Q 

И вы хотите применить функцию к G со строкой APPLE, для функции возврата TRUE, APPLE существует в этом массиве и FALSE, если это не так.

Существует ли предварительно созданная функция или пакет, который может это сделать, или, альтернативно, есть разумный способ сделать это, я относительно новичок в работе со строками в R, и я изо всех сил пытаюсь найти способ ,

Любая помощь очень ценится. Благодарю.

Answer 1

это будет первым проверить, есть ли какие-либо символы в вашем слове, которое не существует в массиве, а затем будет проверять, если количество символов в массиве достаточно для удовлетворения повторяющихся букв в слове

word <- strsplit("APPLE", "") 
pool <- c("A", "Q", "A", "Q", 
      "Q", "A", "Q", "P", 
      "Q", "Q", "Q", "Q", 
      "P", "L", "Q", "Q", 
      "Q", "Q", "E", "Q") 

t.word <- table(word) 
t.pool <- table(pool) 

length(setdiff(names(t.word), names(t.pool))) == 0 
min(t.pool[names(t.word)] - t.word) >= 0 

последние две функции будут как выход TRUE, чтобы показать, что все письма word существуют в pool и что подсчет одной буквы в word не больше, чем у pool

в виде функции, которая будет выводить TRUE, если найдено, в противном случае FALSE

word.find <- function(word, pool) { 
    t.word <- table(strsplit(word, "")) 
    t.pool <- table(pool) 
    length(setdiff(names(t.word), names(t.pool))) == 0 & min(t.pool[names(t.word)] - t.word) >= 0 
} 

word.find("APPLE", pool) 
[1] TRUE 

word.find("APPLES", pool) 
[1] FALSE 

word.find("APPLEE", pool) 
[1] FALSE 

Answer 2

Эта функция работает с использованием только базового R

ФУНКЦИИ

search_string = function(matrix_array, word_to_search){ 

    position = data.frame(NA,NA,NA) #Create empty dataframe 

    word_to_search_inv = sapply(lapply(strsplit(word_to_search, NULL), rev), paste, collapse="") #Reverse word_to_search 

    for (i in 1:nrow(matrix_array)){ 
     str_row = paste((matrix_array[i,]),collapse = "") #Collapse entire row into a string 
     if (grepl(word_to_search,str_row)) { #Check if the word_to_search is in the string towards right 
      position = rbind(position,c(i,paste(gregexpr(word_to_search, str_row)[[1]], collapse = ', '),"RIGHT")) #Get position and add it to the dataframe  
     } 
     if (grepl(word_to_search_inv,str_row)) {#Check if the word_to_search is in the string towards left (by checking for reverse of word_to_search) 
      position = rbind(position,c(i,paste(gregexpr(word_to_search_inv, str_row)[[1]], collapse = ', '),"LEFT"))  
     } 
    } 

    for (j in 1:ncol(matrix_array)){   
     str_column = paste((matrix_array[,j]),collapse = "") 
     if (grepl(word_to_search, str_column)) { #Check if the word_to_search is in the string towards down 
      position = rbind(position, c(paste(gregexpr(word_to_search, str_column)[[1]], collapse = ', '),j,"DOWN")) 
     } 
     if (grepl(word_to_search_inv, str_column)) { #Check if the word_to_search is in the string towards up 
      position = rbind(position, c(paste(gregexpr(word_to_search_inv, str_column)[[1]], collapse = ', '),j,"UP")) 
     } 
    } 

    colnames(position) = c("ROW","COLUMN","DIRECTION") 
    position = position[c(2:nrow(position)),] 
    rownames(position) = NULL 
    return(position) #Return the datafram containing row, columnm, and direction where word_to_match is found 
} 

ПРИМЕНЕНИЕ

#Data 
mydata = structure(c("A", "A", "Q", "Q", "D", "Q", "Q", "Q", "Q", "B", 
        "A", "P", "P", "L", "E", "Q", "Q", "L", "E", "S", "Q", "Q", "Q", 
        "Q", "T", "A", "P", "P", "L", "E"), .Dim = c(5L, 6L), .Dimnames = list(NULL, c("V1", "V2", 
                      "V3", "V4", "V5", "V6"))) 

key = "APPLE" 

#Run the function 
pos = search_string(mydata,key) 

Answer 3

Добавление другого подхода, имеющий:

board = structure(c("A", "A", "Q", "Q", "Q", "Q", "Q", "Q", "A", "P", 
"P", "Q", "Q", "Q", "L", "E", "Q", "Q", "Q", "Q"), .Dim = 4:5, .Dimnames = list(
    NULL, NULL)) 

word = "APPLE" 

мы начинаем с:

matches = lapply(strsplit(word, NULL)[[1]], function(x) which(x == board, arr.ind = TRUE)) 

, которая является простым -Наверное unavoidable- поиском индексов «доски», которые соответствуют каждой букве слова. Это «список», содержащий индексы строк/COL, как:

#[[1]] 
#  row col 
#[1,] 1 1 
#[2,] 2 1 
#[3,] 1 3 
# 
#[[2]] 
#  row col 
#[1,] 2 3 
#[2,] 3 3 
# 
##..... 

Имея это, мы должны выяснить, постепенно, имеет ли индекс в каждом элементе соседа (т.е. вправо/влево/вверх/вниз ячейка) в следующем элементе. Например.нам нужно что-то вроде:

as.matrix(find_neighbours(matches[[1]], matches[[2]], dim(board))) 
#  [,1] [,2] 
#[1,] FALSE FALSE 
#[2,] FALSE FALSE 
#[3,] TRUE FALSE 

, который сообщает нам, что строка 3 из matches[[1]] является соседом ряда 1 из matches[[2]], т.е. [1, 3] и [2, 3], действительно, соседние клетки. Нам это нужно для каждого последующего элемента «спичек»:

are_neighs = Map(function(x, y) which(find_neighbours(x, y, dim(board)), TRUE), 
       matches[-length(matches)], matches[-1]) 
are_neighs 
#[[1]] 
#  [,1] [,2] 
#[1,] 3 1 
# 
#[[2]] 
#  [,1] [,2] 
#[1,] 2 1 
#[2,] 1 2 
# 
#[[3]] 
#  [,1] [,2] 
#[1,] 2 1 
# 
#[[4]] 
#  [,1] [,2] 
#[1,] 1 1 

Теперь, когда мы имеем парно («я» с «я + 1») соседа совпадает мы должны завершить цепочку. В этом примере мы хотели бы иметь такой вектор, как c(1, 2, 1, 1), который содержит информацию о том, что строка 1 из are_neighs[[1]] связана цепью с строкой 2 из are_neighs[[2]], которая прикована к строке 1 из are_neighs[[3]], которая прикована к строке 1 из are_neighs[[4]]. Это пахнет проблемы «igraph», но я не так хорошо знаком с ним (надеюсь, кто-то есть идея получше), так вот наивный подход, чтобы получить, что цепочки:

row_connections = matrix(NA_integer_, nrow(are_neighs[[1]]), length(are_neighs)) 
row_connections[, 1] = 1:nrow(are_neighs[[1]]) 
cur = are_neighs[[1]][, 2] 
for(i in 1:(length(are_neighs) - 1)) { 
    im = match(cur, are_neighs[[i + 1]][, 1]) 
cur = are_neighs[[i + 1]][, 2][im] 
row_connections[, i + 1] = im 
} 
row_connections = row_connections[complete.cases(row_connections), , drop = FALSE] 

который возвращает:

row_connections 
#  [,1] [,2] [,3] [,4] 
#[1,] 1 2 1 1 

Имея этот вектор, теперь мы можем извлечь соответствующую цепочку из «are_neighs»:

Map(function(x, i) x[i, ], are_neighs, row_connections[1, ]) 
#[[1]] 
#[1] 3 1 
# 
#[[2]] 
#[1] 1 2 
# 
#[[3]] 
#[1] 2 1 
# 
#[[4]] 
#[1] 1 1 

, которые могут быть использованы для извлечения соответствующей строки/COL цепочки индексов от «совпадений»:

ans = vector("list", nrow(row_connections)) 
for(i in 1:nrow(row_connections)) { 
    connect = Map(function(x, i) x[i, ], are_neighs, row_connections[i, ]) 
    ans[[i]] = do.call(rbind, Map(function(x, i) x[i, ], matches, c(connect[[1]][1], sapply(connect, "[", 2)))) 
} 
ans 
#[[1]] 
#  row col 
#[1,] 1 3 
#[2,] 2 3 
#[3,] 3 3 
#[4,] 3 4 
#[5,] 4 4 

Обертывание все это в функции (find_neighbours определяется внутри):

library(Matrix) 
ff = function(word, board) 
{ 
    matches = lapply(strsplit(word, NULL)[[1]], function(x) which(x == board, arr.ind = TRUE)) 

    find_neighbours = function(x, y, d) 
    { 
     neighbours = function(i, j, d = d) 
     { 
      ij = rbind(cbind(i, j + c(-1L, 1L)), cbind(i + c(-1L, 1L), j)) 
      ijr = ij[, 1]; ijc = ij[, 2] 
      ij = ij[((ijr > 0L) & (ijr <= d[1])) & ((ijc > 0L) & (ijc <= d[2])), ] 

      ij[, 1] + (ij[, 2] - 1L) * d[1] 
     } 

     x.neighs = lapply(1:nrow(x), function(i) neighbours(x[i, 1], x[i, 2], dim(board))) 
     y = y[, 1] + (y[, 2] - 1L) * d[1] 

     x.sparse = sparseMatrix(i = unlist(x.neighs), 
           j = rep(seq_along(x.neighs), lengths(x.neighs)), 
           x = 1L, dims = c(prod(d), length(x.neighs))) 
     y.sparse = sparseMatrix(i = y, j = seq_along(y), x = 1L, dims = c(prod(d), length(y)))       

     ans = crossprod(x.sparse, y.sparse, boolArith = TRUE) 

     ans 
    }  

    are_neighs = Map(function(x, y) which(find_neighbours(x, y, dim(board)), TRUE), matches[-length(matches)], matches[-1]) 

    row_connections = matrix(NA_integer_, nrow(are_neighs[[1]]), length(are_neighs)) 
    row_connections[, 1] = 1:nrow(are_neighs[[1]]) 
    cur = are_neighs[[1]][, 2] 
    for(i in 1:(length(are_neighs) - 1)) { 
     im = match(cur, are_neighs[[i + 1]][, 1]) 
     cur = are_neighs[[i + 1]][, 2][im] 
     row_connections[, i + 1] = im 
    } 
    row_connections = row_connections[complete.cases(row_connections), , drop = FALSE] 

    ans = vector("list", nrow(row_connections)) 
    for(i in 1:nrow(row_connections)) { 
     connect = Map(function(x, i) x[i, ], are_neighs, row_connections[i, ]) 
     ans[[i]] = do.call(rbind, Map(function(x, i) x[i, ], matches, c(connect[[1]][1], sapply(connect, "[", 2)))) 
    } 
    ans 
} 

Мы можем попробовать:

ff("APPLE", board) 
#[[1]] 
#  row col 
#[1,] 1 3 
#[2,] 2 3 
#[3,] 3 3 
#[4,] 3 4 
#[5,] 4 4 

И с более чем матчей:

ff("AQQP", board) 
#[[1]] 
#  row col 
#[1,] 1 1 
#[2,] 1 2 
#[3,] 2 2 
#[4,] 2 3 
# 
#[[2]] 
#  row col 
#[1,] 1 3 
#[2,] 1 2 
#[3,] 2 2 
#[4,] 2 3 
# 
#[[3]] 
#  row col 
#[1,] 1 3 
#[2,] 1 4 
#[3,] 2 4 
#[4,] 2 3 

Хотя, это гибкий при возвращении нескольких совпадений он не возвращает все возможные совпадения и, в двух словах, из-за использования match при построении цепочки соседей - вместо этого можно использовать линейный поиск, но в данный момент добавляет значительный код сложность.

Answer 4

Я написал ниже, и он работает хорошо и быстро, а также может быть переведен на другие языки.

С учетом графа G и словаря он выполняет поиск по словарю, а затем проверяет, имеет ли G буквы, соответствующие первой букве каждого слова, которое необходимо проверить. Затем он проверяет, равен ли один из соседей, найденный по индексам TRUE значений + delta, значений TRUE предыдущего, 2-го слова. И это продолжается.

Если в любой момент это не будет TRUE, функция завершается и возвращает FALSE. Кроме того, если вы отсортируете словарь по «значению» комбинаций букв, функция будет работать намного быстрее.

#function to check if a word appears in a graph 
dict_check <- function(dictionary, G) { 

#Run thru dictionary and check if word is G 
#If at any point after a word check, it doesn't appear, break and return FALSE 

n <- length(dictionary) 
count_1 <- 0 #sum of words checked 
count_2 <- 0 #sum of words successfully found 
delta <- matrix(c(-1, 0, 1, 0, 
        0, -1, 0, 1), 
        byrow = T, nrow = 4, ncol = 2) 

for (dc in 1:n) { 
word <- dictionary[dc] 

#Add 1 for each word checked 
count_1 <- count_1 + 1 

#Split word into a vector 
W <- unlist(strsplit(word, "")) 

#Boolean matrix for 1st letter of word, if not there, end and return False 
G_bool <- G == W[1] 
if(sum(G_bool) == 0) { 
    return(FALSE) 
} 

#Fetch indices of True values for 1st letter of word 
I <- which(G_bool == T, arr.ind = T) 

#Loop thru word and check if neighbours match next letter of word, 
#for all letters of word 
#if at any point after iteration of a letter in word whereby G is all False, 
#return False for word_check 

last <- length(W) 
for (w in 2:last) { 

    #For each index in I, check if wordbox range, 
    #and check if neighbours ar equal to W[2, ...] 
    for (i in 1:nrow(I)) { 
    for (d in 1:nrow(delta)) { 
     #neighbour 
     k <- I[i, ] + delta[d, ] 

     #If neighbour is out of bounds of box then move onto next neighbour 
     #Each valid neighbour checked if is equal to next letter of word 
     #If it is equal set to neighbour to TRUE, and original position to FALSE 
     #If neighbour doesn't equal next letter, make original position FALSE anyway 
     G_bool[I[i, 1], I[i, 2]] <- FALSE #Set original position to FALSE 
     if (k[1] == 0 | k[1] > nrow(G) | k[2] == 0 | k[2] > ncol(G)) { 
     next} else if (G[k[1], k[2]] == W[w]) { 
      G_bool[k[1], k[2]] <- TRUE #Set neighbour to TRUE 
     } 
     } 
    } 
    #Check after each iteration of letter if any letters of subsequent 
    #letters appear, if yes, continue to next letter of word, if no, return 
    #FALSE for word check 
    if (sum(G_bool) == 0) { 
     return(FALSE) 
    } 
    #Update indices I for next TRUE in G_bool, corresponding to next letters found 
    I <- which(G_bool == T, arr.ind = T) 
    } 
    #Final check after word iteration is complete on G_bool 
    if (sum(G_bool) == 0) { 
    return(FALSE) 
    } else if (sum(G_bool) > 0) { 
    count_2 <- count_2 + 1 #Add 1 to count_2 if word successfully found 
    } 
    if (count_1 != count_2) { 
    return(FALSE) 
    } 
    } 
    #Final check 
    if (count_1 != count_2) { 
    return(FALSE) 
    } else 
    return(TRUE) 
    }