diff --git a/assignment/digraph.ml b/assignment/digraph.ml new file mode 100644 index 0000000..7cfa779 --- /dev/null +++ b/assignment/digraph.ml @@ -0,0 +1,98 @@ +module VertexMap = Map.Make(String) + +type t = ((string * int) list) VertexMap.t +type edge = string * string * int + +exception Invalid of string + +(** [empty] is the empty digraph. *) +let empty = VertexMap.empty + +(** [validate_edge (v1, v2, ed_len)] checks whether an edge is valid. + * It raises [Invalid] if either vertex is empty, if the vertices + * are the same, or if the edge length is not positive. + *) +let validate_edge ((v1, v2, ed_len) : edge) : unit = + if v1 = "" then + raise (Invalid "source vertex cannot be empty") + else if v2 = "" then + raise (Invalid "destination vertex cannot be empty") + else if v1 = v2 then + raise (Invalid "source and destination must be distinct") + else if ed_len <= 0 then + raise (Invalid "edge length must be positive") + else + () + +(** [add_edge (v1, v2, ed_len) graph] returns a new graph with the given + * directed edge added. + * It raises [Invalid] if the edge is invalid or if an edge with the + * same source and destination already exists. + *) +let add_edge ((v1, v2, ed_len) : edge) (graph : t) : t = + let _ = validate_edge (v1, v2, ed_len) in + let existing_edges = + match VertexMap.find_opt v1 graph with + | Some edges -> edges + | None -> [] + in + if List.exists (fun (dest, _) -> dest = v2) existing_edges then + raise (Invalid "duplicate edge") + else + VertexMap.add v1 ((v2, ed_len) :: existing_edges) graph + +(** [of_edges ls] builds a digraph from the list of edges [ls]. + * It raises [Invalid] if any edge in [ls] is invalid or duplicated. + *) +let of_edges (ls : edge list) : t = + List.fold_left (fun acc edge -> add_edge edge acc) empty ls + +(** [edges graph] returns a sorted list of all distinct edges in [graph]. + * The edges are sorted first by source vertex, then by destination vertex. + *) +let edges (graph : t) : edge list = + let compare_edges (v1, v2, _) (va, vb, _) = + let cmp1 = String.compare v1 va in + if cmp1 <> 0 then + cmp1 + else + String.compare v2 vb + in + let all_edges = + VertexMap.fold + (fun src neighbors acc -> + List.fold_left + (fun inner_acc (dest, len) -> (src, dest, len) :: inner_acc) + acc + neighbors) + graph + [] + in + List.sort compare_edges all_edges + +(** [vertices graph] returns a sorted list of all distinct vertices + * in [graph]. + * This includes vertices that appear only as destinations. + *) +let vertices (graph : t) : string list = + let vertex_list = + VertexMap.fold + (fun src neighbors acc -> + let acc_with_src = src :: acc in + List.fold_left + (fun inner_acc (dest, _) -> dest :: inner_acc) + acc_with_src + neighbors) + graph + [] + in + List.sort_uniq String.compare vertex_list + +(** [neighbors vtx graph] returns the outgoing neighbors of [vtx] + * as a list of [(destination, length)] pairs. + * If [vtx] has no outgoing edges, it returns the empty list. + *) +let neighbors vtx (graph : t) : (string * int) list = + match VertexMap.find_opt vtx graph with + | Some verts -> verts + | None -> [] diff --git a/assignment/digraph.mli b/assignment/digraph.mli new file mode 100644 index 0000000..eebbd60 --- /dev/null +++ b/assignment/digraph.mli @@ -0,0 +1,35 @@ +type t (* the abstract digraph type *) +type edge = string * string * int (* type of an edge *) + +(** raised by [add_edge] and [of_edges] when adding an edge to a digraph; + this could happen when the edge has non-positive length, or the 2 vertices + in the edge are not distinct, or the edge to add is a "duplicate" in the + sense that there is already an edge in the graph with the same source + and destination vertices, and which can be of the same length or of + different lengths. +*) +exception Invalid of string (* the string argument specifies the reason *) + +(** [empty] is the empty digraph *) +val empty : t + +(** [add_edge edge graph] adds [edge] to [graph]. + Raises: [Inv_edge] if [edge] is invalid; raises [Inv_graph] if [edge] is + a duplicate with a different length *) +val add_edge : edge -> t -> t + +(** [of_edges edges] is the digraph formed from the list [edges]. + May raise [Inv_edge] or [Inv_graph] (see above) *) +val of_edges : edge list -> t + +(** [edges graph] is the sorted list of all distinct edges in [graph] *) +val edges : t -> edge list + +(** [vertices graph] is the list of all distinct vertices (in alphabetical + order) of [graph] *) +val vertices : t -> string list + +(** [neighbors vertex graph] is the list of neighbors of [vertex] in + [graph]; each neighbor is a pair of the form ([vertex2], [length]) which + indicates there is an edge from [vertex] to [vetex2] of length [length]) *) +val neighbors : string -> t -> (string * int) list diff --git a/assignment/graph b/assignment/graph new file mode 100644 index 0000000..89f63f9 --- /dev/null +++ b/assignment/graph @@ -0,0 +1,11 @@ +A C 2 # sample graph data +B A 4 # an edge +C B 6 # the following line is invalid and is skipped +A D A + C D 5 + C E 1 + D E 3 + E B 2 + E F 1 + F D 2 + diff --git a/assignment/main.ml b/assignment/main.ml new file mode 100644 index 0000000..62df5e9 --- /dev/null +++ b/assignment/main.ml @@ -0,0 +1,155 @@ +open Digraph + +(** [read_file src] returns all lines from the file named [src] + * in the same order they appear in the file. + *) +let read_file src = + let ic = open_in src in + let rec read_file_line acc = + try + let line = input_line ic in + read_file_line (line :: acc) + with + | End_of_file -> + close_in ic; + List.rev acc + in + read_file_line [] + +(** [parse_line line] tries to parse [line] as an edge. + * It uses only the first 3 words and ignores any extra words. + * It returns [None] if [line] does not contain 2 vertices followed + * by an integer edge length. + *) +let parse_line line = + let parts = String.split_on_char ' ' line in + let filtered_parts = List.filter (fun x -> x <> "") parts in + match filtered_parts with + | src :: dst :: len_str :: _ -> + ( + try + let len = int_of_string len_str in + Some (src, dst, len) + with + | Failure _ -> None + ) + | _ -> None + +(** [read_data src] reads graph data from the file named [src] + * and returns the resulting digraph. + * Lines that do not match the expected format are skipped. + * It may raise [Invalid] if a parsed edge is invalid or duplicated. + *) +let read_data src = + let lines = read_file src in + let edge_list = + List.fold_right + (fun line acc -> + match parse_line line with + | Some edge -> edge :: acc + | None -> acc) + lines + [] + in + Digraph.of_edges edge_list + +(** [update_distance vertex new_dist dist_list] returns a new distance + * list where [vertex] has distance [new_dist]. + * If [vertex] is not already present, it is added. + *) +let rec update_distance vertex new_dist dist_list = + match dist_list with + | [] -> [(vertex, new_dist)] + | (v, d) :: rest -> + if v = vertex then + (v, new_dist) :: rest + else + (v, d) :: update_distance vertex new_dist rest + +(** [find_min_vertex dist_list unvisited] returns [Some (v, d)] where [v] + * is the unvisited vertex with the smallest distance in [dist_list]. + * It returns [None] if no unvisited vertex remains. + *) +let find_min_vertex dist_list unvisited = + List.fold_left + (fun acc (v, d) -> + if not (List.mem v unvisited) then + acc + else + match acc with + | None -> Some (v, d) + | Some (_, d_min) -> + if d < d_min then + Some (v, d) + else + acc) + None + dist_list + +(** [update_predecessor vertex pred pred_list] returns a new predecessor + * list where [vertex] has predecessor [pred]. + * If [vertex] is not already present, it is added. + *) +let rec update_predecessor vertex pred pred_list = + match pred_list with + | [] -> [(vertex, Some pred)] + | (v, p) :: rest -> + if v = vertex then + (v, Some pred) :: rest + else + (v, p) :: update_predecessor vertex pred rest + +(** [construct_path prev_list v acc] builds the path ending at [v] + * by following predecessors in [prev_list]. + * The list [acc] stores the path built so far. + *) +let rec construct_path prev_list v acc = + match List.assoc v prev_list with + | None -> acc + | Some u -> construct_path prev_list u (u :: acc) + +(** [shortest_path src dst graph] returns a pair containing the total + * length of a shortest path from [src] to [dst] in [graph], and the + * path itself as a list of vertices from [src] to [dst]. + * It raises [Failure] if no path exists or if either vertex is missing. + *) +let shortest_path src dst graph = + let verts = Digraph.vertices graph in + if not (List.mem src verts) || not (List.mem dst verts) then + failwith "No path found" + else + let dist_list = + List.map (fun v -> (v, if v = src then 0 else max_int)) verts + in + let prev_list = + List.map (fun v -> (v, None)) verts + in + let rec dijkstra_helper dist_list prev_list unvisited = + match find_min_vertex dist_list unvisited with + | None -> failwith "No path found" + | Some (u, d_u) -> + if d_u = max_int then + failwith "No path found" + else if u = dst then + let path = construct_path prev_list u [u] in + (d_u, path) + else + let neighbors_list = Digraph.neighbors u graph in + let (dist_list', prev_list') = + List.fold_left + (fun (d_acc, p_acc) (v, weight) -> + let d_v = List.assoc v d_acc in + let alt = d_u + weight in + if alt < d_v then + let d_acc' = update_distance v alt d_acc in + let p_acc' = update_predecessor v u p_acc in + (d_acc', p_acc') + else + (d_acc, p_acc)) + (dist_list, prev_list) + neighbors_list + in + let unvisited' = List.filter (fun x -> x <> u) unvisited in + dijkstra_helper dist_list' prev_list' unvisited' + in + dijkstra_helper dist_list prev_list verts