Haskell实现：判断坐标路径对是否构成连通图

我们可以把问题拆解为几个核心步骤，逐步实现isConnected函数：

1. 实现路径连通性判断的核心辅助函数 #

首先需要判断两条路径（线段）是否存在公共点，这包含三种情况：共享端点、其中一条的端点在另一条线段上、两条线段相交。

1.1 判断点是否在线段上 #

-- 检查点(x,y)是否在线段((x1,y1), (x2,y2))上
pointOnSegment :: (Integer, Integer) -> ((Integer, Integer), (Integer, Integer)) -> Bool
pointOnSegment (x,y) ((x1,y1), (x2,y2)) =
  -- 先判断点在 bounding box 范围内
  (min x1 x2 <= x && x <= max x1 x2) &&
  (min y1 y2 <= y && y <= max y1 y2) &&
  -- 叉积为0说明点与线段共线
  (x - x1) * (y2 - y1) == (y - y1) * (x2 - x1)

1.2 判断两条线段是否相交（非端点重合） #

-- 计算三个点的叉积，用于判断方向
crossProduct :: (Integer, Integer) -> (Integer, Integer) -> (Integer, Integer) -> Integer
crossProduct (x1,y1) (x2,y2) (x3,y3) = (x2 - x1)*(y3 - y1) - (y2 - y1)*(x3 - x1)

direction :: (Integer, Integer) -> (Integer, Integer) -> (Integer, Integer) -> Integer
direction = crossProduct

-- 判断点q是否在线段pr上（用于处理相交的特殊情况）
onSegment :: (Integer, Integer) -> (Integer, Integer) -> (Integer, Integer) -> Bool
onSegment p q r =
  (min (fst p) (fst r) <= fst q && fst q <= max (fst p) (fst r)) &&
  (min (snd p) (snd r) <= snd q && snd q <= max (snd p) (snd r))

-- 判断两条线段是否相交（非端点重合场景）
segmentsIntersect :: ((Integer, Integer), (Integer, Integer)) -> ((Integer, Integer), (Integer, Integer)) -> Bool
segmentsIntersect (p1,p2) (p3,p4) =
  let d1 = direction p3 p4 p1
      d2 = direction p3 p4 p2
      d3 = direction p1 p2 p3
      d4 = direction p1 p2 p4
      -- 一般情况：两条线段互相跨立
      generalCase = (d1 * d2 < 0) && (d3 * d4 < 0)
      -- 特殊情况：端点落在另一条线段上（已被pathsConnected前置条件覆盖，保留兼容）
      specialCase = (d1 == 0 && onSegment p3 p1 p4) ||
                    (d2 == 0 && onSegment p3 p2 p4) ||
                    (d3 == 0 && onSegment p1 p3 p2) ||
                    (d4 == 0 && onSegment p1 p4 p2)
  in generalCase || specialCase

1.3 判断两条路径是否连通 #

pathsConnected :: ((Integer, Integer), (Integer, Integer)) -> ((Integer, Integer), (Integer, Integer)) -> Bool
pathsConnected p1@(a,b) p2@(c,d) =
  -- 任意端点落在对方线段上，或线段直接相交
  pointOnSegment a p2 || pointOnSegment b p2 ||
  pointOnSegment c p1 || pointOnSegment d p1 ||
  segmentsIntersect p1 p2

2. 实现全局连通性判断 #

我们可以用**广度优先搜索（BFS）**遍历所有连通的路径，最后检查是否覆盖了列表中所有路径：

import Data.List (delete)

-- 从起始路径出发，找到所有连通的路径
findConnected :: [((Integer, Integer), (Integer, Integer))] -> ((Integer, Integer), (Integer, Integer)) -> [((Integer, Integer), (Integer, Integer))]
findConnected paths start = bfs [start] []
  where
    bfs [] visited = visited
    bfs (current:rest) visited =
      let -- 筛选未访问且与当前路径连通的邻居
          neighbors = filter (\p -> p `notElem` visited && pathsConnected current p) paths
          newRest = rest ++ filter (`notElem` visited) neighbors
          newVisited = current : visited
      in bfs newRest newVisited

-- 主函数：判断所有路径是否属于同一个连通分量
isConnected :: [((Integer, Integer), (Integer, Integer))] -> Bool
isConnected [] = True  -- 空列表默认连通，可根据需求调整
isConnected (first:rest) =
  let allConnectedPaths = findConnected (first:rest) first
  in length allConnectedPaths == length (first:rest)

3. 测试示例 #

-- 连通示例，应返回True
example1 :: [((Integer, Integer), (Integer, Integer))]
example1 = [((0,0),(0,3)), ((0,2),(2,2)), ((2,1),(4,1)),
            ((4,0),(4,2)), ((4,2),(5,2)), ((2,1),(2,5)),
            ((1,5),(4,5))]

-- 非连通示例，应返回False
example2 :: [((Integer, Integer), (Integer, Integer))]
example2 = [((0,0),(0,3)), ((0,2),(2,2)), ((2,1),(4,1)),
            ((4,0),(4,2)), ((4,2),(5,2)), ((2,1),(2,5)),
            ((4,5),(5,5))]

可选优化：并查集（Union-Find） #

如果处理大规模路径列表，BFS的elem操作效率较低，可以用并查集优化：

import Data.Map (Map)
import qualified Data.Map as Map
import Data.List (nub)

type UnionFind = Map Int Int

-- 查找节点根，带路径压缩
find :: UnionFind -> Int -> (UnionFind, Int)
find uf x =
  case Map.lookup x uf of
    Just parent | parent /= x ->
      let (uf', root) = find uf parent
      in (Map.insert x root uf', root)
    Just parent -> (uf, parent)
    Nothing -> (Map.insert x x uf, x)

-- 合并两个节点
union :: UnionFind -> Int -> Int -> UnionFind
union uf x y =
  let (uf', rootX) = find uf x
      (uf'', rootY) = find uf' y
  in if rootX == rootY then uf'' else Map.insert rootY rootX uf''

isConnectedUnionFind :: [((Integer, Integer), (Integer, Integer))] -> Bool
isConnectedUnionFind [] = True
isConnectedUnionFind paths =
  let initialUF = Map.fromList [(i,i) | i <- [0..length paths -1]]
      mergedUF = foldl (\uf (i,j) -> if pathsConnected (paths!!i) (paths!!j) then union uf i j else uf)
                      initialUF
                      [(i,j) | i <- [0..length paths-1], j <- [i+1..length paths-1]]
      roots = snd . unzip $ Map.toList $ snd $ foldl (\(uf,_) i -> find uf i) (mergedUF, 0) [0..length paths-1]
  in length (nub roots) == 1

内容的提问来源于stack exchange，提问作者Student