Как найти все возможные «непрерывные» пути матрицы / сети / графа в R

Question

Мне интересно определить все возможные «непрерывные» пути матрицы NxN в R и вернуть их результат. Под «непрерывным» я подразумеваю, что мы можем путешествовать, не поднимая карандаш / ди git. То есть мы можем двигаться вверх, вниз, влево, вправо или по диагонали.

Чтобы сделать этот бетон, давайте использовать пример матрицы 3x3:

mat_3x3 <- matrix(LETTERS[1:9], ncol = 3, byrow = TRUE)
mat_3x3
#      [,1] [,2] [,3]
# [1,] "A"  "B"  "C" 
# [2,] "D"  "E"  "F" 
# [3,] "G"  "H"  "I" 

Это означает, что у нас есть следующие допустимые и недействительные пути:

Некоторые соображения:

• Начальная позиция не обязательно должна быть позицией A (1, 1).
• Мы не можем "дважды- назад "или прикоснитесь к одной и той же ячейке несколько раз.
• Возможны короткие пути (например, A -> B -> C является допустимым путем; аналогично A -> E -> I) - то есть мы не нужно пройти через все узлы.

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

---

Я полагаю, что ответ на случай 2X2 может быть 60 для следующего решения для одной ячейки с путями = 15; 15 * 4 = 60:

Однако в случае 3x3, 4x4, дело быстро обостряется ... больше не только углы, добавление "центральные" квадраты и т. д. c ...

---

Если мы рассматриваем эту проблему как диаграмму или сеть, для случая 3X3 мы имеем следующее:

Почему, хотя? Я просто искренне заинтересован в этой проблеме и считаю ее увлекательной. Я хотел бы понять, как его запрограммировать в R, но я бы рассмотрел другие ответы, если они существуют (тогда, возможно, переведите их в R). Все началось с мыслительного эксперимента, когда мы думали об «игре», в которой вы двигаете пальцем по сенсорному экрану, чтобы создать слова из цепочки символов. Вместо минимальной стоимости мы хотели бы максимизировать балл - используя Z баллов, больше баллов, чем E, как в Scrabble , et c. Но я предполагаю, что это имеет интересные приложения в социальных сетях, теории графов, оптимизации транспорта и других областях.

Answer 1

Это сработает матрица любого размера (ограниченная аппаратным обеспечением) и не требует, чтобы матрица была прямоугольной angular например, 3 x 4. Она строит матрицу достоверности, в которой все исходные позиции матрицы представлены в виде столбцов, и строка будет верните TRUE, если это верный ход, и FALSE, если нет. Я не проверил все результаты, но выборочные проверки, которые я сделал, сработали.

library(gtools)

# convert matrix to numbers to reference by position
m <- matrix(seq_along(mat_3x3), ncol = ncol(mat_3x3))

# create blank matrix that is used to see if it is a valid move
mLength <- length(m)
mValid <- matrix(rep(FALSE, mLength ^ 2), ncol = mLength)

# create index to generate validity matrix
xIndex <- seq_len(ncol(m))
yIndex <- seq_len(nrow(m))

# wrap with NA to prevent out of bounds
mBounds <- rbind(NA, cbind(NA, m, NA), NA)

# set validity matrix TRUE if returns a value that is not NA
mValid[cbind(as.vector(mBounds[yIndex + 1, xIndex + 2]), seq_len(mLength))] <- TRUE
mValid[cbind(as.vector(mBounds[yIndex + 2, xIndex + 2]), seq_len(mLength))] <- TRUE
mValid[cbind(as.vector(mBounds[yIndex + 2, xIndex + 1]), seq_len(mLength))] <- TRUE
mValid[cbind(as.vector(mBounds[yIndex + 2, xIndex    ]), seq_len(mLength))] <- TRUE
mValid[cbind(as.vector(mBounds[yIndex + 1, xIndex    ]), seq_len(mLength))] <- TRUE
mValid[cbind(as.vector(mBounds[yIndex    , xIndex    ]), seq_len(mLength))] <- TRUE
mValid[cbind(as.vector(mBounds[yIndex    , xIndex + 1]), seq_len(mLength))] <- TRUE
mValid[cbind(as.vector(mBounds[yIndex    , xIndex + 2]), seq_len(mLength))] <- TRUE

# define function to check if provided sequence is valid
validate <- function(x) {
  all(mValid[cbind(x[-1], x[-length(x)])])
}

# generate all permutations
p1 <- permutations(mLength, mLength)
p2 <- apply(p1, 1, validate)
p2 <- p1[p2, ]

# some results
> mat_3x3[p2[1, ]]
[1] "A" "D" "G" "E" "B" "C" "F" "H" "I"

> mat_3x3[p2[531, ]]
[1] "C" "E" "H" "G" "D" "A" "B" "F" "I"

Для генерации других последовательностей, в которых не используются все буквы, потребуется изменить приведенную выше функцию permutations, чтобы ограничить длину целевого вектора :

p1 <- permutations(mLength, mLength - 1)
p2 <- apply(p1, 1, validate)
p2 <- p1[p2, ]

> mat_3x3[p2[1701, ]]
[1] "C" "F" "B" "D" "G" "E" "I" "H"

Использование combinat::permn для использования функции validate при построении перестановок.

library(combinat)
p <- list()
pTemp <- permn(mLength, function(x) x[validate(x)])
p[[mLength]] <- pTemp[lengths(pTemp) > 0]

# breaking all paths that use every option into smaller pieces to find shorter paths
for (i in seq_len(mLength)[-mLength]) {
  pTemp <- lapply(p[[mLength]], function(x, y) embed(rev(x), length(x) - y), y = i)
  p[[mLength - i]] <- unique(do.call(rbind, pTemp))
}

# total number of paths
sum(unlist(lapply(p, nrow)), length(p[[mLength]]))