Is there way to represent static data in Haskell? Or is there any other elegant algorithm for DFS traversal in Haskell?

微笑、不失礼 提交于 2019-12-01 04:43:13

The answer involving passing and returning state or using a state monad is more transparent than this approach, but as mentioned in the paper below, it's not as efficient and doesn't generalize well. That said, whatever your needs in this answer, it's worth learning about state monads and working with immutable data in Haskell.

The paper linked in another answer paper provides a rather academic discussion of the use of so called inductive graphs. Fortunately, the author of the paper was kind enough to implement this approach as a Haskell library, fgl. I'm going to gloss over some details about attaching data to nodes and whatnot, and show how to implement DFS using this library. It's easy to modify this algorithm to produce trees instead of lists, and the list version is significantly more concise.

dfs :: Graph gr => [Node] -> gr a b -> [Node]
dfs [] _ = []  
-- this equation isn't strictly necessary, but it can improve performance for very dense graphs.
dfs _ g | isEmpty g = [] 
dfs (v:vs) g = case match v g of
    (Just ctx, g') -> v:dfs (suc' ctx ++ vs) g'
    _ -> dfs vs g

The key here is match, which decomposes a graph into the so called Context of a vertex and the remaining graph (match returns a Maybe Context, to cover the case of a vertex not in the graph).

The notion of a vertex Context is central to the idea of inductive graphs: it's defined as a tuple

(adjIn, nodeId, nodeLabel, adjOut)

where adjIn and adjOut are lists of (edgeLabel, nodeId) pairs.

Note that the term label is used loosely here, and refers to general data attached to vertices or edges.

The suc' function takes a context and returns a list of nodes that are successors of the node in the context (adjOut, with edge labels dropped).

We can build a graph like this

with code like this

testGraph :: DynGraph g => gr a b
testGraph =
    let nodes = [(i, "N" ++ show i) | i <- [1..5]]
        edges = [(2,1,"E21")
                ,(4,1, "E41")
                ,(1,3, "E13")
                ,(3,4, "E34")
                ,(3,5,"E35")
                ,(5,2, "E52")]
        withNodes = insNodes nodes empty
        in insEdges edges withNodes

Calling dfs testGraph produces [1,3,4,5,2].

Note: I was bored and stumbled across this question, so the answer is just a writeup of a couple hours of investigation and experiments.

Nothing keeps you from encoding state in function arguments/return values. A classic DFS could look like this:

import qualified Data.Map as Map
import qualified Data.Set as Set

newtype Graph a = Graph (Map.Map a [a]) deriving (Ord, Eq, Show)
data Tree a = Tree a [Tree a] deriving (Ord, Eq, Show)

dfs :: (Ord a) => Graph a -> a -> Tree a
dfs (Graph adj) start = fst $ dfs' (Set.singleton start) start
  where
    neighbors x = Map.findWithDefault [] x adj
    dfs' vis x =
      let (subtrees, vis') =
            foldr
              (\y (subtrees, vis) ->
                if Set.member y vis
                  then (subtrees, vis)
                  else let vis' = Set.insert y vis
                           (t, vis'') = dfs' vis' y
                       in (t : subtrees, vis'')
              )
              ([], vis)
              (neighbors x)
      in (Tree x subtrees, vis')

Instead of Map/Set, you could also use persistent hash tables or integer maps/sets, depending on your node type.

To avoid the explicit state, you should use a state monad:

import Control.Applicative
import Control.Monad.State
import Control.Monad
import Data.Maybe
{- ... -}

dfs :: (Ord a) => Graph a -> a -> Tree a
dfs (Graph adj) start = evalState (dfs' start) (Set.singleton start)
  where
    neighbors x = Map.findWithDefault [] x adj
    dfs' x = Tree x . catMaybes <$>
      forM (neighbors x) (\y -> get >>= \vis ->
        if Set.member y vis
          then return Nothing
          else put (Set.insert y vis) >> Just <$> dfs' y)
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!