来自 2D 阵列的高效连接组件

Question

在由

m x n

和

0

组成的

1

矩阵中，我们的任务是计算 4 个方向相连的

1

岛。 python实现如下：

    def numIslands(grid):
        def sink(i, j):
            if 0 <= i < len(grid) and 0 <= j < len(grid[i]) and grid[i][j] == '1':
                grid[i][j] = '0'
                list(map(sink, (i+1, i-1, i, i), (j, j, j+1, j-1)))
                return 1
            return 0
        return sum(sink(i, j) for i in range(len(grid)) for j in range(len(grid[i])))

我尝试在 Haskell 中解决这个问题，但在以下限制下失败了：

• O(mn)

  时间复杂度
• 仅使用纯函数
• ~48 个令牌或更少（以上大小根据

  wc -w

  ）

我尝试过的事情：

• 返回森林的自定义 DFS 函数

• scc

  来自

  Data.Graph

• dfsForest

  来自

  algebraic-graphs

所有情况下的问题都是将矩阵转换为任何漂亮的图形表示（我们可以调用库函数）的管道代码总是太长。

在这里您可以看到使用

Algebra.Graph.AdjacencyMap

的有效实现，它做了很多多余的工作：

data Coord = C Int Int deriving (Eq, Ord, Show)
data Cell a = Cell Coord a deriving (Eq, Ord)
type A = Cell Char

coord :: Cell a -> Coord
coord (Cell c _) = c

mkcell :: Int -> Int -> a -> Cell a
mkcell i j = Cell (C i j)

cells :: [[a]] -> [[Cell a]]
cells = zipWith (map . uncurry . mkcell) [0..] . map (zip [0..])

is1 :: A -> Bool
is1 (Cell _ '1') = True
is1 (Cell _  _ ) = False

cardinals :: Coord -> [Coord]
cardinals c = map ($ c) [up, down, left, right]
  where
    up    (C i j) = C (i+1) j
    down  (C i j) = C (i-1) j
    left  (C i j) = C i (j-1)
    right (C i j) = C i (j+1)

coordMap :: [[a]] -> Map Coord [a]
coordMap board = M.fromAscList [(C i j, [z]) | (i,zs) <- zip [0..] board, (j,z) <- zip [0..] zs]

mkstars :: [[A]] -> [(A, [A])]
mkstars xss = map (id &&& nbs) $ ones =<< xss
  where
    ones  = filter is1
    value = flip (M.findWithDefault []) (coordMap xss)
    nbs   = ones . value <=< cardinals . coord

islands :: [[Char]] -> Int
islands = length . dfsForest . stars . mkstars . cells

还有一些简单的测试用例：

main :: IO ()
main = do
  hspecWith defaultConfig {configFailFast = True} $ do
    describe "islands" $ do

      it "handles test case 0" $ do
        islands [ ['1', '1', '1', '1', '0']
                , ['1', '1', '0', '1', '0']
                , ['1', '1', '0', '0', '0']
                , ['0', '0', '0', '0', '0'] ] `shouldBe` 1

      it "handles test case 1" $ do
        islands [ ['1', '1', '0', '0', '0']
                , ['1', '1', '0', '0', '0']
                , ['0', '0', '1', '0', '0']
                , ['0', '0', '0', '1', '1'] ] `shouldBe` 3

      it "handles test case 2" $ do
        islands [['1']] `shouldBe` 1

请注意，我们在两个地方执行了一对类似

zip [0..]

的操作。我想这应该是没有必要的。根据 vim，这以

220

标记计时，甚至不包括

dfsForest

逻辑或

Data.Map.Strict

中的内容！ Haskell 中的编程竟然如此冗长和复杂，这感觉很荒谬，所以我希望这只是一个技能问题。

有人能指出我正确的方向吗？我也很高兴得到这样的答案：“这是不可能的，但[这里]是我们能做的最好的事情。”

如果有帮助的话，最终我的目标是提出一种标准方法，用于非常简洁地将二维数组问题编组为与

containers

、

algebraic-graphs

或

fgl

中实现的图形算法兼容的格式。虽然现在

algebraic-graphs

中的东西对我来说看起来最好。

Answer 1

这是一个相当简洁的实现：

{-# Language BlockArguments #-}

import Data.Partition
import Data.Vector (Vector)
import qualified Data.Set as S
import qualified Data.Vector as V

islands :: Vector (Vector Bool) -> Int
islands = length . nontrivialSets . fromSets . V.toList . V.concat . V.toList . createEqualities where
    createEqualities grid =
        flip V.imap grid \i row ->
        flip V.imap row \j val -> S.fromList
        [ (i',j',lmao)
        | val
        , (i',j') <- [(i,j), (i-1,j), (i+1,j), (i,j-1), (i,j+1)]
        , or (grid V.!? i' >>= (V.!? j'))
        , lmao <- "01"
        ]

这使用

data-partition

并产生对数开销，这在将可变算法简单地转换为不可变类似物时很常见，因此运行时间为 O(mn log(mn))。^*

lmao

变量的大小加倍每个岛屿；

nontrivialSets

仅报告大小严格大于 1 的集合，并且我们希望报告其中只有一个节点的岛屿。

查看它在 ghci 中运行：

> islands . fmap (fmap ('1'==)) . read $ "[\"11000\", \"11000\", \"00100\", \"00011\"]"
3

---

^* 众所周知，任何可变算法都可以通过 O(log n) 乘法惩罚变得纯粹；我相信是否存在任何可证明需要这种惩罚的问题是一个悬而未决的问题，因此很可能比我更聪明的理论家可以从这里改进！