Re: Make equations!!
> make differential equations
> and use Gauss-Jordan reduction. and then you can solve O(n^3)
Hi there!
I made nxn equation system and I solved it with Gauss reduction in O
(n^2) but I still got WA! I've used brute force to find the shortest
solution. Maybe there's better way to do this ? Here's my program :)
faithrespectdejan
program P1042 ;
const
maxN = 250 ;
type
TEquations = array [1 .. maxN + 1, 1 .. maxN + 1]
of Byte ;
TResult = set of 1 .. maxN ;
var
N : Integer ;
E : TEquations ;
Solved : Boolean ;
Res : TResult ;
minRes : Byte ;
procedure readInput ;
var
i, a : Integer ;
begin
{ Assign(Input, 'input.txt') ; Reset(Input) ;}
Read(N) ;
FillChar(E, SizeOf(E), 0) ;
for i := 1 to N do
begin
Read(a) ;
while a <> -1 do
begin
E [a, i] := 1 ;
Read(a) ;
end ;
E [i, N + 1] := 1 ; { result }
end ;
end ;
procedure SwapByte(var a, b : Byte) ;
var c : Byte ; begin c := a ; a := b ; b :=
c ; end ;
procedure SwapEquations(i, j : Byte) ;
var c : Byte ;
begin
for c := 1 to N + 1 do SwapByte(E [i, c], E [j, c]) ;
end ;
procedure FindCorrect(place : Byte) ;
var i : Byte ;
begin
if E [place, place] = 1 then EXIT ;
for i := place + 1 to N do
if E [i, place] = 1 then
begin
SwapEquations
(i, place) ;
EXIT ;
end ;
end ;
procedure AddEquation(a, b : Byte) ;
var i : Byte ;
begin
for i := a to N + 1 do
E [b, i] := E [b, i] xor E [a, i] ;
end ;
procedure FindRes(eq, count : Byte ; tmpRes : TResult) ;
var
i, sum : Byte ;
begin
if eq = 0 then
begin
Solved := TRUE ;
if count < minRes then begin minRes := count ; Res :=
tmpRes ; end ;
end
else
if count <= minRes then
begin
sum := 0 ;
for i := eq + 1 to N do
if i in tmpRes then sum := sum + E [eq, i] ;
sum := E [eq, N + 1] xor sum ;
if sum = 1 then
if E [eq, eq] = 1 then FindRes(eq - 1, count + 1,
tmpRes + [eq])
else EXIT
else
if E [eq, eq] = 1 then FindRes(eq - 1, count, tmpRes)
else
begin
FindRes(eq - 1, count + 1, tmpRes + [eq]) ;
FindRes(eq - 1, count, tmpRes) ;
end ;
end ;
end ;
procedure Solve ;
var
i, j : Byte ;
begin
for i := 1 to N do
begin
FindCorrect(i) ;
if E [i, i] = 0 then CONTINUE ;
for j := i + 1 to N do
if E [j, i] = 1 then
AddEquation(i, j) ;
end ;
Solved := FALSE ;
minRes := N + 1 ;
FindRes(N, 0, []) ;
end ;
procedure writeOutput ;
var
i : Integer ;
Start : Boolean ;
begin
if Solved then
begin
Start := FALSE ;
for i := 1 to N do
if i in Res then
if Start then Write(' ', i) else begin Start :=
TRUE ; Write(i) ; end ;
end
else Write('No solution') ;
end ;
begin
readInput ;
Solve ;
writeOutput ;
end.