PWRFAIL - Mất điện

Tác giả: ladpro98

Ngôn ngữ: Pascal

{$MODE OBJFPC}
program pwrfail;
uses    math;
type    e=record
        x,y:int64;
        end;
        e2=record
        v:longint;
        w:extended;
        end;
const   maxn=1010;
        fi='';
var     a:array[1..maxn] of e;
        pos,h,len:array[1..maxn] of longint;
        d:array[1..maxn] of extended;
        cn:array[1..maxn,1..maxn] of boolean;
        c:array[1..maxn,1..maxn] of e2;
        n,w,nh:longint;
        m:extended;

procedure input;
var     inp:text;
        i,x,y,j:longint;
        temp:extended;
begin
        assign(inp,fi);
        reset(inp);
        readln(inp,n,w);
        readln(inp,m);
        for i:=1 to n do
        readln(inp,a[i].x,a[i].y);
        for i:=1 to w do
        begin
                readln(inp,x,y);
                cn[x,y]:=true;
                cn[y,x]:=true;
        end;
        for i:=1 to n do
        begin
                len[i]:=0;
                for j:=1 to n do
                if j<>i then
                begin
                        if cn[i,j] then
                        begin
                                inc(len[i]);
                                c[i,len[i]].v:=j;
                                c[i,len[i]].w:=0;
                                continue;
                        end;
                        temp:=sqrt(sqr(a[i].x-a[j].x)+sqr(a[i].y-a[j].y));
                        if temp<=M then
                        begin
                                inc(len[i]);
                                c[i,len[i]].v:=j;
                                c[i,len[i]].w:=temp;
                        end;
                end;
        end;

        close(inp);
end;

procedure update(v:longint);
var     p,c:longint;
begin
        c:=pos[v];
        if c=0 then
        begin
                inc(nh);
                c:=nh;
        end;
        repeat
                p:=c shr 1;
                if (p=0) or (d[h[p]]<=d[v]) then break;
                h[c]:=h[p];
                pos[h[c]]:=c;
                c:=p;
        until false;
        h[c]:=v;
        pos[v]:=c;
end;

function extract:longint;
var     p,c,v:longint;
begin
        result:=h[1];
        v:=h[nh];
        dec(nh);
        p:=1;
        repeat
                c:=p shl 1;
                if (c<nh) and (d[h[c+1]]<d[h[c]]) then inc(c);
                if (c>nh) or (d[h[c]]>=d[v]) then break;
                h[p]:=h[c];
                pos[h[p]]:=p;
                p:=c;
        until false;
        h[p]:=v;
        pos[v]:=p;
end;

procedure dijkstra;
var     i,u:longint;
begin
        for i:=1 to n do d[i]:=123456789;
        d[1]:=0;
        update(1);
        repeat
                u:=extract;
                if u=n then exit;
                for i:=1 to len[u] do
                begin
                        if d[c[u,i].v]>d[u]+c[u,i].w then
                        begin
                                d[c[u,i].v]:=d[u]+c[u,i].w;
                                update(c[u,i].v);
                        end;
                end;
        until nh=0;
end;

begin
        input;
        dijkstra;
        if d[n]=123456789 then
        write(-1)
        else
        write(trunc(1000*d[n]));
end.

Download