open Format

let n = int_of_string Sys.argv.(1)
let target_out = Array.create n 0
let target_plink = Array.create n 0

let () =
  try
    while true do
      let s = read_line () in
      Scanf.sscanf s "%d -> (%d,%d)" 
	(fun i j k -> target_out.(i) <- j; target_plink.(i) <- k)
    done
  with End_of_file ->
    ()

let () =
  for i = 0 to n-1 do
    printf "%d -> (%d,%d)@." i target_out.(i) target_plink.(i)
  done;
  printf "---@."


(* the infamous bubble sort *)

let t = Array.copy target_out
let cur = Array.init n (fun i -> i)
let plink = Array.create n 0

let solution = ref []
let matrix = Array.create_matrix n n []

let swap line i =
  let tmp = t.(i) in t.(i) <- t.(i+1); t.(i+1) <- tmp;
  plink.(cur.(i)) <- plink.(cur.(i)) + 1;
  let tmp = cur.(i) in cur.(i) <- cur.(i+1); cur.(i+1) <- tmp;
  match !solution with
    | (l, sw) :: r when l = line -> solution := (l, i :: sw) :: r
    | sol -> solution := (line, [i]) :: sol

let update_matrix line =
  for i = 0 to n-2 do
    matrix.(cur.(i)).(cur.(i+1)) <- (line, i) :: matrix.(cur.(i)).(cur.(i+1));
    matrix.(cur.(i+1)).(cur.(i)) <- (line, i) :: matrix.(cur.(i+1)).(cur.(i))
  done
    
let () =
  let line = ref 0 in

  (* hack for n=50 *)
  if n = 50 then begin
    for i = 48 downto 44 do
      update_matrix !line;
      swap !line i;
      incr line
    done
  end;

  try
    while true do
      update_matrix !line;
      let modif = ref false in
      let i = ref 0 in
      while !i < n-1 do
	if t.(!i) > t.(!i+1) then begin
	  swap !line !i;
	  modif := true;
	  i := !i + 2
	end else 
	  incr i
      done;
      if not !modif then raise Exit;
      incr line
    done
  with Exit ->
    update_matrix !line

let diff = Array.init n (fun i -> target_plink.(i) - plink.(i))
let sdiff = ref 0

let () = 
  printf "diff: "; Array.iteri (fun i di -> printf "%d " di) diff; printf "@."

let () =
  for i = 0 to n-1 do
    assert (target_out.(cur.(i)) = i);
    assert (diff.(i) >= 0);
    sdiff := !sdiff + diff.(i)
  done;
  assert (!sdiff mod 2 = 0)

(*
(* affichage matrice *)
let () =
  for i = 0 to n-1 do
    for j = 0 to n-1 do
      match matrix.(i).(j) with
	| [] -> printf " ."
	| (l,_) :: _ -> printf "%2d" l
    done;
    printf "@."
  done
*)

open Search

module I = struct

  (* the state is imperative *)
  let success () = 
    try
      Array.iteri 
	(fun _ di -> assert (di >= 0); if di > 0 then raise Exit) diff; true
    with Exit ->
      false

  (* moves *)
  type move = int * int * int

  let deg = Array.create n 0

  (* maximal constraint-based selection *)
  let moves () =
    let degree i =
      let c = ref 0 in
      for j = 0 to n-1 do 
	if matrix.(i).(j) <> [] && diff.(j) > 0 then incr c
      done;
      !c
    in
    for i = 0 to n-1 do deg.(i) <- degree i done;
    let min_d = ref 0 in
    let min_val = ref max_int in
    for i = 1 to n-1 do 
      if diff.(i) > 0 && deg.(i) < !min_val then begin 
	min_d := i; min_val := deg.(i)
      end
    done;
    let ml = ref [] in
    for i = 0 to n-1 do
      if diff.(i) > 0 && matrix.(!min_d).(i) <> [] then
 	ml := (i, !min_d, min diff.(i) diff.(!min_d)) :: !ml
    done;
    let ml = List.sort (fun (i1,_,_) (i2,_,_) -> deg.(i1) - deg.(i2)) !ml in
    let todo = ref 0 in
    for i = 0 to n-1 do if diff.(i) > 0 then incr todo done;
    match List.rev ml with
      (* heuristics go here *)
      (*
      | ((i1,_,_) as m1) :: ((i2,_,_) as m2) :: _ when !todo > 50 -> 
	  if diff.(!min_d) > diff.(i1) then [m1] else [m1; m2]
      *)
      | m1 :: _ :: _ -> [m1; List.hd ml]
      | _ -> ml
      
  let ok () =
    try
      for i = 0 to n-1 do
	if diff.(i) > 0 then begin
	  let s = ref 0 in
	  for j = 0 to n-1 do
	    if matrix.(i).(j) <> [] then s := !s + diff.(j)
	  done;
	  if !s < diff.(i) then raise Exit
	end
      done;
      true
    with Exit -> 
      false

  let moves () = if ok () then moves () else []

  let do_move (i,j,k) = diff.(i) <- diff.(i) - k; diff.(j) <- diff.(j) - k

  let undo_move (i,j,k) = diff.(i) <- diff.(i) + k; diff.(j) <- diff.(j) + k


  (* visited states are put in a hash table using function [mark] *)
  type marked_state = unit
  let mark () = None

end

module B = ImperativeDFS(I)

let display_one_swap idx =
  for i = 0 to idx-1 do Format.printf "|" done;
  Format.printf "><";
  for i = idx+2 to n-1 do Format.printf "|" done;
  Format.printf "@."

let display_swaps sl =
  let rec display i = function
    | j :: sl when j = i -> printf "><"; display (i+2) sl
    | sl -> if i < n then begin printf "|"; display (i+1) sl end
  in
  display 0 sl;
  printf "@."

let compact tps il = 
  let l,il = List.partition (fun ((l,_),_) -> l <= tps) il in
  let rec build sl = function
    | [] -> sl
    | ((t,i),k) :: l -> 
	let s,l = 
	  List.fold_right 
	    (fun (((t',i'),k') as tik') (s,l) ->
	       if List.for_all (fun j -> i' < j-1 || i' > j+1) s then
		 (i' :: s, if k' = 1 then l else ((t',i'),k'-1)::l)
	       else
		 (s, tik' :: l)
	    )
	    l ([i],[])
	in
	let s = List.sort compare s in
	build (s :: sl) (if k = 1 then l else ((t,i),k-1)::l)
  in
  build [] l, il

let () =
  let l = B.search () in
  List.iter (fun (i,j,k) -> printf "(%d,%d,%d)" i j k) l; printf "@.";
  printf "YES!@.";
  let l = List.map (fun (i,j,k) -> (List.hd matrix.(i).(j), k)) l in
  let il = List.sort (fun ((l1,i1),k1) ((l2,i2),k2) -> l1 - l2) l in
  List.iter (fun ((t,i),k) -> printf "((%d,%d),%d)" t i k) il; printf "@.";
  let rec display_inter tps = function
    | [] -> []
    | (((l,i),k) :: _) as il when l <= tps -> 
	let sl,il = compact tps il in
	List.iter (fun s -> display_swaps s; display_swaps s) sl;
	display_inter tps il
    | il -> il
  in
  let rec display il = function
    | [] -> 
	let il = display_inter max_int il in
	assert (il = [])
    | (tps, swaps) :: sol -> 
	let il' = display_inter tps il in
	display_swaps (List.rev swaps);
	display il' sol
  in
  display il (List.rev !solution)