Question

这是this post的后续行动，代码现在基于Structuring Depth-First Search Algorithms in Haskell to do depth first search，由King和Launchbury在20世纪90年代。那篇论文提出了一个生成和修剪策略，但是使用了一个带有状态Monad的可变数组（我怀疑已经弃用了一些语法）。作者提示可以使用一组来记住所访问的节点，作为额外O（log n）的成本。我尝试使用一套（我们现在拥有比20世纪90年代更好的机器！），使用现代State Monad语法，并使用Vectors而不是数组（因为我读通常更好）。

和以前一样，我的代码运行在小型数据集上，但无法返回我需要分析的5米边缘图，而我正在寻找仅提示关于大规模操作的弱点。我所知道的是代码在内存中运行舒适，所以这不是问题，但是我无意中滑到了O（n2）？（相比之下，本文在Data.Graph库中的官方实现（我最近也借用了一些代码）使用了一个可变数组，但在大数据集上失败了... Stack Overflow !!!）< / p>

所以现在我有一个没有完成IntSet State的Vector数据存储和一个ST Monad Array'官方'崩溃的数组！ Haskell应该能做得比这更好吗？

import Data.Vector (Vector)
import qualified Data.IntSet as IS
import qualified Data.Vector as V
import qualified Data.ByteString.Char8 as BS
import Control.Monad.State

type Vertex   = Int
type Table a  = Vector a
type Graph    = Table [Vertex]
type Edge     = (Vertex, Vertex)
data Tree a   = Node a (Forest a) deriving (Show,Eq)
type Forest a = [Tree a]
-- ghc -O2 -threaded --make
-- +RTS -Nx
generate :: Graph -> Vertex -> Tree Vertex
generate g v = Node v $ map (generate g) (g V.! v)

chop :: Forest Vertex -> State IS.IntSet (Forest Vertex)
chop [] = return []
chop (Node x ts:us) = do
    visited <- contains x
    if visited then
        chop us
    else do
        include x
        x1 <- chop ts
        x2 <- chop us
        return (Node x x1:x2)

prune :: Forest Vertex -> State IS.IntSet (Forest Vertex)
prune vs = chop vs

main = do
    --edges <- V.fromList `fmap` getEdges "testdata.txt"
    edges <- V.fromList `fmap` getEdges "SCC.txt"
    let 
        -- calculate size of five largest SCC
        maxIndex = fst $ V.last edges
        gr = buildG maxIndex edges
        sccRes = scc gr
        big5 = take 5 sccRes
        big5' = map (\l -> length $ postorder l) big5
    putStrLn $ show $ big5'

contains :: Vertex -> State IS.IntSet Bool
contains v = state $ \visited -> (v `IS.member` visited, visited)

include :: Vertex -> State IS.IntSet ()
include v = state $ \visited -> ((), IS.insert v visited)


getEdges :: String -> IO [Edge]
getEdges path = do
    lines <- (map BS.words . BS.lines) `fmap` BS.readFile path
    let pairs = (map . map) (maybe (error "can't read Int") fst . BS.readInt) lines
    return [(a, b) | [a, b] <- pairs] 

vertices :: Graph -> [Vertex]
vertices gr = [1.. (V.length gr - 1)]

edges :: Graph -> [Edge]
edges g = [(u,v) | u <- vertices g, v <- g V.! u]

-- accumulate :: (a -> b -> a)  -> Vector a-> Vector (Int, b)--> Vector a
-- accumulating function f
-- initial vector (of length m)
-- vector of index/value pairs (of length n)
buildG :: Int -> Table Edge -> Graph
buildG maxIndex edges = graph' where
    graph    = V.replicate (maxIndex + 1) []
    --graph'   = V.accumulate (\existing new -> new:existing) graph edges
    -- flip f takes its (first) two arguments in the reverse order of f
    graph'   = V.accumulate (flip (:)) graph edges

mapT :: Ord a => (Vertex -> a -> b) -> Table a -> Table b
mapT = V.imap

outDegree :: Graph -> Table Int
outDegree g = mapT numEdges g
    where numEdges v es = length es

indegree :: Graph -> Table Int
indegree g = outDegree $ transposeG g

transposeG :: Graph -> Graph
transposeG g = buildG (V.length g - 1) (reverseE g)

reverseE :: Graph -> Table Edge
reverseE g = V.fromList [(w, v) | (v,w) <- edges g]

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

postorder :: Tree a -> [a]
postorder (Node a ts) = postorderF ts ++ [a]

postorderF :: Forest a -> [a]
postorderF ts = concat (map postorder ts)

postOrd :: Graph -> [Vertex]
postOrd g = postorderF (dff g)

dfs :: Graph -> [Vertex] -> Forest Vertex
dfs g vs = map (generate g) vs

dfs' :: Graph -> [Vertex] -> Forest Vertex
dfs' g vs = fst $ runState (prune d) $ IS.fromList []
    where d = dfs g vs

dff :: Graph -> Forest Vertex
dff g = dfs' g $ reverse (vertices g)

scc :: Graph -> Forest Vertex
scc g = dfs' g $ reverse $ postOrd (transposeG g)

Answer 1

一些可能的小改进：

更改

type Edge = (Vertex, Vertex)

到

data Edge = Edge {-# UNPACK #-} !Vertex {-# UNPACK #-} !Vertex

重用每个边的内存使用量，从7个字到3个字，并改善缓存局部性。降低内存压力几乎总能提高运行时间。正如@jberryman所提到的那样，Table Edge可以使用未装箱的矢量（那么你不需要上面的自定义数据类型）。

generate :: Graph -> Vertex -> Tree Vertex
generate g v = Node v $ map (generate g) (g V.! v)

如果你确定索引是在边界内，你可以使用vector中的不安全索引函数而不是.!。

contains :: Vertex -> State IS.IntSet Bool
contains v = state $ \visited -> (v `IS.member` visited, visited)

改为使用get和put $!的组合。

include :: Vertex -> State IS.IntSet ()
include v = state $ \visited -> ((), IS.insert v visited)

改为使用modify'。

您在程序中使用了很多列表。链接列表不是最有效的内存/缓存数据结构。看看你是否可以转换代码以使用更多的向量。

Haskell：优化图形处理算法

1 个答案: