program Details; const Nmax = 50; type PNode =^TNode; TNode = record N: Word; W: Word; B: Word; Next: PNode; end; var Rec: array[1..Nmax] of PNode; XRec: array[1..Nmax*2 + 2] of PNode; Sochet: array[1..Nmax*2] of Word; XV: set of 1..Nmax*2 + 2; S, T: Word; B, N: Word; procedure PGA; var QH, QT: PNode; procedure Put(x: Word); var PV: PNode; begin New(PV); PV^.N := x; PV^.Next := nil; if QH = nil then QH := PV else QT^.Next := PV; QT := PV; end; function Get:Word; var PV: PNode; begin Get := QH^.N; PV := QH; QH := QH^.Next; Dispose(PV); end; procedure Add(n: Word; v: Word); var PV: PNode; begin New(PV); PV^.Next := XRec[n]; PV^.N := v; XRec[n] := PV; end; var Length: array[1..Nmax*2 + 2] of integer; PV: PNode; u, x, y: Word; begin for u:=1 to 2 * N + 2 do begin Length[u] := MaxInt; { XRec[u] := nil;} end; QH := nil; XV := [s]; Length[s] := 0; for x := 1 to N do if Sochet[x] = 0 then begin Put(x); Add(s,x); Length[x] := 1; end; while QH <> nil do begin u := Get; XV := XV + [u]; if (u > N) and (u <= 2 * N) then if Sochet[u] = 0 then begin Add(u,t); XV := XV + [t]; Length[t] := Length[u] + 1; end else begin x := Sochet[u]; if Length[t] = MaxInt then begin Put(x); Add(u,x); Length[x] := Length[u] + 1; end end else begin PV := Rec[u]; while PV <> nil do begin if PV^.B <= B then begin y := PV^.N; if Length[u] < Length[y] then begin if Length[y] = MaxInt then Put(y); Add(u,y); Length[y] := Length[u] + 1; end; end; PV := PV^.Next; end; end; end; end; procedure Phase; var St: PNode; procedure Push(u: Word); var PV: PNode; begin New(PV); PV^.Next := St; PV^.N := u; St := PV; end; function Pop: Word; var PV: PNode; begin Pop := St^.N; PV := St; St := PV^.Next; Dispose(PV); end; var New: array[1..Nmax*2 + 2] of Boolean; P: array[1..Nmax*2 + 2] of PNode; u, v, x, y: Word; b: Boolean; begin for u := 1 to t do if u in XV then begin New[u] := true; P[u] := XRec[u]; end; St := nil; Push(s); New[s] := false; while St <> nil do begin u := St^.N; if P[u] = nil then b := false else b := not New[P[u]^.N]; while b do begin P[u] := P[u]^.Next; if P[u] = nil then b := false else b := not New[P[u]^.N]; end; if P[u] <> nil then if P[u]^.N = t then while St^.N <> s do begin y := Pop; x := Pop; Sochet[x] := y; Sochet[y] := x; end else begin v := P[u]^.N; Push(v); New[v] := false; end else u := Pop; end; end; var Inp, Out: Text; x, v, M, I, J, K, P, Lo, Hi: Word; E: Integer; PV: PNode; L: String; R: array[1..Nmax * Nmax] of PNode; begin Assign(Inp, 'DETAILS.DAT'); Reset(Inp); Assign(Out, 'DETAILS.SOL'); Rewrite(Out); Readln(Inp, M); for K := 1 to M do begin Readln(Inp, N); S := 2 * N + 1; T := 2 * N + 2; for x := 1 to N do begin Rec[x] := nil; Readln(Inp, L); L := L + ','; for v := 1 to N do begin New(PV); PV^.Next := Rec[x]; Rec[x] := PV; PV^.N := v + N; R[(x - 1) * n + v] := PV; P := Pos(',',L); Val(Copy(L, 1, P - 1), PV^.W, E); Delete(L,1,P); end; end; for I := N * N - 1 downto 1 do for J := 1 to I do if R[J]^.W > R[J + 1]^.W then begin PV := R[J]; R[J] := R[J + 1]; R[J + 1] := PV; end; for J := 1 to N * N do R[J]^.B := J; { Opt := R[N * N]^.W;} Lo := N; Hi := N * N; while (Lo <> Hi) or (Lo <> B) do begin B := (Lo + Hi) div 2; for v:=1 to 2 * N do Sochet[v] := 0; for v:=1 to 2 * N + 2 do XRec[v] := nil; PGA; repeat Phase; for v:=1 to 2 * N + 2 do begin while XRec[v] <> nil do begin PV := XRec[v]; XRec[v] := PV^.Next; Dispose(PV); end; end; PGA; until not (t in XV); x := 1; while (x <= N) and (Sochet[x] <> 0) do Inc(x); if x > N then Hi := B else Lo := B + 1; end; for i := 1 to N do Write(Out, Sochet[i]-N, ' '); Writeln(Out); Writeln(Out, R[Hi]^.W); Writeln('Оброблено тест N ', K); end; Close(Out); Close(Inp); end.