Question

我尝试解决在Haskell中查找所有连接子图的问题。使用的算法描述为here。从那篇论文引用：

与每个路径算法一样，有前进步骤和后退步骤。如果给定的连接子图可以通过添加边k来扩展，即如果边k不是给定子图的一部分，如果k与给定子图的至少一个边相邻，并且如果加法边缘k不受下面给出的某些限制的禁止。一旦给定的连接子图不能进一步拉长，就会退后一步。在这种情况下，最后添加的边缘从字符串中移除，暂时给予状态“禁止”，并且同时“允许”再次“允许”从先前较长的字符串回溯禁止的任何其他边缘。相反，禁止从短于当前字符串的字符串中删除的边缘被禁止，从而确保每个连接的子图构造一次且仅构造一次。

为了做这个算法，我将图表表示为边缘列表：

 type Edge =  (Int,Int)
 type Graph = [Edge]

首先，我编写了函数addEdge来检查是否可以扩展图表，如果不可能则返回Nothing或者Edge进行扩展。

我有一个"parent"图表和"extensible"图表，因此我尝试找到"parent"图表中存在的唯一一条与"extensible"图形相关联的边缘，而不是已包含在"extensible"图表中，因此未包含在forbidden集中。

我在下面写了这个函数：

addEdge :: Graph -> Graph -> [Edge] -> Maybe Edge
addEdge !parent !extensible !forb = listToMaybe $ intersectBy (\ (i,j) (k,l) -> (i == k || i == l || j == k || j == l)) (parent \\ (extensible `union` forb)) extensible

这是工作！但是，正如我从剖析整个程序中看到的那样，addEdge是最重要的功能。我确信，我的代码并不是最优的。最少，intersectBy功能找到所有可能的解决方案，但我只需要一个。有没有办法让这段代码更快？也许，不要使用标准列表，Set from Data.Set？这是第一个关注点。

主要递归函数ext如下所示：

ext :: Graph -> [Graph] -> Maybe Graph -> [(Edge,Int)] -> Int -> [Graph]
ext !main !list !grow !forb !maxLength      | isEnd  == True = (filter (\g -> (length g /= 1)) list) ++ (group main) 
                                            | ((addEdge main workGraph forbEdges) == Nothing) || (length workGraph) >= maxLength = ext main list (Just workGraph) forbProcess maxLength
                                            | otherwise = ext main ((addedEdge:workGraph):list) Nothing forb  maxLength where 
                                                workGraph = if grow == Nothing then (head list) else (bite (fromJust grow)) -- [Edge] graph now proceeded
                                                workGraphLength = length workGraph
                                                addedEdge = fromJust  $ addEdge'
                                                addEdge' = addEdge main workGraph forbEdges
                                                bite xz = if (length xz == 1) then (fromJust (addEdge main xz forbEdges)):[] else tail xz 
                                                forbProcess = (head workGraph,workGraphLength):(filter ((<=workGraphLength).snd) forb)
                                                forbEdges = map fst forb -- convert from (Edge,Level) to [Edge]                     
                                                isEnd = (grow /= Nothing) && (length (fromJust grow) == 1) && ((addEdge main (fromJust grow) forbEdges) == Nothing)

我在图表上测试我的程序

c60 = [(1,4),(1,3),(1,2),(2,6),(2,5),(3,10),(3,7),(4,24),(4,21),(5,8),(5,7),(6,28),(6,25),
    (7,9),(8,11),(8,12),(9,16),(9,13),(10,20),(10,17),(11,14),(11,13),(12,28),(12,30),(13,15),
    (14,43),(14,30),(15,44),(15,18),(16,18),(16,17),(17,19),(18,47),(19,48),(19,22),(20,22),(20,21),
    (21,23),(22,31),(23,32),(23,26),(24,26),(24,25),(25,27),(26,35),(27,36),(27,29),(28,29),(29,39),
    (30,40),(31,32),(31,33),(32,34),(33,50),(33,55),(34,37),(34,55),(35,36),(35,37),(36,38),(37,57),
    (38,41),(38,57),(39,40),(39,41),(40,42),(41,59),(42,45),(42,59),(43,44),(43,45),(44,46),(45,51),
    (46,49),(46,51),(47,48),(47,49),(48,50),(49,53),(50,53),(51,52),(52,60),(52,54),(53,54),(54,56),(55,56),(56,58),(57,58),(58,60),(59,60)] :: Graph

例如，查找长度为1到7的所有子图

length $ ext c60 [[(1,2)]] Nothing [] 7
>102332

问题太低速的计算。正如它在原始文章中指出的那样，程序已经用FORTRAN 77编写并在150MHz工作站上启动，执行测试任务的速度比现代i5处理器上的代码快30倍。我无法理解，为什么我的程序如此之慢？ 有没有办法重构这段代码？或者最好的解决方案是将它移植到C上，并通过FFI写入C库的绑定？

Answer 1

我决定使用fgl来实现本文所述的算法。完整的代码如下。

{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Graph.Inductive
import Data.List
import Data.Tree

uniq = map head . group . sort . map (\(a, b) -> (min a b, max a b))
delEdgeLU (from, to) = delEdge (from, to) . delEdge (to, from)
insEdgeDU (from, to) = insEdge (from, to, ()) . insNodeU to . insNodeU from where
    insNodeU n g = if gelem n g then g else insNode (n, ()) g

nextEdges subgraph remaining
    | isEmpty subgraph = uniq (edges remaining)
    | otherwise = uniq $ do
        n  <- nodes subgraph
        n' <- suc remaining n
        return (n, n')

search_ subgraph remaining
    = Node subgraph
    . snd . mapAccumL step remaining
    $ nextEdges subgraph remaining
    where
    step r e = let r' = delEdgeLU e r in (r', search_ (insEdgeDU e subgraph) r')

search = search_ empty

mkUUGraph :: [(Int, Int)] -> Gr () ()
mkUUGraph es = mkUGraph ns (es ++ map swap es) where
    ns = nub (map fst es ++ map snd es)
    swap (a, b) = (b, a)

-- the one from the paper
sampleGraph = mkUUGraph cPaper
cPaper = [(1, 2), (1, 5), (1, 6), (2, 3), (3, 4), (4, 5)]

您要在顶层使用的函数是mkUUGraph，它构造了一个边缘列表中的图形，search构造了一个树，其节点连接了子图的子图。它的输入。例如，要计算本文“方案1”底部显示的统计数据，您可以这样做：

*Main> map length . tail . levels . search . mkUUGraph $ [(1, 2), (1, 5), (1, 6), (2, 3), (3, 4), (4, 5)]
[6,7,8,9,6,1]
*Main> sum it
37

将它与您的实现进行比较时遇到了一些麻烦，因为我不明白ext的所有参数应该做什么。特别是，我无法弄清楚如何在论文中的邻接图上调用ext，以便得到37个结果。也许你有一个错误。

无论如何，我尽力模仿我认为你的代码试图做的事情：找到最多七条边的图形，当然包含边(1, 2)（尽管你的代码输出很多）不包含(1, 2)的图表。我添加了这段代码：

mainHim = print . length $ ext c60 [[(1,2)]] Nothing [] 7
mainMe  = print . length . concat . take 7 . levels $ search_ (mkUUGraph [(1,2)]) (mkUUGraph c60)

我的代码找到3301这样的图表;你的发现35571.我没有非常努力地弄清楚这种差异来自何处。在ghci中，mainHim需要36.45秒; mainMe需要0.13秒。使用-O2进行编译时，mainHim需要4.65秒; mainMe需要0.05秒。 mainMe的数字可以通过使用PatriciaTree图形实现而不是默认值来再次减半，并且可能会进行更深入的分析和一些思考。如果mainMe的原因如此之快，那就是找到了更少的图表，我也测试了修改后的main：

main = print . length . concat . take 8 . levels $ (search (mkUUGraph c60) :: Tree (Gr () ()))

这打印35853，因此它可以找到与测试命令大致相同的图形数量。使用-O2编译时，ghci需要0.72秒，0.38秒。

Answer 2

或者最好的解决方案是将它移植到C上，并通过FFI将绑定写入C库？

不，你不必用C写它.GHC生成的代码并不比C慢。这个巨大的速度差异表明你正在实现一个不同的算法。因此，您应该重写Haskell代码，而不是使用其他语言进行重写。

我猜你的代码存在的问题是你......

使用列表而不是集合
使用广度优先而不是深度优先枚举（不确定）
在整个边缘集合上使用操作，而不是巧妙地跟踪哪个边缘在哪个边缘
手动编码算法的递归结构，而不是使用递归调用。

我必须承认我并不完全理解你的代码。但是我读了你链接到的论文，并且那里描述的算法似乎是对所有结果的简单蛮力枚举。所以我猜Haskell实现应该使用list monad（或list comprehensions）来枚举所有子图，在枚举期间过滤掉非连接的子图。如果您以前从未使用列表monad编写代码，只需枚举所有子图可能是一个很好的起点。

Haskell profilling子图挖掘算法

2 个答案: