Система уравнений (100 баллов)
Пусть k-ое уравнение системы из N уравнений имеет вид X+Y=bk, где X=x1k+x2k+…+xk-1 k; Y=xk k+1+…+xk N. Таким образом, левая часть каждого уравнения имеет (N-1)-но слагаемое и каждое неизвестное встречается ровно в двух уравнениях системы.
Задание
Напишите программу SYSTEM, которая по заданным b1,…,bN находит одно из решений системы, при условии что неизвестные xij могут принимать только значения 0 либо 1.
Входные данные
В первой строке входного файла SYSTEM.DAT находится натуральное число — количество тестовых блоков. Каждый тестовий блок начинается со строки, которая содержит число N (3N50) — количество уравнений в системе. Во второй строке блока находится N целых чисел bi (0bi50).
Выходные данные
Для каждого тестового блока в выходной файл SYSTEM.SOL должно быть записано одно из решений системи: (N-1)-на строка, каждая k-ая из которых содержит N-k чисел — найденных значений неизвестных:
x12 … x1N
x23 … x2N
x34 … x3N
…
xN-1 N
Если система не имеет решений для тестового блока, в выходной файл должна быть записана строка, которая содержит единственное число -1.
Пример входных и выходных данных
|
SYSTEM.DAT |
SYSTEM.SOL |
|
2 3 1 2 3 5 3 2 3 2 2 |
-1 1 1 1 0 0 0 1 1 1 0 |
{ Problem: SYSTEM}
const
MAX_N = 50;
FILE_IN = 'system.dat';
FILE_OUT = 'system.sol';
type
TArrElm = record
Vert : integer;
Power : integer;
end;
TArr = array[1..MAX_N] of TArrElm;
var
fin : Text;
fout : Text;
testNum : integer; {The number of test blocks}
currTest : integer;
n : integer;
b : array[1..MAX_N] of integer; {Input data}
x : array[1..MAX_N, 1..MAX_N] of boolean; {Graph matrix}
a : TArr; {Current}
Ans : boolean;
{ ******************************************************************************
Sorting
*****************************************************************************}
procedure SwapArrElm(var A : TArr; i, j : integer);
var c : TArrElm;
begin
c:=A[i]; A[i]:=A[j]; A[j]:=c;
end;
function CmpArrElm(var A : Tarr; i, j : integer) : boolean;
begin
if A[i].Power > A[j].Power
then CmpArrElm := false
else CmpArrElm := true;
end;
procedure Reorder(var A : TArr; i, j : integer);
var k : integer;
begin
if 2*i = j then
if not CmpArrElm(A, i, j) then SwapArrElm(A, i, j);
if 2*i < j then
begin
if CmpArrElm(A, 2*i, 2*i+1)
then k:=2*i
else k:=2*i+1;
if not CmpArrElm(A, i, k)then
begin
SwapArrElm(A, i, k);
Reorder(A, k, j);
end;
end;
end;
procedure Build(var A : TArr; i: integer);
var j : integer;
begin
for j:=i div 2 downto 1 do
Reorder(A, j, i);
end;
procedure Treesort(var A : TArr; i : integer);
var j : integer;
begin
Build(A, i);
for j:=i downto 2 {???} do
begin
SwapArrElm(A, 1, j);
Reorder(A, 1, j-1);
end;
end;
{ ******************************************************************************
Task
*****************************************************************************}
procedure ReadTestBlock;
var
i : integer;
begin
ReadLn(fin, n);
FillChar(A, sizeof(A), 0);
for i:=1 to n do
begin
Read(fin, b[i]);
A[i].Vert := i;
A[i].Power := b[i];
end;
FillChar(x, sizeof(x), false);
Ans := false;
end;
procedure Process;
var i,j : integer;
begin
Treesort(A, n);
for i:=1 to n-1 do
begin
for j:=2 to A[1].Power + 1 do
begin
if j>n then exit;
if A[j].Power = 0 then exit;
Dec(A[1].Power);
Dec(A[j].Power);
x[A[1].Vert, A[j].Vert]:=true;
x[A[j].Vert, A[1].Vert]:=true;
end;
Treesort(A, n);
end;
Ans:=true;
end;
procedure WriteAnswer;
var
i, j : integer;
begin
if Ans then
begin
for i:=1 to n do
for j:=i+1 to n do
if j = n then
if x[i,n] then
WriteLn(fout, '1')
else
WriteLn(fout, '0')
else
if x[i,j] then
Write(fout, '1 ')
else
Write(fout, '0 ');
end else
begin
WriteLn(fout, '-1');
end;
end;
begin
Assign(fin, FILE_IN);
Reset(fin);
Assign(fout, FILE_OUT);
Rewrite(fout);
Readln(fin, testNum);
for currTest := 1 to testNum do
begin
ReadTestBlock;
Process;
WriteAnswer;
end;
Close(fout);
Close(fin);
end.