### 10426 - Knights' Nightmare

Posted:

**Mon Jan 13, 2003 8:33 pm**I can find a test where my program gets WA. Please, help me!!

[pascal]Program p10426;

Const MaxN = 16;

MaxR = 1000;

Type InfType = Array[1..MaxN,1..MaxN]of Byte;

Var R,C,i,j : Integer;

K : Array[1..4,1..2] of Integer;

Inf : Array[1..4,0..1]of InfType;

Mr,Mc : Integer;

test : Integer;

S : String;

Procedure FillK(ID : Integer);

Var x,y,p,t : Integer;

order : Array[1..MaxR,1..2] of Integer;

b,bc,e,ec : Integer;

procedure check(dx,dy : integer);

var yy : integer;

begin

if (x+dx<1)or(x+dx>R) then exit;

if (y+dy<1)or(y+dy>C) then exit;

if inf[id][0][x+dx,y+dy]<=p then exit;

inf[id][0][x+dx,y+dy]:=p;

if not((x+dx=Mr) and (y+dy=Mc)) then begin

if e + ec > MaxR then yy := e + ec - MaxR else yy := e + ec;

order[yy,1]:=x+dx;

order[yy,2]:=y+dy;

ec := ec + 1;

end;

end;

procedure check2(dx,dy : integer);

var yy : integer;

begin

if (x+dx<1)or(x+dx>R) then exit;

if (y+dy<1)or(y+dy>C) then exit;

if inf[id][0][x+dx,y+dy]<=p then exit;

inf[id][0][x+dx,y+dy]:=p;

if e + ec > MaxR then yy := e + ec - MaxR else yy := e + ec;

order[yy,1]:=x+dx;

order[yy,2]:=y+dy;

ec := ec + 1;

end;

begin

(* fill without monster *)

fillchar(inf[id][0], sizeof(inf[id][0]), 255);

inf[id][0][k[ID,1], k[ID,2]] := 0;

order[1,1] := k[ID,1];

order[1,2] := k[ID,2];

b := 1; bc := 1;

e := 2; ec := 0;

p := 0;

while bc > 0 do begin

p := p + 1;

for t := 1 to bc do begin

x := order[b,1];

y := order[b,2];

check(-2,-1);

check(-2,1);

check(-1,-2);

check(-1,2);

check(1,-2);

check(1,2);

check(2,-1);

check(2,1);

b := b + 1;

if b = MaxR + 1 then b := 1;

end;

bc := ec;

b := e;

e := e + ec;

if e > MaxR then e := e - MaxR;

ec := 0;

end;

(* fill with monsters *)

inf[id][1] := inf[id][0];

order[1,1] := Mr;

order[1,2] := Mc;

b := 1; bc := 1;

e := 2; ec := 0;

p := inf[id][0][Mr,Mc];

if p = 255 then exit;

while bc > 0 do begin

p := p + 1;

for t := 1 to bc do begin

x := order[b,1];

y := order[b,2];

check2(-2,-1);

check2(-2,1);

check2(-1,-2);

check2(-1,2);

check2(1,-2);

check2(1,2);

check2(2,-1);

check2(2,1);

b := b + 1;

if b = MaxR + 1 then b := 1;

end;

bc := ec;

b := e;

e := e + ec;

if e > MaxR then e := e - MaxR;

ec := 0;

end;

end;

function getit(x,y,id : integer) : integer;

var r,i : integer;

begin

r:=0;

for i:=1 to 4 do if i <> id then begin

if inf

[pascal]Program p10426;

Const MaxN = 16;

MaxR = 1000;

Type InfType = Array[1..MaxN,1..MaxN]of Byte;

Var R,C,i,j : Integer;

K : Array[1..4,1..2] of Integer;

Inf : Array[1..4,0..1]of InfType;

Mr,Mc : Integer;

test : Integer;

S : String;

Procedure FillK(ID : Integer);

Var x,y,p,t : Integer;

order : Array[1..MaxR,1..2] of Integer;

b,bc,e,ec : Integer;

procedure check(dx,dy : integer);

var yy : integer;

begin

if (x+dx<1)or(x+dx>R) then exit;

if (y+dy<1)or(y+dy>C) then exit;

if inf[id][0][x+dx,y+dy]<=p then exit;

inf[id][0][x+dx,y+dy]:=p;

if not((x+dx=Mr) and (y+dy=Mc)) then begin

if e + ec > MaxR then yy := e + ec - MaxR else yy := e + ec;

order[yy,1]:=x+dx;

order[yy,2]:=y+dy;

ec := ec + 1;

end;

end;

procedure check2(dx,dy : integer);

var yy : integer;

begin

if (x+dx<1)or(x+dx>R) then exit;

if (y+dy<1)or(y+dy>C) then exit;

if inf[id][0][x+dx,y+dy]<=p then exit;

inf[id][0][x+dx,y+dy]:=p;

if e + ec > MaxR then yy := e + ec - MaxR else yy := e + ec;

order[yy,1]:=x+dx;

order[yy,2]:=y+dy;

ec := ec + 1;

end;

begin

(* fill without monster *)

fillchar(inf[id][0], sizeof(inf[id][0]), 255);

inf[id][0][k[ID,1], k[ID,2]] := 0;

order[1,1] := k[ID,1];

order[1,2] := k[ID,2];

b := 1; bc := 1;

e := 2; ec := 0;

p := 0;

while bc > 0 do begin

p := p + 1;

for t := 1 to bc do begin

x := order[b,1];

y := order[b,2];

check(-2,-1);

check(-2,1);

check(-1,-2);

check(-1,2);

check(1,-2);

check(1,2);

check(2,-1);

check(2,1);

b := b + 1;

if b = MaxR + 1 then b := 1;

end;

bc := ec;

b := e;

e := e + ec;

if e > MaxR then e := e - MaxR;

ec := 0;

end;

(* fill with monsters *)

inf[id][1] := inf[id][0];

order[1,1] := Mr;

order[1,2] := Mc;

b := 1; bc := 1;

e := 2; ec := 0;

p := inf[id][0][Mr,Mc];

if p = 255 then exit;

while bc > 0 do begin

p := p + 1;

for t := 1 to bc do begin

x := order[b,1];

y := order[b,2];

check2(-2,-1);

check2(-2,1);

check2(-1,-2);

check2(-1,2);

check2(1,-2);

check2(1,2);

check2(2,-1);

check2(2,1);

b := b + 1;

if b = MaxR + 1 then b := 1;

end;

bc := ec;

b := e;

e := e + ec;

if e > MaxR then e := e - MaxR;

ec := 0;

end;

end;

function getit(x,y,id : integer) : integer;

var r,i : integer;

begin

r:=0;

for i:=1 to 4 do if i <> id then begin

if inf

*[0][x,y]=255 then begin getit:=-1; exit; end else*

r:=r+infr:=r+inf

*[0][x,y];*

end;

if inf[id][1][x,y]=255 then begin getit:=-1; exit; end;

r:=r+inf[id][1][x,y];

getit:=r;

end;

function getitxy(x,y : integer) : integer;

var i,r,b : integer;

begin

r:=10000;

for i:=1 to 4 do begin

b:=getit(x,y,i);

if (b<>-1) and (b<r) then r:=b;

end;

if r<>10000 then getitxy:=r else getitxy:=-1;

end;

procedure getans;

var i,j : integer;

b,rr : integer;

begin

b:=10000;

for i:=1 to R do

for j:=1 to C do

if not((i=Mr)and(j=Mc)) then begin

rr:=getitxy(i,j);

if (rr<>-1) and (rr<b) then b:=rr;

end;

if b=10000 then Writeln('Meeting is impossible.') else

Writeln('Minimum time required is ',b,' minutes.');

end;

begin

test:=0;

While Not Eof do begin

Readln(S);

test:=test+1;

Writeln('Set#',test);

Readln(R,C);

for i := 1 to 4 do for j := 1 to 2 do Read(K[i,j]);

Readln;

Readln(Mr,Mc);

for i := 1 to 4 do FillK(i);

getans;

end;

end.[/pascal]end;

if inf[id][1][x,y]=255 then begin getit:=-1; exit; end;

r:=r+inf[id][1][x,y];

getit:=r;

end;

function getitxy(x,y : integer) : integer;

var i,r,b : integer;

begin

r:=10000;

for i:=1 to 4 do begin

b:=getit(x,y,i);

if (b<>-1) and (b<r) then r:=b;

end;

if r<>10000 then getitxy:=r else getitxy:=-1;

end;

procedure getans;

var i,j : integer;

b,rr : integer;

begin

b:=10000;

for i:=1 to R do

for j:=1 to C do

if not((i=Mr)and(j=Mc)) then begin

rr:=getitxy(i,j);

if (rr<>-1) and (rr<b) then b:=rr;

end;

if b=10000 then Writeln('Meeting is impossible.') else

Writeln('Minimum time required is ',b,' minutes.');

end;

begin

test:=0;

While Not Eof do begin

Readln(S);

test:=test+1;

Writeln('Set#',test);

Readln(R,C);

for i := 1 to 4 do for j := 1 to 2 do Read(K[i,j]);

Readln;

Readln(Mr,Mc);

for i := 1 to 4 do FillK(i);

getans;

end;

end.[/pascal]