```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;
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 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)

```