0

我编写了一个程序来生成平面图的正交表示。对于这项工作,我使用 GHC 6.10.1。我的代码基于 FGL 库。它用于保持图形结构。

最近我发现了一个我无法解释的错误。如果删除我的程序的上下文作业,那么:

main = let g = insEdge (0,1,()) $ buildGr [ ([], 0, (), []), ([], 1, (), []) ]
           g' = delEdge (0,1) g
        在 if 1 `elem` suc g 0
              然后把StrLn“确定”
              否则 putStrLn “错误”

该程序必须打印“OK”但结果是“ERROR”

这里更详细。函数 prepareData 得到一个带有帮助边的图。Data BlockScheme 也将他们的数据保存在cyclesInfoBS 列表中。这些边需要函数 dualGraph 的算法。

函数 prepareG 从删除这些边的图形中构建新图形。并且 EmbeddedBSG 变量的值必须在任何地方都相同。

但是 dualGraph 工作时会发生错误。内部跟踪表示该图没有帮助边(2,1),但在调用 dualGraph 之前,它的图参数有帮助边。dualGraph 的模块既没有 delEdge 也没有 delEdge 也没有 delNodes 也没有 delNode 并且没有调用要执行此操作的函数。dualGraph 的模块只读取图形变量。

如果注释代码删除帮助边缘,那么它们会留下来。

dualGraph之前的图状态:

__+嵌入式BSG =
0:NodeLabel {typeLabel = Terminator, sizeLabel = (30.0,10.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF}->[((1,3),3)]
1:NodeLabel {typeLabel = Terminator, sizeLabel = (30.0,10.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF}->[]
2:NodeLabel {typeLabel = HelpNode, sizeLabel = (0.0,0.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF}->[((2,0),1)]
3:NodeLabel {typeLabel = IfWhBlock, sizeLabel = (30.0,20.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF}->[(((1,0),2),((2,2),1 ),((0,1),4)]
4:NodeLabel {typeLabel = OpBlock, sizeLabel = (30.0,20.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF}->[((0,1),2)]

将图的状态转换为 DualGraph 模块:

0:(0.0,NodeLabel {typeLabel = Terminator, sizeLabel = (30.0,10.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF})->[((1,3),3)]
1:(30.0,NodeLabel {typeLabel = Terminator, sizeLabel = (30.0,10.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF})->[]
2:(45.0,NodeLabel {typeLabel = HelpNode, sizeLabel = (0.0,0.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF})->[]
3:(15.0,NodeLabel {typeLabel = IfWhBlock, sizeLabel = (30.0,20.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF})->[((2,2),1),((1, 0),2),((0,1),4)]
4:(35.0,NodeLabel {typeLabel = OpBlock, sizeLabel = (30.0,20.0), textLabel = (), foregroundLabel = 0x000000, backgroundLabel = 0xFFFFFF})->[((0,1),2)]
allEdges: = [(OutEdge,(2,(0,1))),(InEdge,(3,(0,1)))]

第二状态的节点 2 没有任何传出边。

DualGraph中有一个检测错误的地方是函数lSortSuc。

lSortSuc vertexId graph =.... 它要求 vertexId 的顶点至少有 1 个入边和 1 个出边,或者它是 sink 节点。在这种情况下,sink 节点为 1。

然后它可以假设 lSortSuc 在没有节点 2 的帮助边的图的某个地方被调用。但事实并非如此。

有人有什么想法吗?我能做些什么?

类型 BlockSchemeGraph = Gr NodeLabel ()

数据周期信息 =
    循环信息 {
        reversedEdge :: 边缘,
        帮助边缘 :: 边缘
    } 推导 (Show, Eq)

数据 BlockScheme = BlockScheme { graphBS :: BlockSchemeGraph,
                                 循环信息BS :: [循环信息],
                                 generalSchemeOptionsBS :: (),
                                 backBonesBS :: [[节点]]
                                } 推导 (Show, Eq)


准备数据 bs =
 让 bsg = graphBS bs
     [ sink, source ] = map head $ pam bsg [ getSinks, getSources ]
     [帮助节点] = newNodes 1 bsg
     helpEdges = [ (source,helpNode), (helpNode, sink) ]
     bsg' = insEdges [ (a,b, ()) | (a,b) (l, 0.0) )
                           -- 这里的帮助边被删除
              $ foldr (\cinf g -> delEdge (helpEdge cinf) g)
                      (trace ("\n\nembG = " ++ show embG) embG)
                      周期信息
     f (v, 高度) g =
       让 fsuc (w, (order, weight)) g =
              setELabel' (v,w) (顺序, 重量 + 高度/2) g
           fpre (w, (order, weight)) g =
              setELabel' (w,v) (顺序, 重量 + 高度/2) g
           g' = 折叠 fsuc g $ lsuc gv
        在文件夹 fpre g' $ lpre g' v
  在 emap (\(order, weight) -> (order, {-round-} weight))
          . 文件夹 f embG'
          . 地图 (\n -> (n, snd . sizeLabel $ getVLabel n embG))
          $ 节点 embG

-------------------------------------------------- ---------------------
{-# LANGUAGE ScopedTypeVariables #-}
模块 GraphVisualiser  
#如果定义(MYDEBUG)
#别的
 (可视化方案,块方案图像)
#万一
    在哪里

导入 SimpleUtil (map2,swap,pam, vopt, compareDouble)
导入 Data.Maybe (fromJust,isJust)
导入 Data.List (foldl',find, nubBy, deleteFirstsBy, maximumBy)
导入合格的 Data.Map 作为 Map
导入方案编译器
导入 InductivePlus
导入 GraphEmbedder
导入 DualGraph
导入拓扑编号
导入 Text.Printf (printf)
导入 Debug.Trace

类型 NodePosition =(双,双)
键入 EdgePosition = [ 节点位置 ]

类型 BSIG = Gr (NodePosition, NodeLabel) EdgePosition
newtype BlockSchemeImage = BlkScmImg BSIG 推导方程

getWeight = fst
visualiseScheme :: BlockScheme -> BlockSchemeImage
可视化方案 bs =
 let (numEmbBsg, numDualBsg, emf, nmf, source, sink) = prepareData bs

     xCoords = map (calcXForBackBone (numEmbBsg, numDualBsg, emf, nmf)) $ backBonesBS bs
     calcedNodes = calcNodePositions numEmbBsg numDualBsg nmf emf source sink xCoords
     calcedEdges = calcEdgePositions numEmbBsg numDualBsg nmf emf source sink calcedNodes xCoords
     scaledG = scaleGraph calcedEdges
     --
     g' = reverseFeedBacks scaledG $cyclesInfoBS bs
  在 BlkScmImg g' -- -- calcedEdges

calcXForBackBone (numEmbBsg, numDualBsg, emf, nmf) idsOfNodes =
 --
 让 (_, (xleft, xright) ) =
         maximumBy (\ (v1, (xleft1, xright1) ) (v2, (xleft2, xright2) ) ->
                         比较 (xright1 - xleft1) (xright2 - xleft2) )
                   $ map (\ v -> (v, fidsToWeights numDualBsg $ Map.lookup v nmf ))
                         idsOfNodes
  在 ( (xright + xleft) / 2.0 , idsOfNodes )
-- g :: Gr (NodePosition, NodeLabel) [ NodePositions ]  
reverseFeedBacks g 周期信息 = foldr fEdge g 周期信息
 其中 fEdge cinfo g =
        让 elbl = getELabel 例如
            e = reversedEdge cinfo
            (v,w) = e
            g' = delEdge 例如
         在 insEdge (w,v, 反向 elbl) g'
calcEdgePositions numEmbBsg numDualBsg nmf emf 源接收器 calcedNodes backBones =  
 让 fEdge e@(v,w) g =
      让 xOfe = case find (\ (x, lst) ->
                                if v `elem` lst && w `elem` lst
                                   那么真
                                   否则为假
                            ) 骨干
                    什么都没有 -> halfSumEdge numDualBsg emf e
                    只是 (x,_) -> x
          [startY, endY] = 映射 (\n -> getWeight $ getVLabel n numEmbBsg) [ v, w ]
          坐标 = [ (xOfe, startY), (xOfe, endY) ]
          g' = setELabel' (v,w) 坐标 g
       在跟踪 ("\n\ncoords = " ++ 显示坐标 ++ "\ncalc 边缘 " ++ 显示 (v,w) ++ "\nemf = "
                                          ++ 显示 emf ++ "\nnmf = " ++ 显示 nmf
                                          ++ "\nnumDualBsg = " ++ 显示 numDualBsg
                                          ++ "\nnumEmbBsg = " ++ 显示 numEmbBsg)
                G'
     outEdgesOfSource = map fst $ lSortSuc numEmbBsg 源
     inEdgesOfSink = map fst $ lSortPre numEmbBsg sink
     fixFouthEdgeLbl v lst yModifier g =
         第一个案例
              [_]->g
              [ _, _ ] -> (trace "\nFixFouth\n" g)
              [ _, _, _ ] -> g
              [ _, _, _, w ] ->
                让 [ (x1,y1), p2 ] = getELabel (v,w) g
                    (xv, yv) = fst $ getVLabel vg
                 在 setELabel' (v,w)
                               [ (xv, yModifier y1 ), (x1, yModifier y1 ), p2 ]
                               G
              _ -> 错误 $ "visualiseScheme.fixFouthEdgeLbl: lst 有超过 4 条边!!!\n"
                           ++ 显示 lst
     calcedUsualEdges = foldr fEdge
                              计算节点
                              $ 边缘计算节点
     calcedAll = fixFouthEdgeLbl sink inEdgesOfSink (+1)
                   $ fixFouthEdgeLbl source outEdgesOfSource (\a -> a - 1) calcedUsualEdges

  在跟踪 ("\ncalcedAll = " ++ 显示 calcedAll) calcedAll

比例图 g =
 让
     系数 = 3.0
     保证金LT = 10
     modifyCoord = (marginLT + ) 。(*factor) -- marginLeft и marginTop
     modifyCoords a = map2 modifyCoord 。vopt (-) a $ minCoordinates g
  在 emap 中(地图修改坐标)
                $ nmap (\(coords, lbl) -> (modifyCoords coords, lbl) )
                       G
准备数据 bs =
 让 bsg = graphBS bs
     [ sink, source ] = map head $ pam bsg [ getSinks, getSources ]
     [帮助节点] = newNodes 1 bsg
     helpEdges = [ (source,helpNode), (helpNode, sink) ]
     bsg' = insEdges [ (a,b, ()) | (a,b) (l, 0.0) )
              $ foldr (\cinf g -> {- g) --- -} delEdge (helpEdge cinf) g)
                      (trace ("\n\nembG = " ++ show embG) embG)
                      周期信息
     f (v, 高度) g =
       让 fsuc (w, (order, weight)) g =
              setELabel' (v,w) (顺序, 重量 + 高度/2) g
           fpre (w, (order, weight)) g =
              setELabel' (w,v) (顺序, 重量 + 高度/2) g
           g' = 折叠 fsuc g $ lsuc gv
        在文件夹 fpre g' $ lpre g' v
  在 emap (\(order, weight) -> (order, {-round-} weight))
          . 文件夹 f embG'
          . 地图 (\n -> (n, snd . sizeLabel $ getVLabel n embG))
          $ 节点 embG

prepareDualG dg =
 让 dg' = emap (\lbl -> (lbl, 0.0)) dg
     宽度元素 v sucOrPre =
       让宽度 = fst 。sizeLabel $getVLabel vg
        宽度 / (fromIntegral .length $ sucOrPre gv)
     -- 节点是人脸        
     fNodes v (dg :: Gr Face (Edge, Double) )=
      让 fEdge (w, (orig@(origV, origW), weight)) dg =
            让 wV = widthElement origV lsuc
                wW = widthElement origW lpre
             在 setELabel' (v,w) (orig, weight + wV + wW) dg
          传出 :: [ (Node, (Edge, Double)) ]
          传出 = lsuc dg v
       在文件夹 fEdge dg 传出
   在 emap (\(e, weight) -> (e, {-round-} weight))
           . foldr fNodes dg'
           $ 节点 dg

calcNodePositions numEmbBsg numDualBsg nmf emf source sink backBones {- :: [ (Double, [ Node ] ) -} =
 让 fNode v (g :: Gr (NodePosition, NodeLabel) [ NodePosition ] ) =
      如果 v == 源 -- s
         然后 calcSorT v id g lSortSuc numEmbBsg numDualBsg emf backBones
         否则如果 v == sink -- t
                 然后 calcSorT v 交换 g lSortPre numEmbBsg numDualBsg emf backBones
                 否则让 vlbl = getVLabel v numEmbBsg
                          xCoord = case find (\ (x, lst) ->
                                                 如果 v `elem` lst
                                                    那么真
                                                    否则为假
                                             ) 骨干
                                     什么都没有 -> halfSumNode numDualBsg nmf v
                                     只是 (x,_) -> x
                       在 setVLabel' v ((xCoord, getWeight vlbl ), snd vlbl) g
     g' :: Gr (NodePosition, NodeLabel) [ NodePosition ]
     g' = emap (\_ -> [] ) $ nmap (\(weight, lbl) -> ((0.0,0.0), lbl))
                                   numEmbBsg
     结果 :: Gr (NodePosition, NodeLabel) [ NodePosition ]                       
     结果 = 折叠 fNode
                    G'
                    $ 节点 numEmbBsg
  结果

calcSorT v 选择器 (g :: Gr (NodePosition, NodeLabel) [ NodePosition ] ) edgeSelector numEmbBsg numDualBsg emf backBones =
  让 calcSTDegree4 w =
       let (weight , vlbl) = getVLabel v numEmbBsg
        在 setVLabel' v ((halfSumEdge numDualBsg emf $ selector (v,w) ,
                          重量 ),
                        vlbl)
                        G
   in case map fst $ edgeSelector numEmbBsg v of
          []->错误$“calcSorT:节点”++显示v
                         ++ " 没有任何 suc 边!\nGraph:\n" ++ show g
                         ++ "\nnumEmbBsg = \n" ++ 显示 numEmbBsg

          [ w ] -> let (weight, vlbl) = getVLabel v numEmbBsg
                       xCoord = case find (\ (x, lst) ->
                                              如果 v `elem` lst
                                                 那么真
                                                 否则为假
                                          ) 骨干
                                  无 -> halfSumEdge numDualBsg emf $ 选择器 (v,w)
                                           -----halfSumNode numDualBsg nmf v
                                  只是 (x,_) -> x
                    在 setVLabel' v ((xCoord , weight), vlbl)
                                G
          [ w1, _ ] -> let (weight , vlbl) = getVLabel v numEmbBsg
                        在 setVLabel' v (( snd .fidsToWeights numDualBsg
                                               $ Map.lookup(选择器(v,w1))电动势,
                                          重量),
                                          vlbl
                                        )
                                      G
          [ _, w, _ ] -> calcSTDegree4 w
          [ _, w, _, _ ] -> calcSTDegree4 w
          moreEdges -> error $ "calcSorT: node " ++ show v ++ " has got too may edges!:\n"
                                ++ 显示更多边 ++ "\nGraph:" ++ 显示 g
                                ++ "\nnumEmbBsg = " ++ 显示 numEmbBsg

--- fidsToWeights :: 也许 EdgeFaces -> NodePosition
fidsToWeights numDualBsg = map2 (\fid -> getWeight $ getVLabel fid numDualBsg) 。来自Just

halfSum numDualBsg fids = ( uncurry (+) (fidsToWeights numDualBsg fids) / 2.0 ) :: Double
halfSumNode numDualBsg nmf v = (halfSum numDualBsg) $ Map.lookup v nmf                       
halfSumEdge numDualBsg emf e = (halfSum numDualBsg) $ Map.lookup e emf


-------------------------------------------------- ---------------------

模块 DualGraph
#如果定义(MYDEBUG)
#别的
(dualGraph, Face(..), leftFace, rightFace, FaceId, EdgeFaces, EdgeMapFaces,NodeMapFaces, DualGraph, lSortSuc, lSortPre)
#万一
      在哪里
导入合格的 Data.Set 作为 Set
导入合格的 Data.Map 作为 Map
导入 Data.Maybe (fromJust,isJust)
导入 SimpleUtil (apa,swap,map2)
导入 Data.List (foldl', sortBy, 查找)
导入 InductivePlus
导入 GraphEmbedder
导入 Debug.Trace

类型 FaceId = Int
类型 EdgeFaces = (FaceId, FaceId)
type EdgeMapFaces = Map.Map Edge EdgeFaces

type NodeMapFaces = Map.Map 节点 EdgeFaces

leftFace :: EdgeFaces -> FaceId
左脸 = fst
rightFace :: EdgeFaces -> FaceId
rightFace = snd

数据 Face = Face { sourceNode, sinkNode :: Node,
                   leftContour, rightContour :: Set.Set Edge --- [节点],
                 } |
            外表面{
                         leftContour, rightContour :: Set.Set Edge --- [节点],
                      } 推导 (Show, Eq)

nodePathToEdgePath :: Ord a => [ a ] -> Set.Set (a,a)
nodePathToEdgePath (h:rest) = Set.fromList 。snd
                              $ foldl' (\ (current,result) next ->
                                         (下一个,(当前,下一个):结果))
                                       (H, [])
                                       休息

newFace src leftC rightC =
  面{ sourceNode = src,
         sinkNode = 最后左边C,
         leftContour = nodePathToEdgePath $ src : leftC,
         rightContour = nodePathToEdgePath $src : rightC -- ,
       }

newOuterFace embG edgeSelector slotModifier =
 case filter (\v -> null $ lpre embG v) $ nodes embG of
  [] -> 错误 $ "newOuterFace: 该图没有任何源顶点\n"
                ++ 显示 embG
  [ v ] -> slotModifier emptyOuterFace
                        . nodePathToEdgePath
                        $ findContour v
  源顶点->
     error $ "newOuterFace: 图形有多个源顶点:"
             ++ 显示源顶点
             ++ "\nThe Graph:\n" ++ 显示 embG
 在哪里
  emptyOuterFace = OuterFace { leftContour = Set.empty,
                               rightContour = Set.empty
                             }
  找到轮廓 v =
   case lSortSuc embG v 的
     [] -> [ v ]
     someEdges -> v : (findContour . fst $ edgeSelector someEdges )

setRightContour face con = face { rightContour = con }
setLeftContour face con = face { leftContour = con }


输入 DualGraph = Gr 面边

dualGraph :: BlockSchemeEmbeddedGraph -> (DualGraph, EdgeMapFaces, NodeMapFaces)

checkm msg g = if 1 `notElem` suc g 2
                  然后错误 $ "\ncheckm:" ++ msg ++ "\nthe G = " ++ show g
                  否则跟踪 ( "\n\nsuc g 2 = " ++ 显示 (suc g 2) ) g

dualGraph embGr =
 让 embG = checkm "dualGraph:" embGr
     通常的脸 = snd 。foldr (findFaces embG)
                              (2, buildGr []) --- Map.empty)
                              $ 节点 embG

     sFace = newOuterFace embG 头部 setRightContour
     tFace = newOuterFace embG last setLeftContour
     allFaces = insNodes [ (0,sFace), (1,tFace) ]
     allNodes = map (\n -> (n, getVLabel n allFaces))
                    $ 节点 allFaces
     linkedFaces = 折叠链接
                         全脸
                         [ (f1, f2) | f1@(fid1,_) fid1
                         ]
     emf = foldr (\(fid,f) m -> let comb fun conSel m = Set.fold (\em -> Map.insertWith fun

              e

              (fid,fid)

              米)
                                                                 米
                                                                 $ conSelf
                                 在梳子 (\ (_,r) (l,_) -> (l,r) )
                                         左轮廓
                                         $梳子 (\ (l,_) (_,r) -> (l,r) )
                                                右轮廓
                                                米
                 )
                 地图.empty
                 所有节点

     fNMF nm = let (lFace,rFace) = case lSortSuc embG n of
                           [] -> 让 ls = lSortPre embG n
                                     lFace = leftFace
                                              . 来自Just
                                              $ Map.lookup (fst $head ls, n) -- 最后 ls, n)
                                                           电动势
                                     rFace = rightFace
                                              . 来自Just
                                              $ Map.lookup (fst $ last ls, n) -- 头部 ls, n)
                                                           电动势
                                  在 (lFace, rFace)
                           ls -> 让 lFace = leftFace
                                              . 来自Just
                                              $ Map.lookup (n, fst $ head ls)
                                                           电动势
                                      rFace = rightFace
                                              . 来自Just
                                              $ Map.lookup (n, fst $ last ls)
                                                           电动势
                                   在 (lFace, rFace)
                 在 Map.insert n (lFace, rFace) m
     nmf = foldr fNMF Map.empty $ 节点 embG
  在跟踪 ("\nDualGrapn: (linkedFaces, emf, nmf) \n" ++ show (linkedFaces, emf, nmf) ) (linkedFaces, emf, nmf)


findFaces embG v st =
  case map fst $lSortSuc(checkm "findFaces:" embG) v of
   [] -> st -- вершина не может образовать грань
   [_]->圣
   (firstOut:outgoing) -> snd $ foldl' (findFace embG v)
                                       (firstOut,st)
                                       传出

数据 EdgeType = InEdge | OutEdge 推导 (Show,Eq)

lSortEdges gren v =
 让 g = trace ("\nlSortEdges: g = " ++ show gren) (checkm ("lSortEdges: v = " ++ show v )gren)
     getEdgeNumber (OutEdge, (_, (n,_))) = n
     getEdgeNumber (InEdge, (_, (_,n))) = n

     oute = lsuc gv
     ine = lpre gv
     allEdges = sortBy(apa 比较 getEdgeNumber)
                 $ concat [ map (\lbl -> (OutEdge, lbl) ) 输出,
                            地图 (\lbl -> (InEdge, lbl) ) ine ]

     cAllEdges = 循环 allEdges

     zeroEdge = head (trace ("allEdges: = " ++ show allEdges) allEdges)
     spanE e = span ((e ==) . fst)
     outEdges = case fst zeroEdge of

                  OutEdge -> fst 。跨度 OutEdge
                              . snd 跨度InEdge
                              . snd $ spanE OutEdge 呼叫边缘
                  _ -> fst 。跨度 OutEdge 。snd $ spanE InEdge 调用
     inEdges = case fst zeroEdge of
                  InEdge -> fst 。跨度InEdge
                              . snd 跨度 OutEdge
                              . snd $ spanE InEdge 调用
                  _ -> fst 。跨度 InEdge 。snd $ spanE OutEdge 呼叫边缘

  在 if 空行 || 零外
        然后让 [ sv ] = getSources g
                 findContour prew w =
                   如果 w /= v
                      然后 findContour (Just w) 。fst 。head $ (trace ("\n\nlSortSuc gw = " ++ show w

  ++ " lsortSuc = " ++ 显示 (lSortSuc gw))
                                                                      ( lSortSuc gw ))
                      否则预
                 wOfFirstEdge = fromJust $ findContour Nothing sv
                 sine = sortBy (apa notCompare (snd . snd)) ine
                 (beforeW, withW) = span ((wOfFirstEdge /=) . fst) 正弦
              in ( sortBy (apa compare (fst . snd)) oute,
                   withW ++ sortBy (apa compare (snd . snd)) beforeW
                 )
        否则map2(地图snd)
                  (outEdges, inEdges)
 其中 notCompare ab = 大小写比较 ab
                          情商 -> 情商
                          LT->GT
                          GT->LT

lSortPre gv = 让 res = snd $ lSortEdges gv in
                   trace ("\n\nlSortPre(" ++ show v ++ ") = " ++ show res) res
lSortSuc gv = 让 res = fst $ lSortEdges gv in
                   trace ("\n\nlSortSuc(" ++ show v ++ ", g= " ++ show g ++ ") = " ++ show res) res

findFace embG v (wi, st@ (freeFID, mf)) wj =
  让 findContour vw pStop selectEdge =
         让 preEdges = lSortPre (checkm ("findFace: v = " ++ show v ++ " wi = "
                                             ++显示wi ++“v =”++显示v
                                             ++ " w = " ++ 显示 w ++ " wj = "
                                             ++ 显示 wj) embG) w
             sucEdges = lSortSuc embG w
             nextW = selectEdge sucEdges
             res = if null sucEdges || (not (null preEdges) && pStop v preEdges) -- w 是 t 节点
                      然后 [ w ]
                      else w : findContour w nextW pStop selectEdge
          在跟踪中 ("findContour: v = " ++ show v ++ " w = " ++ show w ++ " suc = " ++ show sucEdges ++ " pre = " ++ show preEdges )
                   资源

      leftCon = findContour v wi
                            (\v -> (v /= ) . fst . head ) -- 最后 )
                            (fst . 最后)
      rightCon = findContour v wj
                             (\v -> (v /=) . fst . last ) -- 头)
                             (fst. 头)
      tr = trace ("\nfindFace v = " ++ show v ++ " wi = " ++ show wi ++ " wj = " ++ show wj ++ " freeFID = " ++ show freeFID )
                 leftCon
      res = (wj, (freeFID + 1,
                  insNode (freeFID, newFace v tr rightCon) mf
                 )
            )
   在跟踪 ("\nfindFace:" ++ 显示 res ) res

链接 ((fid1, f1), (fid2, f2)) g =
 让 getC f = (leftContour f, rightContour f)
     [ (lc1, rc1), (lc2, rc2) ] = 地图 getC [f1,f2]
     foldIntersection res 选择器 =
       让 (ff1, ff2) = 选择器 (fid1, fid2)
           foldr (\e@(v,w) g -> insEdge (ff1,ff2,e) g )
                 G
                 资源
  如果 Set.toList $ lc1 `Set.intersection` rc2 的
       []->
         case Set.toList $ rc1 `Set.intersection` lc2 of
          []->g
          -- 我 f2 в f1
          res -> foldIntersection res id
       res -> foldIntersection res 交换
4

1 回答 1

1

在您的示例中:

main = let g = insEdge (0,1,()) $ buildGr [ ([], 0, (), []), ([], 1, (), []) ]
           g' = delEdge (0,1) g
        in if 1 `elem` suc g 0
              then putStrLn "OK"
              else putStrLn "ERROR "

该变量g'从未使用过。表达式suc g 0应该是suc g' 0?在我看来,这应该使它打印OK...

于 2010-05-17T10:25:01.103 回答