Question

这是我previous question关于处理5.1米边缘有向图的矢量表示的后续行动。我正在尝试实现Kosaraju的图算法，因此需要按照反转边缘上的深度优先搜索（DFS）的完成时间的顺序重新排列我的Vector。我的代码在小数据集上运行，但在完整数据集上无法在10分钟内返回。（我不能排除大图出现循环，但我的测试数据没有迹象表明。）

DFS需要避免重新访问节点，所以我需要某种状态＆＃39;对于搜索（目前是一个元组，我应该使用State Monad吗？）。第一次搜索应该返回一个重新排序的Vector，但是我现在通过返回一个重新排序的Node索引列表来保持简单，这样我就可以随后一次处理Vector。

我认为问题出在dfsInner。以下代码记得＆＃39;访问的节点更新每个节点（第三防护）的探索字段。虽然我试图使其尾递归，但代码似乎相当快地增加了内存使用。 我是否需要强制执行某些严格，如果是，请如何执行？（我在单个搜索搜索中使用了另一个版本，它通过查看堆栈上未开发边缘的起始节点和已完成的节点列表来检查先前的访问。这不会增长得那么快，但是对于任何连接良好的节点都不会返回。）

但是，它也可能是foldr'，但如何检测到？

这应该是Coursera的家庭作业，但我不再确定我可以勾选荣誉代码按钮！学习更重要，所以我不想要复制/粘贴答案。我所拥有的并不是非常优雅 - 它也有一种迫切的感觉，这是由于保持某种状态的问题所致 - 见第三后卫。我欢迎对设计模式发表评论。

type NodeName = Int
type Edges    = [NodeName]
type Explored = Bool
type Stack    = [(Int, Int)]

data Node  = Node NodeName Explored Edges Edges deriving (Eq, Show)
type Graph = Vector Node

main = do
    edges <- V.fromList `fmap` getEdges "SCC.txt"
    let 
        maxIndex = fst $ V.last edges
        gr = createGraph maxIndex edges
        res = dfsOuter gr
    --return gr
    putStrLn $ show res

dfsOuter gr = 
    let tmp = V.foldr' callInner (gr,[]) gr
    in snd tmp

callInner :: Node -> (Graph, Stack) -> (Graph, Stack)
callInner (Node idx _ fwd bwd) (gr,acc) = 
    let (Node _ explored _ _) = gr V.! idx
    in case explored of
        True  -> (gr, acc)
        False ->
            let
                initialStack = map (\l -> (idx, l)) bwd
                gr' = gr V.// [(idx, Node idx True fwd bwd)]
                (gr'', newScc) = dfsInner idx initialStack (length acc) (gr', [])
            in (gr'', newScc++acc)

dfsInner :: NodeName -> Stack -> Int -> (Graph, [(Int, Int)]) -> (Graph, [(Int, Int)])
dfsInner start [] finishCounter (gr, acc) = (gr, (start, finishCounter):acc)
dfsInner start stack finishCounter (gr, acc)
    | nextStart /= start =                      -- no more places to go from this node
        dfsInner nextStart stack (finishCounter + 1) $ (gr, (start, finishCounter):acc)
    | nextExplored = 
-- nextExplored || any (\(y,_) -> y == stack0Head) stack || any (\(x,_) -> x == stack0Head) acc =
        dfsInner start (tail stack) finishCounter (gr, acc)
    | otherwise =
        dfsInner nextEnd (add2Stack++stack) finishCounter (gr V.// [(nextEnd, Node idx True nextLHS nextRHS)], acc)
--      dfsInner gr stack0Head (add2Stack++stack) finishCounter acc

    where
        (nextStart, nextEnd) = head stack
        (Node idx nextExplored nextLHS nextRHS) = gr V.! nextEnd
        add2Stack = map (\l -> (nextEnd, l)) nextRHS

Answer 1

简而言之：

了解时间的复杂性。

优化有很多优点，其中很大一部分在日常编程中并不是很重要，但却不知道渐近的复杂性和程序通常只是根本无法工作。

Haskell库通常记录复杂性，特别是当它不明显或无效时（线性更差）。特别是，可以在Data.List和Data.Vector中找到与此问题相关的所有复杂性。

这里的表现被V.//杀死了。向量是内存中的盒装或未装箱的不可变连续数组。因此，修改它们需要复制整个矢量。由于我们有O（N）这样的修改，整个算法是O（n ^ 2），所以我们必须复制大约2TB，N = 500000.因此，没有太多用于标记向量内的访问节点。相反，根据需要构建IntSet个索引。

initialStack (length acc)看起来也很糟糕。在大型列表上使用length几乎绝不是一个好主意，因为它也是O（n）。它可能不像代码中的//那么糟糕，因为它位于一个相对较少发生的分支中，但在我们纠正了向量问题后，它仍然会使性能瘫痪。

此外，搜索实现似乎相当不清楚，并且过于复杂。旨在在Wiki页面上进行字面意义的伪代码翻译应该是一个好的开始。此外，没有必要将索引存储在节点中，因为它们可以从向量位置和邻接列表中确定。

Answer 2

基于@andras gist，我重写了我的代码，如下所示。我没有使用箭头功能，因为我不熟悉它们，我的第二次深度优先搜索在风格上与第一次搜索相同（而不是@Andras filterM方法）。最终结果是它在安德拉斯的20％的时间内完成了。代码（21s而不是114s）。

import qualified Data.Vector as V
import qualified Data.IntSet as IS
import qualified Data.ByteString.Char8 as BS
import Data.List
import Control.Monad
import Control.Monad.State
--import Criterion.Main

--getEdges :: String -> IO [(Int, Int)]
getEdges file = do
    lines <- (map BS.words . BS.lines) `fmap` BS.readFile file
    let 
        pairs = (map . map) (maybe (error "can't read Int") fst . BS.readInt) lines
        pairs' = [(a, b) | [a, b] <- pairs]         -- adds 9 seconds
        maxIndex = fst $ last pairs'
        graph = createGraph maxIndex pairs'
    return graph

main = do
    graph <- getEdges "SCC.txt"
    --let 
        --maxIndex = fst $ V.last edges
    let 
        fts = bwdLoop graph
        leaders = fst $ execState (fwdLoop graph fts) ([], IS.empty)
    print $ length leaders

type Connections = [Int]
data Node = Node {fwd, bwd :: Connections} deriving (Show)
type Graph = V.Vector Node

type Visited = IS.IntSet
type FinishTime = Int
type FinishTimes = [FinishTime]
type Leaders = [Int]

createGraph :: Int -> [(Int, Int)] -> Graph
createGraph maxIndex pairs = 
    let
        graph  = V.replicate (maxIndex+1) (Node [] [])
        graph' = V.accum (\(Node f b) x -> Node (x:f) b) graph  pairs
    in           V.accum (\(Node f b) x -> Node f (x:b)) graph' $ map (\(a,b) -> (b,a)) pairs

bwdLoop :: Graph -> FinishTimes
bwdLoop g = fst $ execState (mapM_ go $ reverse [0 .. V.length g - 1]) ([], IS.empty) where
    go :: Int -> State (FinishTimes, Visited) ()
    go i = do
        (fTimes, vs) <- get
        let visited = IS.member i vs
        if not visited then do
            put (fTimes, IS.insert i vs)
            mapM_ go $ bwd $ g V.! i
            -- get state again after changes from mapM_
            (fTimes', vs') <- get
            put (i : fTimes', vs')
        else return ()

fwdLoop :: Graph -> FinishTimes -> State (Leaders, Visited) ()
fwdLoop _ [] = return ()
fwdLoop g (i:fts) = do
    (ls, vs) <- get
    let visited = IS.member i vs
    if not visited then do
        put (i:ls, IS.insert i vs)
        mapM_ go $ fwd $ g V.! i
    else return ()
    fwdLoop g fts

    where
        go :: Int -> State (Leaders, Visited) ()
        go i = do
            (ls, vs) <- get
            let visited = IS.member i vs
            if not visited then do
                put (ls, IS.insert i vs)
                mapM_ go $ fwd $ g V.! i
            else return ()

优化大向量的操作

2 个答案: