Source

kamlostuff / floyd_warshall.ml

Full commit

type ('a, 'b) graph = ('a, 'b) edges * 'a vertexes
and ('a , 'b) edges = (('a * 'a) * ('b weight)) list
and 'a vertexes = 'a list
and 'b weight = Val of 'b | Infinity | Zero


let gvertexes:(('a, 'b) graph -> 'a list) = snd
let gedges:(('a, 'b) graph -> (('a * 'a) * 'b) list) = fst


let zip = List.combine
let unzip = List.split
let curry f x y = f (x, y)
let uncurry f (x, y) = f x y


let all_pairs lst =
  let pairs item lst = List.map (fun li -> (item, li)) lst
  in
    List.fold_left (fun acc item -> acc @ (pairs item lst)) [] lst

let floyd_warshall graph = 
  let vertexes = gvertexes graph in 
  let vertex_pairs = all_pairs vertexes in
  let edges = gedges graph in 
  let init_d l_of_p = 
    let rec forall lst d = match lst with
      | ((u, v)::tail) when u == v -> 
          let d' = ((u, v), Zero)::d in
            forall tail d' 
      | (uv::tail) when List.mem_assoc uv edges -> 
          let w = List.assoc uv edges in
          let d' = (uv, w)::d in
            forall tail d'
      | (uv::tail) -> 
          let d' = (uv, Infinity)::d in
            forall tail d'
      | [] -> d
    in forall l_of_p []
  in 
    init_d vertex_pairs
(* *)