NOIP 2009 最优贸易

2013-09-22 11:23

//By BLADEVIL 
var
    n, m                :longint;
    mark                :array[0..100100] of longint;
    pre, other          :array[0..1000100] of longint;
    last                :array[0..100100] of longint;
    l,l2                :longint;
    que                 :array[0..100100] of longint;
    flag                :array[0..100100] of boolean;
    d, d2               :array[0..100100] of longint;
    ans                 :longint;
    pre2, other2        :array[0..1000100] of longint;
    last2               :array[0..100100] of longint;

function max(a,b:longint):longint;
begin
    if a>b then max:=a else max:=b;
end;

function min(a,b:longint):longint;
begin
    if a>b then min:=b else min:=a;
end;

procedure connect(x,y:longint);
begin
    inc(l);
    pre[l]:=last[x];
    last[x]:=l;
    other[l]:=y;
end;

procedure connect2(x,y:longint);
begin
    inc(l2);
    pre2[l2]:=last2[x];
    last2[x]:=l2;
    other2[l2]:=y;
end;

procedure init;
var
    i                   :longint;
    x, y, z             :longint;

begin
    read(n,m); l:=1; l2:=1;
    for i:=1 to n do read(mark[i]);
    for i:=1 to m do
    begin
        read(x,y,z);
        connect(x,y);
        connect2(y,x);
        if z=2 then
        begin
            connect(y,x);
            connect2(x,y)
        end;
    end;
end;

procedure bfs;
var
    q, p, cur           :longint;
    h, t                :longint;
    i                   :longint;
begin
    filldword(d,sizeof(d) div 4, maxlongint div 10);

    h:=0; t:=1;

    que[1]:=1; flag[1]:=true;
    d[1]:=mark[1];
    while h<>t do
    begin
        h:=h mod 10000+1;
        cur:=que[h];
        q:=last[cur];

        while q<>0 do
        begin
            p:=other[q];
            if (d[cur]<d[p]) or (not flag[p]) then
            begin
                d[p]:=min(d[p],d[cur]);
                d[p]:=min(d[p],mark[p]);
                if not flag[p] then
                begin
                    t:=t mod 10000+1;
                    que[t]:=p;
                    flag[p]:=true;
                end;
            end;
            q:=pre[q];
        end;

    end;
end;

procedure bfs2;
var
    q, p, cur           :longint;
    h, t                :longint;
    i                   :longint;
begin
    fillchar(flag,sizeof(flag),false);

    for i:=1 to n do d2[i]:=-maxlongint div 10;

    h:=0; t:=1;
    d2[n]:=mark[n];
    que[1]:=n; flag[n]:=true;
    while h<>t do
    begin
        h:=h mod 10000+1;
        cur:=que[h];
        q:=last2[cur];
        while q<>0 do
        begin
            p:=other2[q];
            if (d2[cur]>d2[p]) or (not flag[p]) then
            begin
                d2[p]:=max(d2[p],d2[cur]);
                d2[p]:=max(d2[p],mark[p]);
                if not flag[p] then
                begin
                    t:=t mod 10000+1;
                    que[t]:=p;
                    flag[p]:=true;
                end;
            end;
            q:=pre2[q];
        end;
    end;
    for i:=1 to n do ans:=max(ans,d2[i]-d[i]);
    writeln(ans);
end;


begin
    init;
    bfs;
    bfs2;
end.