Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

I am trying to construct DFS tree using recursive algorithm.

Pseudo code for this is :

DFF(G)
Mark all nodes u as unvisited
while there is an unvisited node u do 
    DFS(u)

.

DFS(u)
Mark u as visited
for each v in u's neighbor do 
    if v is not marked
        DFS(v)

While I can fairly easily accomplish this in imperative language in simple way by constructing some sort of data structure for un/visited nodes, assigning them dynamic allocation or some sort of declaration, for Haskell, it is impossible to do so since Haskell's pureness prevents me to change data while passing parameters.

data Graph a = Graph [(a,[a])] deriving (Ord, Eq, Show)
data Tree a = Node a [Tree a] deriving (Ord, Eq, Show)

type Point = (Int, Int)
type Edges = [Point]
type Path = [Point]

pathGraphFy :: Graph Point -> Point -> Tree (Point,Path)
pathGraphFy inputGraph point = getPathVertex inputGraph (point,[])

getPathVertex :: Graph Point -> (Point, Path) -> Tree (Point,Path)
getPathVertex inputGraph (point,path) = 
    Node (point,point:path) (map (getPathVertex inputGraph) [(x,(point:path))  | x<- neighbors, x `notElem` path])
    where neighbors = pointNeighbor inputGraph point

pointNeighbor :: Graph Point -> Point -> Edges
pointNeighbor (Graph (x:xs)) point = 
    if fst x == point then snd x else pointNeighbor (Graph(xs)) point

This is what I've got for graph traversal using DFS-ish(or rather BFS-ish) algorithm but the problem is that it will visit all the points again that is not in points' path. (i.e if there exists a cycle, it will traverse in both ways clockwise and counter clockwise)

I've also tried currying another Graph with visited points but failed since Graphs passed by parameter only holds data of Graph in the traversal (i.e is not global)

If only dynamic allocation or static data to hold data for global level was possible, this can be easily solved but I'm kinda new to Haskell and I couldn't find answers on the web on this issue. Please help me :( Thanks in advance.

(P.S) I've tried using passing list of visited nodes but it didn't work because when recursion returns, the list of visited nodes will also return, making it impossible to track data. If there is a way to make 'Map' or 'List' global, it is possible to implement it this way. Answer below despite is a link only answer, has great explanation on the reason why this can't be(or shouldn't be) implemented.

like image 823
MazaYong Avatar asked Feb 16 '15 19:02

MazaYong


2 Answers

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

example graph

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.

like image 187
jjm Avatar answered Nov 10 '22 00:11

jjm


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)
like image 31
Niklas B. Avatar answered Nov 10 '22 00:11

Niklas B.