CODEWITHSUNDEEP
graphfunctional-programmingocaml
Jackson Tale
Jackson Tale

Reputation: 25812

DFS and BFS for Graph in a **pure** functional way in OCaml

I am using Map to implement pure functional DFS and BFS for graph.

here is my code:

module IntMap = Map.Make(struct type t = int let compare = compare end);;
module IntSet = Set.Make(struct type t = int let compare = compare end);;

type digraph = int list IntMap.t;;

exception CantAddEdge;;

let create v = 
  let rec fill i acc =
    if i < v then
      fill (i+1) (IntMap.add i [] acc)
    else 
      acc
  in 
  fill 0 IntMap.empty;;

let num_vertices g = IntMap.cardinal g;;

let add_edge u v g = 
  if IntMap.mem u g && IntMap.mem v g then 
    let add u v g =
      let l = IntMap.find u g in 
      if List.mem v l then g
      else IntMap.add u (v::l) g
    in 
    add u v (add v u g)
  else 
    raise CantAddEdge;;

let dfs_path u g =
  let rec dfs current visited path =
    let dfs_child current (visited, path) c =
      if not (IntSet.mem c visited) then
         dfs c (IntSet.add c visited) (IntMap.add c current path)
      else 
         (visited, path)
    in 
    List.fold_left (dfs_child current) (visited, path) (IntMap.find current g)
  in 
  let (v, p) = dfs u (IntSet.singleton u) IntMap.empty
  in 
  p;;

let bfs_path u g =
  let rec bfs current_list v p n =
    let bfs_current (v,p,n) current  =
      let bfs_child current (v, p, n) c = 
         if not (IntSet.mem c v) then begin
           print_int c;
           ((IntSet.add c v), (IntMap.add c current p), (c::n))
         end 
         else 
           (v, p, n)
      in 
      List.fold_left (bfs_child current) (v, p, n) (IntMap.find current g)
    in 
    let (v,p,n) = List.fold_left bfs_current (v,p,n) current_list
    in 
    if n = [] then p
    else bfs n v p []
  in  
  bfs [u] (IntSet.singleton u) IntMap.empty [];;

I know the code is quite long, but I really do wish for some suggestions:

  1. Is it worthy to really implement a pure functional set of graph algorithm? I do this because I am getting used to functional and hate imperative now.
  2. Is my implementation too complicated in some parts or all?
  3. Although I like functional, personally I think the implementation I make seems more complicated than the imperative array-everywhere version. Is my feeling correct?

Edit

Added Bipartite code

(* basically, we have two sets, one for red node and the other for black node*)
(* we keep marking color to nodes via DFS and different level of nodes go to coresponding color set*)
(* unless a node is meant to be one color but already in the set of the other color*)
type colorType = Red | Black;;
let dfs_bipartite u g =
  let rec dfs current color red black block  =
    if block then (red, black, block)
    else 
      let dfs_child current color (red, black, block) c =
    if block then (red, black, block)
    else 
      let c_red = IntSet.mem c red and c_black = IntSet.mem c black in
      if (not c_red) && (not c_black) then
        if color = Red then
          dfs c Black (IntSet.add c red) black false
        else
          dfs c Red red (IntSet.add c black) false
      else if (c_red && color = Black) || (c_black && color = Red) then (red, black, true)
      else (red, black, block)
      in 
      List.fold_left (dfs_child current color) (red, black, block) (IntMap.find current g)
  in 
  let (r, b, block) = dfs u Black (IntSet.singleton u) IntSet.empty false
  in 
  not block;;

Edit 2

DFS with list based path

let dfs_path u g =
  let rec dfs current visited path =
    let dfs_child (visited, path) c =
      if not (IntSet.mem c visited) then begin
    print_int c;
    dfs c (IntSet.add c visited) (c::path)
      end 
      else (visited, path)
    in 
    List.fold_left dfs_child (visited, path) (IntMap.find current g)
  in 
  let (v, p) = dfs u (IntSet.singleton u) [u]
  in 
  p;;

Upvotes: 2

Views: 5798

Answers (2)

Jeffrey Scofield
Jeffrey Scofield

Reputation: 66808

I'm not sure what you mean by worthy. It's worthy to set yourself this task as a learning exercise. It's also worthy to use immutable data to solve actual real world graph problems. It doesn't seem to me that graph processing is an area of application where pure functional code costs more than one is generally willing to pay for the benefits.

You're representing a path as a map from each node to the next. This is nice because you can start up the path in the middle. But a list is a simpler and more natural representation of a path for a lot of applications. At any rate, yours is a pretty heavyweight representation and so it makes your code a little heavier than I would have expected. (BTW it was hard to figure this out--some comments would help.)

I don't personally think this code is more complicated than imperative could would be. I also think that arrays make a poor representation for graphs when viewed as linked structures. So I don't believe an "arrays everywhere" solution is what you want to compare against. I'd compare against a malloc()/struct based (a la C) or against an object-based solution, personally.

When representing graphs as adjacency matrices, I'd say the array representation is more competitive. If your graph changes size a lot, or if you want to access nodes by keys other than integers, maps still have many advantages.

Upvotes: 3

Indicator
Indicator

Reputation: 361

  1. It is worthy to do that if you cannot find good codes in open source community. Do not reinvent wheels.

  2. There is another post has an extensive explanation on DFS algorithm by OCaml, Topological sort in OCaml What I suggest is to try write bfs, bfs_current and bfs_child into a single function.

Upvotes: 0

Related Questions