QBROBOT - VOI07 Robot cứu hỏa
Tác giả: RR
Ngôn ngữ: Pascal
{$R+,Q+}
uses math;
const
FINP='';
FOUT='';
MAXN=501;
oo=5000001;
type
list=^node;
node=record
u:longint;
next:list;
end;
var
f1,f2:text;
first,last,spt,hsize,n:longint;
ke:array[1..MAXN] of list;
c,t:array[1..MAXN,1..MAXN] of longint;
queue,inq,hpos,h,a,d1,dn,e:array[1..MAXN] of longint;
procedure openF;
begin
assign(f1,FINP); reset(f1);
assign(f2,FOUT); rewrite(f2);
end;
procedure closeF;
begin
close(f1); close(f2);
end;
procedure add(u:longint; var a:list);
var
p:list;
begin
new(p); p^.u:=u;
p^.next:=a; a:=p;
end;
procedure inp;
var
i,m,u,v:longint;
begin
read(f1,n);
for i:=1 to n do read(f1,a[i]);
read(f1,m);
for i:=1 to m do
begin
read(f1,u,v,t[u,v],c[u,v]);
t[v,u]:=t[u,v]; c[v,u]:=c[u,v];
add(u,ke[v]);
add(v,ke[u]);
end;
end;
procedure swap(var a,b:longint);
var
temp:longint;
begin
temp:=a; a:=b; b:=temp;
end;
procedure down1(i:longint);
var
j:longint;
begin
j:=i<<1;
while (j<=hsize) do
begin
if (j<hsize) and (d1[h[j+1]]<d1[h[j]]) then inc(j);
if (d1[h[j]]<d1[h[i]]) then
begin
swap(hpos[h[i]],hpos[h[j]]);
swap(h[i],h[j]);
end;
i:=j; j:=i<<1;
end;
end;
procedure up1(i:longint);
var
j:longint;
begin
j:=i>>1;
while (i>1) and (d1[h[i]]<d1[h[j]]) do
begin
swap(hpos[h[i]],hpos[h[j]]);
swap(h[i],h[j]);
i:=j; j:=i>>1;
end;
end;
procedure push1(u:longint);
begin
inc(hsize); h[hsize]:=u; hpos[u]:=hsize;
up1(hsize);
end;
procedure pop1(var u:longint);
begin
u:=h[1]; hpos[u]:=0;
swap(h[1],h[hsize]);
hpos[h[1]]:=1;
dec(hsize);
down1(1);
end;
procedure left;
var
u,v:longint;
p:list;
begin
for u:=2 to n do d1[u]:=oo;
d1[1]:=0; hsize:=0; push1(1);
while hsize>0 do
begin
pop1(u);
p:=ke[u];
while p<>nil do
begin
v:=p^.u; p:=p^.next;
if d1[v]>d1[u]+t[u,v] then
begin
d1[v]:=d1[u]+t[u,v];
if hpos[v]=0 then push1(v)
else up1(hpos[v]);
end;
end;
end;
end;
procedure down2(i:longint);
var
j:longint;
begin
j:=i<<1;
while (j<=hsize) do
begin
if (j<hsize) and (dn[h[j+1]]<dn[h[j]]) then inc(j);
if (dn[h[j]]<dn[h[i]]) then
begin
swap(hpos[h[i]],hpos[h[j]]);
swap(h[i],h[j]);
end;
i:=j; j:=i<<1;
end;
end;
procedure up2(i:longint);
var
j:longint;
begin
j:=i>>1;
while (i>1) and (dn[h[i]]<dn[h[j]]) do
begin
swap(hpos[h[i]],hpos[h[j]]);
swap(h[i],h[j]);
i:=j; j:=i>>1;
end;
end;
procedure push2(u:longint);
begin
inc(hsize); h[hsize]:=u; hpos[u]:=hsize;
up2(hsize);
end;
procedure pop2(var u:longint);
begin
u:=h[1]; hpos[u]:=0;
swap(h[1],h[hsize]);
hpos[h[1]]:=1;
dec(hsize); down2(1);
end;
procedure right;
var
v,u:longint;
p:list;
begin
fillchar(hpos,sizeof(hpos),0);
for u:=1 to n-1 do dn[u]:=oo;
dn[n]:=0;
hsize:=0; push2(n);
while hsize>0 do
begin
pop2(u);
p:=ke[u];
while p<>nil do
begin
v:=p^.u; p:=p^.next;
if dn[v]>dn[u]+t[u,v] then
begin
dn[v]:=dn[u]+t[u,v];
if hpos[v]=0 then push2(v)
else up2(hpos[v]);
end;
end;
end;
end;
function check(w:longint):boolean;
var
u,v,x:longint;
p:list;
begin
fillchar(inq,sizeof(inq),0);
for u:=1 to n do e[u]:=-1;
first:=1; last:=1; spt:=1; queue[1]:=1; e[1]:=w; inq[1]:=1;
while spt>0 do
begin
u:=queue[first]; inc(first); if first=MAXN then first:=1; dec(spt);
inq[u]:=0;
p:=ke[u];
while p<>nil do
begin
v:=p^.u; p:=p^.next;
if d1[u]+t[u,v]+dn[v]>d1[n] then continue;
if e[u]<c[u,v] then continue;
if a[v]=0 then x:=e[u]-c[u,v] else x:=w;
if x>e[v] then
begin
e[v]:=x;
if inq[v]=0 then
begin inc(last); if last=MAXN then last:=1; queue[last]:=v; inc(spt); end;
inq[v]:=1;
end;
end;
end;
check:=e[n]>=0;
end;
procedure solve;
var
u,l,r,mid:longint;
begin
l:=0; r:=oo;
repeat
mid:=(l+r)>>1;
if check(mid) then r:=mid else l:=mid;
until r-l<=1;
if check(l) then writeln(f2,l)
else writeln(f2,r);
end;
begin
openF;
inp;
left;
right;
solve;
closeF;
end.