(*  Minh Truong
*
*   Language: Standard ML of New Jersey
*
*   This structure provides an implementation of Dijstra's Algorithm for
*   finding the shortest distance and path between two vertices in a weighted
*   graph. The graph is in the form of a vector (SML's equalivalence to arrays)
*   of weighted adjacency lists.
*
*)

structure WeightedGraphAdjList =
struct

  (*  A vector type for adjacency lists. To have a much more efficient code,
  *   a braun vector should be used instead of a regular vector.
  *)
  structure V = Vector

  (*  The type of a vertex.
  *)
  type vertex = int

  (*  The type of an adjacency list.
  *)
  type adjlist = (vertex*real) list

  (*  The type of a graph.
  *)
  type graph = adjlist V.vector

  type vgraph = real V.vector

  type pgraph = ((vertex list)*real) V.vector

  type bgraph = bool V.vector

  (*  Exception that is raised by functions when applied to vertices that
  *   are not in a graph.
  *)
  exception BadVertex

  exception Empty

  exception BadKey

  (*  graph n = ({0,...n-1}, empty); i.e., the graph on n vertices
  *   with no edges.
  *)
  fun new(n : int) : graph =
    V.tabulate (n, fn i => [])

  (*  size g = the number of vertices in g.
  *)

  fun size( g :graph): int = V.length(g)


  (*  getNeighbors(g, u) = [(v_0,w_0),...], where (v, w) = (v_i, w_i) if
  *   and only if there is an edge from u to v_i with weight w_i.
  *
  *   Raises BadVertex if u is not a vertex in g.
  *
  *   In other words, getNeighbors(g, u) returns the list of pairs
  *   (v, w) such that there is an edge from u to v of weight w in g.
  *)
  fun getNeighbors(g :graph, v: vertex): (vertex*real) list =
    V.sub(g,v)


  (*  insert ([(x,q)_0,...,(x,q)_{n-1}],(x, q)) =
  *   [(x,q)_0,...,(x,q)_{i-1},(x,q),(x,q)_{i+1},...,(x_{n},q_{n})],
  *   where q_{i-1} <= q <= q_{i+1}.
  *)
  fun insert (xs : adjlist, (x, q) : vertex*real) : adjlist =
  let
    fun insert2 (xs : adjlist) : adjlist =
      case xs of
           [] => [(x, q)]
         | (y, z) :: ys =>
             if z < q then (y, z) :: (insert2(ys))
             else (x, q) :: xs
  in
    insert2 (xs)
  end

  (*  insertMany (q, [(y_0,q_0),...(y_{n-1},q_{n-1})]) =
  *     insert(...insert(
  *       insert(q, (y_0, q_0)), (y_1, q_1))...,(y_{n-1},q_{n-1})).
  *)
  fun insertMany (xs : adjlist, ys : adjlist) : adjlist =
    foldr (fn (y, q) => insert(q, y)) xs ys

  (*  updatePri(qs,x,p,[]) = qs'. qs = [(m,r)_0,...,(m,r)_{n-1}] and qs' = qs
   *                         such that for x = m_i of qs,
   *                         (m,r)_i = (m,p)_i
   *)
  fun updatePri(qs : adjlist, x : vertex, p : real, ws : adjlist) : adjlist =
    case qs of
         [] => raise Empty
       | (n,r)::zs => if n = x then ws@insert(zs,(x,p)) else updatePri(zs,x,p,ws@[(n,r)])

  fun remove(q : adjlist) : vertex*adjlist =
    case q of
         [] => raise Empty
       | (x, y) :: xs => (x, xs)

   (*  unfin(al,boo,ml) = al'.
  *
  *   this function is similar to List.filter.
  *   al = [(x_0,r_0),...(x_{n-1},r_{n-1}].
  *   let z = V.sub(boo,x_i). then al' = al (where al has all z(x_i) = true then
  *   (x_i,r_i) is removed from the list).
  *   boo is a boolean vector that keeps track of the nodes that are finished.
  *   al' is the list with all finished neighbors removed.
  *)
  fun unfin(al:adjlist,boo: bgraph,ml:adjlist): adjlist =
    case al of
         [] => ml
       | (v,r)::al'=>  if V.sub(boo,v) then unfin(al',boo,ml) else unfin(al',boo,(v,r)::ml)

 (*   findD(u,v,g,pq,g2,boo) = SOME(n). n is the shortest distance from u to v in
  *    graph g. = NONE, if there is no path from u to v
  *
  *
  *   pq is a a priority queue that will be updated with each iteration, it is
  *   initially empty before any iterations.
  *   g2 is vector whose indexes corresponds to the nodes in g, and contains
  *   the tentative distances with each respective iterations. The tentative
  *   distances in g2 are initially set at 0.0 for u and infinity for the rest.
  *   boo is a boolean vector that tracks the status of each nodes, finished or
  *   unfinished.
  *)
  fun findD(u: vertex,v: vertex, g: graph, pq: adjlist, g2: vgraph,boo:bgraph): real option =
  if List.length(pq) = 0 andalso V.sub(g2,v)>= Real.posInf then NONE
  else if List.length(pq) = 0 then SOME(V.sub(g2,v)) else
  let
   (*   update(m,[(v_0,r_1),...,(v_{n-1},r_{n-1})],g2,pqq) = (g2',pqq').
    *
    *   for all v_i and r_i:
    *   if m + r_i < Vector.sub(g2,v_i) => g2' = V.update(g2,v_i,r+m)
    *                                      pqq' = Q.updatePri(pqq,v_i,r+m)
    *)
    fun update(m:real, al: adjlist, g2:vgraph, pqq: adjlist): vgraph*adjlist =
      case al of
           [] => (g2,pqq)
         | (v',r)::al' =>
           let
             val tentdist = V.sub(g2,v')
             val less =  r+m < tentdist
             val g2' = if less then V.update(g2,v',r+m) else g2
             val pq' = if less then updatePri(pqq,v',r+m,[]) else pqq
           in
             update(m,al', g2',pq')
           end
     val neighbors = getNeighbors(g,u)
     val neighbors' = unfin(neighbors,boo,[])
     val pq' = insertMany(pq,neighbors')
     val m = V.sub(g2,u)
     val (g2',pq'') = update(m,neighbors',g2,pq')
     val (u',pq''') = remove(pq'')
     val boo' = V.update(boo,u',true)
     val w =findD(u',v,g,pq''',g2',boo')
   in
     w
   end

  fun dist(g: graph, u: vertex, v :vertex): real option =
  let
    val length = size(g)
    val pq = []
    val pq'' = insert(pq,(u,0.0))
    val g2 = V.tabulate(length,fn x => Real.posInf)
    val g2' = V.update(g2,u,0.0)
    val bvector = V.tabulate(length,fn x => false)
    val bvector' = V.update(bvector,u,true)
    val distance = findD(u,v,g,pq'',g2',bvector')
  in
    distance
  end

 (*   findP(u,v,[],g,pq,g2,boo) = xs = [x_0,x_1,...,x_{n-1}].
  *                              = []. if there is no path from u to v.
  *
  *   xs is the minimal distance path from u to v in graph g,
  *   where x_0 is the first vertex from u to v (that is not u), x_{n-1} = v, and
  *   there is an edge from u_i to u_{i+1} for all 0 <= i < n-1.
  *
  *   pq is a a priority queue that is initially empty before any iterations.
  *   g2 is vector whose indexes corresponds to the nodes in g, and contains
  *   the tentative paths and tentative distances with each respective iterations.
  *   us is initially [] but is used to keep track of the tentative
  *   predecessors of current u.
  *   boo is a boolean vector that tracks the status of each node, whether they
  *   are finished are unfinished.
  *)
  fun findP(u: vertex,v: vertex,us: vertex list,
      g: graph, pq: adjlist, g2: pgraph,boo:bgraph): vertex list =
  if u = v then us else
  let
    (*   update((ys,m),[(v_0,r_1),...,(v_{n-1},r_{n-1})],g2,pqq) = (g2',pqq').
    *
    *   for all v_i and r_i:
    *   if m + r_i < Vector.sub(g2,v_i) => g2' = V.update(g2,v_i, (ys@[v_i],r+m) )
    *                                      pqq' = Q.updatePri(pqq,v_i,r+m)
    *)
    fun update((ys,m):(vertex list)*real, al: adjlist,
        g2':pgraph, pqq: adjlist): pgraph*adjlist =
      case al of
           [] => (g2',pqq)
         | (v',weight)::al' =>
           let
             val (xs,tentdist) = V.sub(g2',v')
             val less = weight+m < tentdist
             val g2'' = if less then V.update(g2',v',(ys@[v'],weight+m)) else g2'
             val pq' = if less then updatePri(pqq,v',weight+m,[]) else pqq
           in
             update((ys,m),al', g2'',pq')
           end
     val neighbors = getNeighbors(g,u)
     val neighbors' = unfin(neighbors,boo,[])
     val pq' = insertMany(pq,neighbors')
     val (g2',pq'') = update(V.sub(g2,u),neighbors',g2,pq')
     val (u',pq''') = remove(pq'')
     val (zs,r) = V.sub(g2',u')
     val boo' = V.update(boo,u',true)
     val z = if List.length(pq''') = 0 then [] else findP(u',v,zs,g,pq''',g2',boo')
   in
     z
   end
  (*  path (g, u, v) = [], if there is no path from u to v in g
  *                  = [u_0,...,u_{n-1}], where u_0 = u, u_{n-1} = v,
  *   and there is an edge from u_i to u_{i+1} for all 0 <= i < n-1.
  *   Furthermore,
  *     sum_i(weight(g, u_i, u_{i+1}))
  *   is minimal among all paths from u to v.
  *
  *   Raises BadVertex if u or v is not a vertex in g.
  *
  *   In other words, path(g, u, v) is a minimal-weight path from u to v
  *   in g, provided such a path exists.
  *)
  fun path(g:graph, u:vertex, v: vertex): vertex list =
  let
    val length = size(g)
    val pq = []
    val pq'' = insert(pq,(u,0.0))
    val (u2,pq''') = remove(pq'')
    val g2 = V.tabulate(length,fn x =>([], Real.posInf))
    val g2' = V.update(g2,u,([],0.0))
    val bvector = V.tabulate(length, fn x => false)
    val bvector' = V.update(bvector,u,true)
    val path = findP(u,v,[],g,pq''',g2',bvector')
    val path' = if path = [] then [] else u::path
  in
    path'
  end


end