Znajdowanie określonych ciągów w tablicy przy użyciu R

Question

Próbuję ustalić, czy istnieje szybki sposób wyszukiwania określonych ciągów znaków w tablicach w R, coś w rodzaju gry Boggle, z wyjątkiem tego, że znasz słowo z góry.

Państwo mogą poruszać się w następujących kierunkach do następnej litery napisu: w górę, w dół, w prawo lub w lewo

powiedzieć na prostym przykładzie masz tablicę w postaci:

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

A chcesz zastosować funkcję do G z ciągiem APPLE, dla funkcji, aby powrócić TRUE, APPLE istnieje w tej tablicy i FALSE, jeśli nie.

Czy istnieje gotowa funkcja lub pakiet, który może to zrobić, lub alternatywnie jest inteligentny sposób to zrobić, jestem stosunkowo nowy w radzeniu sobie z ciągami w R i staram się zobaczyć sposób .

Każda pomoc bardzo ceniona. Dzięki.

Answer 1

będzie to najpierw sprawdzić, czy są jakieś znaki w swoim słowie, które nie istnieją w tablicy, a następnie sprawdza, czy liczba znaków w tablicy są wystarczające, aby sprostać powtarzania liter w słowie

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 

dwie ostatnie funkcje będą zarówno wyjście TRUE aby pokazać, że wszystkie litery z word istnieć w pool i że hrabia z jednej litery w word nie jest większa niż pool

w postaci funkcji, która będzie wyjściowaprzypadku stwierdzenia inaczej 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

Funkcja pracuje tylko przy użyciu zasady R

FUNKCJI

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 
} 

ZASTOSOWANIE

#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

Dodanie kolejnego podejścia, mający:

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" 

zaczynamy:

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

który jest prosty -prawdopodobnie unavoidable- poszukiwanie wskaźników „pokładzie” pasujących każdą literę słowa. Jest to „lista” zawierająca indeksy wiersz/COL jak:

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

uwzględniając, że musimy dowiedzieć się, stopniowo, czy indeks w każdym elemencie ma sąsiada (czyli prawo/lewo/góra/dół komórka) w następnym elemencie. Na przykład.musimy coś takiego:

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

który informuje nas, że rząd 3 matches[[1]] jest sąsiadem rzędu 1 matches[[2]], tj [1, 3] i [2, 3] są rzeczywiście sąsiednich komórek. Musimy to dla każdego kolejnego elementu „pasuje”:

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 

Teraz mamy parami („I” z „i + 1”) sąsiad mecze musimy zakończyć łańcuch. W tym przykładzie chcielibyśmy mieć wektor taki jak c(1, 2, 1, 1), który zawiera informację, że wiersz 1 are_neighs[[1]] jest połączony łańcuchem z wierszem 2 z are_neighs[[2]], który jest połączony łańcuchem 1 z are_neighs[[3]], który jest połączony łańcuchem 1 z are_neighs[[4]]. To pachnie jak „igraph” problem, ale nie jestem tak obeznany z nim (mam nadzieję, że ktoś ma lepszy pomysł), więc o to naiwne podejście, aby ta łańcuchowym:

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] 

która zwraca:

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

Mając ten wektor teraz można wyodrębnić odpowiednie łańcucha z „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 

, które można stosować w celu wyodrębnienia odpowiedniego łańcucha wiersz/col o indeksach od „pasuje”:

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 

Zawijanie to wszystko w funkcji (find_neighbours jest zdefiniowana wewnątrz):

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 
} 

Możemy spróbować:

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

A z więcej niż jednego meczy:

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 

Chociaż jest elastyczny zwracając wiele dopasowań, nie zwraca wszystkich możliwych dopasowań i, w dużym skrócie, jest to spowodowane użyciem match podczas budowania łańcucha sąsiadów - zamiast tego można użyć wyszukiwania liniowego, ale w chwili obecnej - dodaje znaczący kod złożoność.

Answer 4

Napisałem poniżej i działa dobrze i szybko, a także można je przetłumaczyć na inne języki.

Biorąc pod uwagę wykres G i słownik, przeszukuje on słownik, a następnie sprawdza, czy G ma litery odpowiadające pierwszej literze każdego słowa, które musi sprawdzić. Następnie sprawdza, czy którykolwiek z sąsiadów, znaleziony przez wskaźniki wartości PRAWDA + DELTA, wartości PRAWDA poprzedniego jest równy 2. słowu. I to trwa.

Jeśli w którymkolwiek momencie okaże się, że nie jest to PRAWDA, funkcja kończy się i zwraca FAŁSZ. Ponadto, jeśli posortujesz słownik według "rzadkości" kombinacji liter, funkcja zadziała znacznie szybciej.

#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) 
    }