Submission #1890793


Source Code Expand

module type OrderedType = sig
  type t
  val compare: t -> t -> int
end
                 
module BinaryHeap = struct                        
  module Make (Label: OrderedType) = struct
    type 'a tree =
      | Empty
      | Node of int * 'a * 'a tree * 'a tree

    let empty = Empty

    let rank_of_tree = function
      | Empty -> 0
      | Node(rank,_,_,_) -> rank

    let gt q q' = if Label.compare q q' > 0 then (q,q') else (q',q)

    let rec gt3 q q' q'' = if Label.compare q q' < 0 then
                             if Label.compare q' q'' < 0 then (q'',q',q)
                             else if Label.compare q q'' < 0 then (q',q'',q)
                             else (q',q,q'')
                           else
                             if Label.compare q q'' < 0 then (q'',q,q')
                             else if Label.compare q' q'' < 0 then (q,q'',q')
                             else (q,q',q'')

    let make_leaf q = Node (1,q,Empty,Empty)

    let make_triple q q' q'' =
      let y,y',y'' = gt3 q q' q'' in Node (2,y,Node (1,y',Empty,Empty),Node (1,y'',Empty,Empty))

    let make_couple q q' = let y,y' = gt q q' in Node (2,y,Node (1,y',Empty,Empty),Empty)

    let is_leaf = function
      | Node (_,_,Empty,Empty) -> true
      | _ -> false

    let rec count_rank = function
      | Empty -> 0
      | Node (_,_,l,r) -> (max (count_rank l) (count_rank r)) + 1

    let rec find key = function
      | Empty -> None
      | Node (rank,v,l,r) -> if Label.compare key v = 0 then Some v
                             else if Label.compare v key > 0 then
                               match find key l,find key r with
                               | None,None -> None
                               | Some v,_ | _,Some v -> Some v
                             else None

    let rec remove = function
      | Empty -> None
      | Node (rank,v,l,r) ->
         match l,r with
         | Empty,Empty -> Some (v,Empty)
         | Empty,(Node (_,x,_,_) as t)| (Node (_,x,_,_) as t),Empty -> Some (v,t)
         | Node (rank',x',_,_),Node (rank'',x'',_,_) ->
            (* let () = assert (abs (rank' - rank'') <= 2) in *)
            if Label.compare x' x'' < 0 then
              (match remove r with
               | None -> None
               | Some (_,nr) -> 
                  Some (v,Node ((min rank' (rank_of_tree nr)) + 1,x'',l,nr)))
            else
              (match remove l with
               | None -> None
               | Some (_,nl) -> 
                  Some (v,Node ((min rank'' (rank_of_tree nl) + 1,x',nl,r))))

    let rec add q = function
      | Empty -> make_leaf q
      | Node (_,v,l,r) ->
         match l,r with
         | Empty,Empty -> make_couple v q
         | Empty,(Node (_,x,_,_) as t)| (Node (_,x,_,_) as t),Empty -> let y,y' = gt v q in
                                                                       Node (1,y,t,make_leaf y')
         | Node (rank',_,_,_),Node (rank'',_,_,_) ->
            (* let () = assert (abs (rank' - rank'') <= 2) in *)
            let y,y' = gt v q in
            if rank' > rank'' then
              let nr = add y' r in
              Node ((min rank'  (rank_of_tree nr)) + 1,y,l,nr)
            else
              let nl = add y' l in
              Node ((min rank'' (rank_of_tree nl)) + 1,y,nl,r)
    let mem key tree =
      match find key tree with
      | None -> false
      | Some _ -> true
  end
end

type label_t = {cost: Int64.t; end_point: int; sleep_cost: int}

let init_cost = Int64.zero

type v_t = int * label_t

let left_proj = (fun (x,_) (y,_) -> compare x y)

let right_proj = (fun (_,x) (_,y) -> compare y x)

module Vert = struct
  type t = int
  let compare = compare
end
module LeftProj = struct
  type t = int * Int64.t
  let compare = left_proj
end
module RightProj = struct
  type t = int * Int64.t
  let compare = right_proj
end
module RightProja = struct
  type t = v_t
  let compare = (fun (_,x) (_,y) -> compare y.cost x.cost)
end

module Ex = Set.Make (Vert)
module Gp = Map.Make (Vert)
module Log = BinaryHeap.Make (LeftProj)
module Cda = BinaryHeap.Make (RightProja)
module Cd = BinaryHeap.Make (RightProj)

let empty = Gp.empty
              
let rec graph_of_adjacency_form = function
  | [] -> Gp.empty
  | (v,edges) :: xs -> Gp.add v edges (graph_of_adjacency_form xs)

let add_graph_edge v edge graph =
  try
    Gp.add v (edge::(Gp.find v graph)) graph
  with _ -> Gp.add v [edge] graph

let symmetric graph =
  Gp.fold (fun v edges gp -> List.fold_left (fun gp' (v',d) -> add_graph_edge v' (v,d) gp') gp edges) graph graph

let rec adjacency_list v graph =
  try
    Gp.find v graph
  with _ -> []

let get_label x seen =
  match Log.find (x,init_cost) seen with
  | None -> None
  | Some (_,v) -> Some v

let search_all merge_label graph src =
  let update log cost = List.fold_left
                          (fun cand (v,l) ->
                            if Log.mem (v,l.cost) log then cand
                            else Cd.add (v,merge_label v l.cost cost) cand) in
  let log = Log.add (src,init_cost) Log.empty in
  let rec iter log cand =
    match Cd.remove cand with
    | None -> log
    | Some ((closest,label),cand') ->
       if Log.mem (closest,label) log then iter log cand'
       else let log' = Log.add (closest,label) log in
            let next = update log' label cand' (adjacency_list closest graph) in
            iter log' next in
  iter log (update log init_cost Cd.empty (adjacency_list src graph))

let search merge_label graph src dst =
  let update seen cost = List.fold_left
                           (fun cand (v,l) ->
                             if Ex.mem v seen then cand
                             else Cda.add (v,merge_label v l cost) cand) in
  let seen = Ex.add src Ex.empty in
  let rec iter seen cand =
    match Cda.remove cand with
    | None -> None
    | Some ((closest,label),cand') ->
       if closest = dst then Some label
       else if Ex.mem closest seen then iter seen cand'
       else let seen' = Ex.add closest seen in
            let next = update seen' label.cost cand' (adjacency_list closest graph) in
            iter seen' next in
  iter seen (update seen init_cost Cda.empty (adjacency_list src graph))

let int_list_of_line len =
  let rec iter n =
    if n = 1 then Scanf.scanf "%d\n" (fun x -> x) :: iter 2
    else if n <= len then Scanf.scanf "%d " (fun x -> x) :: iter (n + 1)
    else [] in
  List.rev (iter 1)

let int_list_of_line_with_fold_left len f init =
  let apply f v (v',ls) = (f v' v,v :: ls) in
  let rec iter n =
    if n = 1 then apply f (Scanf.scanf "%d\n" (fun x -> x)) (iter 2)
    else if n <= len then apply f (Scanf.scanf "%d " (fun x -> x)) (iter (n + 1))
    else (init,[]) in
  let (v,ls) = iter 1 in (v,List.rev ls)

let int_list_of_line_conti len ls =
  let rec iter n =
    if n <= len then Scanf.scanf "%d " (fun x -> x) :: iter (n + 1)
    else ls in
  iter 1
  
let read_rails 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 = (add_graph_edge x (x',{cost=Int64.of_int y;end_point=start;sleep_cost=now+y;}) graph) in
       let graph = (add_graph_edge x'(x,{cost=Int64.of_int 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 n = Scanf.scanf "%d\n" (fun x -> x) in
           let start = Scanf.scanf "%d " (fun x -> x) in
           let stations = int_list_of_line_conti (n - 2) [start] in
           let last = Scanf.scanf "%d " (fun x -> x) in
           let stations = List.rev (last :: stations) in
           let total,costs = int_list_of_line_with_fold_left (n - 1) (fun x y -> x + y) 0 in
           let graph = graph_of_rail stations costs total start last graph 0 in
           (iter graph (m - 1)) in
  iter empty m
  
let search_ex graph src dst = 
  let dist = search_all (fun _ y z -> Int64.add y z) graph dst in
  let merge_label v l cost =
    match get_label l.end_point dist with
    | Some sleep_case ->
       {l with cost = max (Int64.add l.cost cost) (Int64.add (Int64.of_int l.sleep_cost) sleep_case)} 
    | _ -> failwith "error" in
    match search merge_label graph dst src with
    | Some {cost=res}  -> Int64.to_int res
    | None -> failwith "error"

let (n,m,src,dst) = Scanf.scanf "%d %d %d %d\n" (fun x y z w -> (x,y,z,w))

let rails = read_rails m

let () = search_ex rails src dst |> string_of_int |> print_endline

Submission Info

Submission Time
Task C - メンテナンス明け
User tzskp1
Language OCaml (4.02.3)
Score 50
Code Size 8867 Byte
Status TLE
Exec Time 2657 ms
Memory 22564 KB

Judge Result

Set Name Subtask1 Subtask2
Score / Max Score 50 / 50 0 / 50
Status
AC × 52
TLE × 6
Set Name Test Cases
Subtask1 small/00_sample00, small/00_sample01, small/00_sample02, small/10_small-0000, small/10_small-0001, small/10_small-0002, small/10_small-0003, small/10_small-0004, small/10_small-0005, small/10_small-0006, small/10_small-0007, small/10_small-0008, small/10_small-0009, small/10_small-0010, small/10_small-0011, small/10_small-0012, small/10_small-0013, small/10_small-0014, small/10_small-0015, small/10_small-0016, small/10_small-0017, small/10_small-0018, small/10_small-0019, small/30_max_small, small/40_simple_0000, small/40_simple_0001, small/40_simple_0002, small/40_simple_0003, small/40_simple_0004, small/40_simple_0005, small/40_simple_0006, small/40_simple_0007, small/40_simple_0008, small/40_simple_0009, small/40_simple_0010, small/40_simple_0011, small/40_simple_0012, small/40_simple_0013, small/40_simple_0014, small/40_simple_0015, small/40_simple_0016, small/40_simple_0017, small/40_simple_0018, small/40_simple_0019, small/90_dijkstra_killer_00, small/90_dijkstra_killer_01, small/91_tayama_killer_00, small/91_tayama_killer_01, small/91_tayama_killer_02, small/91_tayama_killer_03, small/91_tayama_killer_04, small/91_tayama_killer_05
Subtask2 large/20_large-00, large/20_large-01, large/20_large-02, large/20_large-03, large/20_large-04, large/31_max_large
Case Name Status Exec Time Memory
large/20_large-00 TLE 2657 ms 20736 KB
large/20_large-01 TLE 2656 ms 21664 KB
large/20_large-02 TLE 2656 ms 22556 KB
large/20_large-03 TLE 2656 ms 22564 KB
large/20_large-04 TLE 2656 ms 20736 KB
large/31_max_large TLE 2656 ms 13312 KB
small/00_sample00 AC 1 ms 384 KB
small/00_sample01 AC 1 ms 384 KB
small/00_sample02 AC 1 ms 2432 KB
small/10_small-0000 AC 8 ms 2304 KB
small/10_small-0001 AC 6 ms 2304 KB
small/10_small-0002 AC 5 ms 1792 KB
small/10_small-0003 AC 5 ms 1792 KB
small/10_small-0004 AC 6 ms 1920 KB
small/10_small-0005 AC 6 ms 2048 KB
small/10_small-0006 AC 7 ms 2176 KB
small/10_small-0007 AC 7 ms 2304 KB
small/10_small-0008 AC 6 ms 1792 KB
small/10_small-0009 AC 6 ms 2048 KB
small/10_small-0010 AC 5 ms 1920 KB
small/10_small-0011 AC 6 ms 1792 KB
small/10_small-0012 AC 6 ms 2048 KB
small/10_small-0013 AC 6 ms 2048 KB
small/10_small-0014 AC 5 ms 1792 KB
small/10_small-0015 AC 8 ms 2304 KB
small/10_small-0016 AC 5 ms 1664 KB
small/10_small-0017 AC 7 ms 2176 KB
small/10_small-0018 AC 7 ms 2304 KB
small/10_small-0019 AC 6 ms 1920 KB
small/30_max_small AC 4 ms 1280 KB
small/40_simple_0000 AC 1 ms 384 KB
small/40_simple_0001 AC 1 ms 384 KB
small/40_simple_0002 AC 1 ms 384 KB
small/40_simple_0003 AC 1 ms 384 KB
small/40_simple_0004 AC 1 ms 384 KB
small/40_simple_0005 AC 1 ms 384 KB
small/40_simple_0006 AC 1 ms 384 KB
small/40_simple_0007 AC 1 ms 384 KB
small/40_simple_0008 AC 1 ms 384 KB
small/40_simple_0009 AC 1 ms 384 KB
small/40_simple_0010 AC 1 ms 384 KB
small/40_simple_0011 AC 1 ms 384 KB
small/40_simple_0012 AC 1 ms 384 KB
small/40_simple_0013 AC 1 ms 384 KB
small/40_simple_0014 AC 1 ms 384 KB
small/40_simple_0015 AC 1 ms 384 KB
small/40_simple_0016 AC 1 ms 384 KB
small/40_simple_0017 AC 1 ms 384 KB
small/40_simple_0018 AC 1 ms 384 KB
small/40_simple_0019 AC 2 ms 384 KB
small/90_dijkstra_killer_00 AC 1 ms 512 KB
small/90_dijkstra_killer_01 AC 1 ms 512 KB
small/91_tayama_killer_00 AC 1 ms 384 KB
small/91_tayama_killer_01 AC 1 ms 384 KB
small/91_tayama_killer_02 AC 1 ms 384 KB
small/91_tayama_killer_03 AC 1 ms 512 KB
small/91_tayama_killer_04 AC 1 ms 384 KB
small/91_tayama_killer_05 AC 1 ms 384 KB