Submission #3216790

---

Source Code Expand

module DirectedGraph
  (Vertex : sig
    type t
    val compare : t -> t -> int
  end) :
sig
  (* トポロジカルソート *)
  val sort :
    (* 頂点のリスト *)
    Vertex.t list ->
    (* 隣接リスト *)
    (Vertex.t -> Vertex.t list) ->
    Vertex.t list

  (* 強連結成分分解 *)
  val scc :
    (* 頂点のリスト *)
    Vertex.t list ->
    (* 隣接リスト *)
    (Vertex.t -> Vertex.t list) ->
    Vertex.t list list
end =
struct
  module VSet = Set.Make (Vertex)

  let rec visit es v (vs, l) =
    if VSet.mem v vs then
      let (vs', l') =
        List.fold_right (visit es) (es v) (VSet.remove v vs, l) in
      (vs', v :: l')
    else (vs, l)

  let sort vs es =
    snd (List.fold_right (visit es) vs (VSet.of_list vs, []))

  let scc vs es =
    sort vs es
    |> List.rev
    |> List.fold_left (fun (vs, l) v ->
        if VSet.mem v vs then
          let (vs', cs) = visit es v (vs, []) in
          (vs', cs :: l)
        else (vs, l)) (VSet.of_list vs, [])
    |> snd
end

module Int = struct
  type t = int
  let compare = compare
end
module G = DirectedGraph (Int)
module IntMap = Map.Make (Int)

let rec select acc trace = function
  | [] -> acc
  | x :: xs -> select ((trace, x, xs) :: acc) (x :: trace) xs
let select xs = select [] [] xs

let () = Scanf.scanf "%d %d %d\n" @@ fun n m k ->
  let cs = Array.init n @@ fun _ ->
    Scanf.scanf "%c " @@ fun c -> c in
  let es = Array.make n [] in
  for i = 0 to m - 1 do
    Scanf.scanf "%d %d\n" @@ fun a b ->
      es.(a - 1) <- b - 1 :: es.(a - 1)
  done;
  let scc =
    Array.of_list @@
    G.scc (Array.to_list @@ Array.init n @@ fun v -> v) (Array.get es) in
  let group = Array.make n 0 in
  Array.iteri (fun i -> List.iter (fun v -> group.(v) <- i)) scc;
  let dp = Array.make (Array.length scc) (IntMap.singleton 0 []) in
  for i = Array.length scc - 1 downto 0 do
    let m =
      List.fold_left (IntMap.merge (fun _ xs ys ->
        match xs, ys with
        | None, _ -> ys
        | _, None -> xs
        | Some x, Some y -> Some (min x y))) (IntMap.singleton 0 []) @@
      List.rev_map (Array.get dp) @@
      List.sort_uniq compare @@
      List.concat @@
      List.rev_map (fun v -> List.rev_map (Array.get group) es.(v)) scc.(i) in
    let css = select @@ List.sort compare @@ List.rev_map (Array.get cs) scc.(i) in
    dp.(i) <-
      IntMap.fold (fun i s ->
        List.fold_right (fun (s', c, _) m ->
          IntMap.add (i + List.length s' + 1)
            ( try min (List.rev_append s' (c :: s)) (IntMap.find (i + List.length s' + 1) m)
              with Not_found -> List.rev_append s' (c :: s) ) m) css) m m
  done;
  try
    begin
      List.iter print_char @@
      IntMap.find k @@
      Array.fold_left (IntMap.merge (fun _ xs ys ->
        match xs, ys with
        | None, _ -> ys
        | _, None -> xs
        | Some x, Some y -> Some (min x y))) (IntMap.singleton 0 []) dp
    end;
    print_newline ()
  with Not_found -> print_endline "-1"

Submission Info

Judge Result