(* split a string [s] at every char [c], and return the list of sub-strings *)
let split s c =
let len = String.length s in
let rec iter pos to_rev =
if pos = len then List.rev ("" :: to_rev) else
try
let pos2 = String.index_from s pos c in
if pos2 = pos then iter (pos+1) ("" :: to_rev) else
iter (pos2+1) ((String.sub s pos (pos2-pos)) :: to_rev)
with Not_found -> List.rev ( String.sub s pos (len-pos) :: to_rev )
in
iter 0 [];;
let int_list_of_chan chan = List.map int_of_string (split (input_line chan) ' ');;
let time f =
let start = Sys.time () in
let x = f () in
let stop = Sys.time () in
Printf.printf "Time: %s\n" (string_of_float (stop -. start));
x ;;
module type OrderedType = sig
type t
val compare: t -> t -> int
end
module type Label = sig
type t
val get_cost : t -> int
end
module Dijkstra = struct
module MakeBase
(Vertex: OrderedType)
(Label: Label) = struct
module VMap = Map.Make (Vertex)
module VSet = Set.Make (Vertex)
let rec add_graph_edge v edge = function
| [] -> [v, [edge]]
| (v',edges as line)::graph ->
if v = v' then (v, edge::edges) :: graph
else line :: add_graph_edge v edge graph
let symmetric graph =
List.fold_right
(fun (v, edges) ->
List.fold_right (fun (v',d) -> add_graph_edge v' (v,d)) edges)
graph graph
let rec adjacency_list v = function
| [] -> []
| (v',n) :: graph -> if v = v' then n else adjacency_list v graph;;
let search_all graph src update init_label =
let rec iter seen cand now =
let map = VMap.filter (fun x _ -> (not (VSet.mem x seen))) cand in
if map = VMap.empty then cand else
let Some (closest,label) = VMap.fold
(fun v label -> function
| (Some (v',label')) as res -> if (Label.get_cost label') < (Label.get_cost label) then res else Some (v,label)
| _ -> Some (v,label))
map
None in
let ad_list = List.filter (fun (x,_) -> not (VSet.mem x seen)) (adjacency_list closest graph) in
let nexts = update cand label ad_list in
iter (VSet.add closest seen) nexts closest in
iter (VSet.add src VSet.empty) (update VMap.empty init_label (adjacency_list src graph)) src
let search graph src dst update init_label =
let rec iter seen cand now =
let Some (closest,label) = VMap.fold
(fun v label -> function
| (Some (v',label')) as res -> if (Label.get_cost label') < (Label.get_cost label) then res else Some (v,label)
| _ -> Some (v,label))
(VMap.filter (fun x _ -> (not (VSet.mem x seen))) cand)
None in
if closest = dst then label else
let ad_list = List.filter (fun (x,_) -> not (VSet.mem x seen)) (adjacency_list closest graph) in
(* let nexts = update (VMap.remove closest cand) label calc_label ad_list in *)
let nexts = update cand label ad_list in
iter (VSet.add closest seen) nexts closest in
iter (VSet.add src VSet.empty) (update VMap.empty init_label (adjacency_list src graph)) src
end
module MakeOrdinary (Vertex: OrderedType) = struct
module Base = MakeBase (Vertex) (struct type t = int let get_cost = (fun x -> x) end)
include Base
let ordinary_search graph src dst =
let rec update cand cost = function
| [] -> cand
| (v,l) :: xs -> let pl = l + cost in
if VMap.mem v cand then let l' = VMap.find v cand in
update (VMap.add v (min pl l') cand) cost xs
else update (VMap.add v pl cand) cost xs in
let init_label = 0 in
search graph src dst update init_label
let ordinary_search_all graph src =
let rec update cand cost = function
| [] -> cand
| (v,l) :: xs -> let pl = l + cost in
if VMap.mem v cand then let l' = VMap.find v cand in
update (VMap.add v (min pl l') cand) cost xs
else update (VMap.add v pl cand) cost xs in
let init_label = 0 in
search_all graph src update init_label
end
module MakeOrdinaryWithPath (Vertex: OrderedType) = struct
type label = {cost: int; path: Vertex.t list}
module Base = MakeBase (Vertex) (struct type t = label let get_cost = (fun x -> x.cost) end)
include Base
let make_label cost = {cost=cost; path=[]}
let get_path label = label.path
let ordinary_search_with_path graph src dst =
let min_label l1 l2 = if l1.cost < l2.cost then l1 else l2 in
let plus_cost v l1 l2 = {l1 with cost=l1.cost + l2.cost; path=v :: (l1.path @ l2.path)} in
let rec update cand label = function
| [] -> cand
| (v,l) :: xs -> let pl = plus_cost v l label in
if VMap.mem v cand then let l' = VMap.find v cand in
update (VMap.add v (min_label pl l') cand) label xs
else update (VMap.add v pl cand) label xs in
let init_label = {cost = 0; path=[];} in
search graph src dst update init_label
end
end
type label = {cost: int; end_point: int; sleep_cost: int}
module Int = struct type t = int let compare = compare end
module Nm = Dijkstra.MakeOrdinary (Int)
module Bs = Dijkstra.MakeBase (Int) (struct type t = label let get_cost = (fun x -> x.cost) end)
let rec gp_of_lbd_gp = function
| [] -> []
| (v,l) :: xs -> (v,List.map (fun (x,y) -> (x,y.cost)) l) :: gp_of_lbd_gp xs
let search graph src dst =
let dist = Nm.ordinary_search_all (gp_of_lbd_gp graph) dst in
let min_label l1 l2 = if l1.cost < l2.cost then l1 else l2 in
let rec update cand label = function
| [] -> cand
| (v,l) :: xs -> let pl = l.cost + label.cost in
let sleep_case = if l.end_point = dst then 0 else
Nm.VMap.find (l.end_point) dist in
let fixed = {l with cost = (max pl (sleep_case + l.sleep_cost))} in
if Bs.VMap.mem v cand
then update (Bs.VMap.add v (min_label fixed (Bs.VMap.find v cand)) cand) label xs
else update (Bs.VMap.add v fixed cand) label xs
in
let init_label = {cost = 0;end_point = -1;sleep_cost = 0;} in
let {cost=ret} = Bs.search graph dst src update init_label in ret
let rec last = function
| [] -> None
| x :: [] -> Some x
| x :: xs -> last xs;;
let read_rails chan m =
let rec graph_of_rail stations costs total start last graph now =
match stations,costs with
| ([],_) | (_,[]) -> graph
| (x :: [] , y :: _ ) -> failwith "error"
| (x :: (x' :: xs as nxt), y :: ys) ->
let graph = (Bs.add_graph_edge x (x',{cost=y;end_point=start;sleep_cost=now+y;}) graph) in
let graph = (Bs.add_graph_edge x'(x,{cost=y;end_point=last;sleep_cost=total - now;}) graph) in
graph_of_rail nxt ys total start last graph (now + y) in
let rec iter graph m =
match m with
| 0 -> graph
| _ -> let _ = input_line chan in
let stations = int_list_of_chan chan in
let start = List.hd stations in
let (Some last) = last stations in
let costs = int_list_of_chan chan in
let total = List.fold_left (fun x y -> x + y) 0 costs in
let graph = graph_of_rail stations costs total start last graph 0 in
(iter graph (m - 1)) in
iter [] m;;
(* let chan = open_in "test.txt";; *)
let chan = stdin;;
let [n;m;src;dst] = int_list_of_chan chan;;
let rails = read_rails chan m;;
search rails src dst |> string_of_int |> print_endline;;
File "./Main.ml", line 60, characters 14-34:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
None
File "./Main.ml", line 73, characters 12-32:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
None
File "./Main.ml", line 119, characters 30-93:
Warning 23: all the fields are explicitly listed in this record:
the 'with' clause is useless.
File "./Main.ml", line 176, characters 15-26:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
None
File "./Main.ml", line 186, characters 4-17:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
[]