Submission #1890914


Source Code Expand

module type OrderedType = sig
  type t
  val compare: t -> t -> int
end
                 
module BinaryHeap = struct                        
 module MakeHash (Label: OrderedType) = struct
    type 'a with_empty =
      | Empty
      | Value of 'a 
 
    type tree = { count: int ref; ary: Label.t with_empty array }
 
    let make_empty_tree q = { count=ref 0; ary=Array.make (q+1) Empty}
 
    let exc_of_opt = function 
      | Some x -> x
      | None -> failwith "error"
 
    let get_value num tree = Array.get tree.ary num
 
    let is_empty num tree =
      match get_value num tree with
      | Empty -> true
      | _ -> false
 
    let is_root num = num <= 1
 
    let set_value num value tree = Array.set tree.ary num value
 
    let get_tail tree = get_value !(tree.count) tree
 
    let set_root value tree = set_value 1 value tree
 
    let get_root tree = get_value 1 tree
 
    let remove_tail tree = let res = get_tail tree in
                           let count = !(tree.count) in
                           let () = Array.set tree.ary count Empty in
                           let () = tree.count := (count - 1) in
                           res
 
    let add_tail v tree = let () = tree.count := !(tree.count) + 1 in
                          let () = Array.set tree.ary !(tree.count) v in !(tree.count)
 
    let parent_num num = num / 2                       
 
    let left_child_num num = 2 * num
 
    let right_child_num num = 2 * num + 1
 
    let swap num num' tree =
      let tmp = get_value num tree in
      let () = set_value num (get_value num' tree) tree in
      let () = set_value num' tmp tree in ()
 
    let gt num num' tree =
      match get_value num tree,get_value num' tree with
      | Empty,_ -> false
      | _,Empty -> true
      | Value x,Value y -> Label.compare x y > 0
 
    let max_of_elems num num' tree =
      if gt num num' tree then num else num'
      
    let rec up_heap child tree =
      if is_root child then ()
      else
        let parent = parent_num child in
        let () = if gt child parent tree then swap child parent tree else () in
        up_heap parent tree
 
    let add q tree =
      let tail = add_tail (Value q) tree in
      let () = up_heap tail tree in tree
 
    let rec down_heap parent tree =
      if is_empty parent tree then ()
      else
        let left = left_child_num parent in
        let right = right_child_num parent in
        let mc = max_of_elems left right tree in
        let () = if gt mc parent tree then swap mc parent tree else () in
        down_heap mc tree
 
    let remove tree =
      match get_root tree with
      | Empty -> None
      | Value x ->
         let tail_v = remove_tail tree in
         match get_root tree with
         | Empty -> Some (x,tree)
         | _ -> let () = set_root tail_v tree in
                let () = down_heap 1 tree in Some (x,tree)
                                           
    let rec add_list ls tree =
      match ls with
      | [] -> ()
      | x :: xs -> let _ = add x tree in
                   add_list xs tree
 
    let list_of_tree tree =
      let rec iter () = 
        match remove tree with
        | None -> []
        | Some (x,_) -> x :: iter () in
      iter ()
 
    let find q tree =
      let merge_opt opt1 opt2 =
        match opt1,opt2 with
        | None,None -> None
        | Some _,None -> opt1
        | None,Some _-> opt2
        | Some _,Some _ -> opt1 in
      let rec iter num =
        match get_value num tree with
        | Empty -> None
        | Value x -> if Label.compare x q = 0 then Some x
                     else if Label.compare x q < 0 then None
                     else
                       let left = left_child_num num in
                       let right = right_child_num num in
                       match get_value left tree,get_value right tree with
                       | Empty,Empty-> None
                       | Value l,Empty -> iter left
                       | Empty,Value r -> iter right
                       | Value l,Value r -> if Label.compare l q >= 0 && Label.compare r q >= 0
                                            then merge_opt (iter left) (iter right)
                                            else if Label.compare l q >= 0 then iter left
                                            else if Label.compare r q >= 0 then iter right
                                            else None
      in iter 1
    let mem v tree =
      match find v tree with
      | Some _ -> true
      | None -> false
 end
  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.MakeHash (LeftProj)
module Cda = BinaryHeap.MakeHash (RightProja)
module Cd = BinaryHeap.MakeHash (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.make_empty_tree 25252) 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.make_empty_tree 25252) (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.cost
       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.make_empty_tree 25252) (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 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 13458 Byte
Status RE
Exec Time 1334 ms
Memory 18688 KB

Judge Result

Set Name Subtask1 Subtask2
Score / Max Score 50 / 50 0 / 50
Status
AC × 52
RE × 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 RE 1148 ms 18688 KB
large/20_large-01 RE 1161 ms 18304 KB
large/20_large-02 RE 1206 ms 18304 KB
large/20_large-03 RE 1299 ms 18432 KB
large/20_large-04 RE 1334 ms 18304 KB
large/31_max_large RE 84 ms 12416 KB
small/00_sample00 AC 1 ms 1024 KB
small/00_sample01 AC 1 ms 1024 KB
small/00_sample02 AC 2 ms 2816 KB
small/10_small-0000 AC 10 ms 3712 KB
small/10_small-0001 AC 7 ms 2176 KB
small/10_small-0002 AC 7 ms 3968 KB
small/10_small-0003 AC 6 ms 1920 KB
small/10_small-0004 AC 8 ms 3712 KB
small/10_small-0005 AC 8 ms 3840 KB
small/10_small-0006 AC 8 ms 2048 KB
small/10_small-0007 AC 8 ms 2176 KB
small/10_small-0008 AC 7 ms 1920 KB
small/10_small-0009 AC 7 ms 3584 KB
small/10_small-0010 AC 6 ms 3968 KB
small/10_small-0011 AC 7 ms 1920 KB
small/10_small-0012 AC 8 ms 2048 KB
small/10_small-0013 AC 7 ms 2048 KB
small/10_small-0014 AC 7 ms 3584 KB
small/10_small-0015 AC 9 ms 2176 KB
small/10_small-0016 AC 6 ms 1792 KB
small/10_small-0017 AC 8 ms 2048 KB
small/10_small-0018 AC 8 ms 2176 KB
small/10_small-0019 AC 8 ms 1920 KB
small/30_max_small AC 5 ms 1792 KB
small/40_simple_0000 AC 2 ms 3072 KB
small/40_simple_0001 AC 1 ms 1024 KB
small/40_simple_0002 AC 2 ms 2944 KB
small/40_simple_0003 AC 1 ms 1024 KB
small/40_simple_0004 AC 1 ms 1024 KB
small/40_simple_0005 AC 2 ms 2688 KB
small/40_simple_0006 AC 2 ms 2688 KB
small/40_simple_0007 AC 1 ms 1024 KB
small/40_simple_0008 AC 1 ms 1024 KB
small/40_simple_0009 AC 1 ms 1024 KB
small/40_simple_0010 AC 2 ms 2560 KB
small/40_simple_0011 AC 2 ms 1024 KB
small/40_simple_0012 AC 1 ms 1024 KB
small/40_simple_0013 AC 1 ms 1024 KB
small/40_simple_0014 AC 1 ms 1024 KB
small/40_simple_0015 AC 2 ms 2816 KB
small/40_simple_0016 AC 1 ms 1024 KB
small/40_simple_0017 AC 2 ms 3072 KB
small/40_simple_0018 AC 1 ms 1024 KB
small/40_simple_0019 AC 1 ms 1024 KB
small/90_dijkstra_killer_00 AC 1 ms 1024 KB
small/90_dijkstra_killer_01 AC 1 ms 1024 KB
small/91_tayama_killer_00 AC 1 ms 1024 KB
small/91_tayama_killer_01 AC 1 ms 1024 KB
small/91_tayama_killer_02 AC 2 ms 1024 KB
small/91_tayama_killer_03 AC 2 ms 1024 KB
small/91_tayama_killer_04 AC 1 ms 1024 KB
small/91_tayama_killer_05 AC 2 ms 1024 KB