2014-06-21 5 views
6

Dies ist ein Follow-up zu meiner previous question über die Verarbeitung einer Vektordarstellung eines 5,1 m Kanten gerichteten Graphen. Ich versuche, den Grafikalgorithmus von Kosaraju zu implementieren und muss daher meinen Vector in der Reihenfolge der Endzeiten einer Tiefensuche (DFS) an den umgekehrten Kanten neu anordnen. Ich habe Code, der auf kleinen Datensätzen läuft, aber nicht in 10 Minuten auf den gesamten Datensatz zurückkehrt. (Ich kann nicht ausschließen, dass eine Schleife aus dem großen Graphen entsteht, aber es gibt keine Anzeichen dafür auf meinen Testdaten.)Optimierung der Manipulation von großen Vektoren

DFS muss vermeiden, Knoten erneut zu besuchen, also brauche ich eine Art "Zustand" für die Suche (derzeit ein Tupel, sollte ich ein State Monad verwenden?). Die erste Suche sollte einen neu geordneten Vektor zurückgeben, aber ich behalte die Dinge derzeit einfach, indem ich eine Liste der neu angeordneten Knotenindizes zurückgebe, so dass ich den Vektor anschließend in einem Durchgang verarbeiten kann.

Ich nehme an, das Problem liegt in dfsInner. Der Code unter "merkt sich" die besuchten Knoten, indem er das erkundete Feld jedes Knotens aktualisiert (dritter Wächter). Obwohl ich versuchte, es rekursiv zu machen, scheint der Code den Speicherverbrauch ziemlich schnell zu erhöhen. Muss ich einige Strenge erzwingen und wenn ja, wie? (Ich habe eine andere Version, die ich bei einer einzigen Suchsuche verwende, die nach früheren Besuchen sucht, indem ich die Startknoten der unerforschten Kanten auf dem Stapel und die Liste der Knoten, die abgeschlossen wurden, betrachte. Dies wächst nicht so schnell, aber kommt für keinen gut verbundenen Knoten zurück.)

Es könnte aber auch die foldr' sein, aber wie kann ich das erkennen?

Dies ist angeblich Coursera Hausaufgaben, aber ich bin nicht mehr sicher, ob ich den Ehrenkode Button ankreuzen kann! Das Lernen ist jedoch wichtiger, daher möchte ich keine Copy/Paste-Antwort. Was ich habe, ist nicht sehr elegant - es hat auch ein imperatives Gefühl, das von dem Problem getrieben wird, eine Art Staat zu halten - siehe dritte Wache. Ich würde gerne Kommentare zu Entwurfsmustern begrüßen.

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 
+0

Vielleicht ist es keine gute Idee, das besuchte Set im Graphen selbst zu speichern. Ich bezweifle, dass Vektoraktualisierungen während des Markierens des Knotens während der Rekursion zusammengefügt werden, da Sie bei jedem Schritt einen zufälligen Zugriff vornehmen, so dass er tatsächlich konstruiert werden musste. – Piezoid

+0

Ich machte mir darüber Sorgen, aber der einzige andere Weg, den ich finden konnte, um die besuchten Knoten zu identifizieren, sah ebenfalls sehr langsam aus (siehe Zeilen in den Kommentaren, die gerade hinzugefügt wurden) –

+1

Sie können versuchen, veränderbare Vektoren zu verwenden. In diesem Fall würde ich eine Codierung wie 'data Graph = Graph (Vektorkanten) (Vector Edges)' und 'Context s = MVector Explored' empfehlen (siehe [" Struktur von Arrays "vs." Array von Strukturen "] (https://www.fpcomplete.com/user/edwardk/revisiting-matrix-multiplication/part-3#unboxed-vectors)). Die andere Möglichkeit besteht darin, eine 'Set'-ähnliche Struktur mit State-Monade zu verwenden, wie in [Strukturierungstiefe-erste Suchalgorithmen in Haskell] (http://www.researchgate.net/publication/2252048_Structuring_Depth-First_Search_Algorithms_in_Haskell/file/50463523c7a64b12d4). pdf) (Abschnitt 5) – Piezoid

Antwort

0

Basierend auf @andras gist, schrieb ich meinen Code wie folgt um. Ich habe Arrow-Funktionen nicht verwendet, da ich mit ihnen nicht vertraut bin, und meine zweite Tiefensuche ist stilistisch die gleiche wie die erste (anstelle von @Andras filterM). Das Endergebnis ist, dass es in 20% der Zeit des Andras-Codes (21 anstelle von 114) abgeschlossen ist.

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

Auf den Punkt gebracht:

die Zeit Komplexität kennen.

Es gibt viele Feinheiten zu Optimierung, eine große Teilmenge von denen in der täglichen Programmierung nicht sehr wichtig ist, aber nicht die asymptotische Komplexität zu erkennen und Programme werden oft nur nicht bei allen arbeiten.

Haskell-Bibliotheken dokumentieren normalerweise die Komplexität, besonders wenn sie nicht offensichtlich oder nicht effektiv ist (linear von schlechter). Insbesondere können alle für diese Frage relevanten Komplexitäten in Data.List und Data.Vector gefunden werden.

Die Leistung wird von V.// hier getötet. Vektoren sind umrandete unverpackte zusammenhängende Arrays im Speicher. Um sie zu modifizieren, muss daher der gesamte Vektor kopiert werden. Da wir O (N) solche Modifikationen haben, ist der ganze Algorithmus O (n^2), also müssen wir ungefähr 2 Terabytes mit N = 500000 kopieren. Es ist also nicht viel Brauch, besuchte Knoten innerhalb des Vektors zu markieren. Erstellen Sie stattdessen einen IntSet Index nach Bedarf.

initialStack (length acc) sieht auch wirklich schlecht aus. Es ist fast nie eine gute Idee, length auf großen Listen zu verwenden, weil es auch O (n) ist. Es ist wahrscheinlich nicht so schlimm wie // in Ihrem Code, da es in einem relativ selten vorkommenden Zweig sitzt, aber es würde immer noch die Leistung verkrüppelt, nachdem wir das Vektorproblem behoben haben.

Auch scheint mir die Suchimplementierung eher unklar und kompliziert zu sein. Das Ziel einer wörtlichen Übersetzung des Pseudocodes auf der Seite Wiki sollte ein guter Anfang sein. Außerdem ist es nicht notwendig, die Indizes in Knoten zu speichern, da sie aus Vektorpositionen und den Adjazenzlisten bestimmt werden können.