如何在R中找到矩阵/网络/图形的所有可能的“连续”路径

Question

我有兴趣确定 R 中 NxN 矩阵的所有可能的“连续”路径并返回它们的结果。“连续”是指我们可以在不抬起您的铅笔/数字的情况下旅行。也就是说，我们可以向上、向下、向左、向右或对角移动。

为了具体说明，让我们使用一个 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）——也就是说，我们不需要通过所有节点。

如果有方便的包或概念，请指教（我见过的图遍历包大多是“图”而不是“矩阵”）。我想动态编程或递归可能在这里有用，但我不确定如何开始。

---

我相信对于路径 = 15 的一个单元格，对于 2X2 情况，每个以下解决方案的答案可能是 60；15 * 4 = 60：

但是，对于 3x3、4x4 的情况，情况会迅速升级……不再只是角落，添加“中心”方块等……

---

如果我们将此问题更多地视为图形或网络，那么对于 3X3 情况，我们有以下内容：

为什么？ 我只是对这个问题真正感兴趣，并觉得它很有趣。我想了解如何给它编程R，但如果它们存在（那么也许翻译他们我会考虑其他的答案R）。它最初是一个思考“游戏”的思想实验，您可以在其中在触摸屏上滑动手指以从字符串中创建单词。我们希望得分最大化，而不是最低成本，而是在Scrabble等中使用Z比同类更多的分数。但我认为这在社交网络、图论、交通优化和其他领域有有趣的应用。E

Answer 1

这将适用于任何大小的矩阵（受硬件限制），并且不需要矩阵是矩形，例如 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]]))