Adding another approach, having:
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"
we start with:
matches = lapply(strsplit(word, NULL)[[1]], function(x) which(x == board, arr.ind = TRUE))
which is a simple -probably unavoidable- search of indices of "board" that match each letter of the word. It's a "list" containing the row/col indices like:
#[[1]]
# row col
#[1,] 1 1
#[2,] 2 1
#[3,] 1 3
#
#[[2]]
# row col
#[1,] 2 3
#[2,] 3 3
#
##.....
Having that, we need to find out, progressively, whether an index in each element has a neighbour (i.e. the right/left/up/down cell) in the next element. E.g. we need something like:
as.matrix(find_neighbours(matches[[1]], matches[[2]], dim(board)))
# [,1] [,2]
#[1,] FALSE FALSE
#[2,] FALSE FALSE
#[3,] TRUE FALSE
which informs us, that the row 3 of matches[[1]] is a neighbour of row 1 of matches[[2]], i.e. [1, 3] and [2, 3] are, indeed, neighbouring cells. We need this for each successive element in "matches":
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
Now that we have the pairwise ("i" with "i + 1") neighbour matches we need to complete the chain. For this example we'd like to have a vector like c(1, 2, 1, 1) which contains the info that the row 1 of are_neighs[[1]] is chained with the row 2 of are_neighs[[2]] which is chained with row 1 of are_neighs[[3]] which is chained with row 1 of are_neighs[[4]]. This smells like an "igraph" problem, but I'm not so familiar with it (hopefully someone has a better idea), so here's a naive approach to get that chaining:
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]
Which returns:
row_connections
# [,1] [,2] [,3] [,4]
#[1,] 1 2 1 1
Having this vector, now, we can extract the respective chain from "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
which can be used to extract the appropriate row/col chain of indices from "matches":
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
Wrapping it all in a function (find_neighbours is defined inside):
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
}
We can try it:
ff("APPLE", board)
#[[1]]
# row col
#[1,] 1 3
#[2,] 2 3
#[3,] 3 3
#[4,] 3 4
#[5,] 4 4
And with more than one matches:
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
Although, it's flexible in returning multiple matches, it does not return all possible matches and, in a nutshell, that's because of the use of match when building the chain of neighbours -- a linear search could be used instead, but -at the moment- adds significant code complexity.
