p2293.pas

来自「高手写的所有acm例程 在acm.zju.edu.cn 上的题目的例程」· PAS 代码 · 共 105 行

PROGRAM p2293;

TYPE
        position=record
                x,y                     :Extended;
        end;

CONST
        max=1e15;
        small=1e-7;

VAR
        n,i                             :Integer;
        c,u                             :Extended;
        s,t                             :Integer;
        data                            :array[1..100]of Position;
        dis                             :array[1..100,1..100]of Extended;
        mincost                         :array[1..100]of Extended;

PROCEDURE Dij;
var
        find                            :Boolean;
        copy                            :Extended;
        i,j,k                           :Integer;
        m                               :Extended;
        du                              :array[1..100]of Extended;
        min                             :Extended;
begin
for i:=1 to n do mincost[i]:=max;
for i:=1 to n do
        if dis[i,t]<c+small then du[i]:=dis[i,t] else du[i]:=max;
du[t]:=-1;
find:=false;
if du[s]<max then
        begin
        copy:=du[s];
        find:=true;
        end;
if du[s]<max then
        begin
        writeln(du[s]:0:4);
        exit;
        end;
repeat
        min:=max;
        for i:=1 to n do
                if (du[i]<min)and(du[i]>0) then
                        begin
                        min:=du[i];
                        k:=i;
                        end;

        if min<max then
                begin
                mincost[k]:=du[k];
                for j:=1 to n do
                        if (j<>k) then
                                begin
                                if (dis[j,k]<c/2)and(du[j]>0) then
                                        begin
                                        m:=trunc((du[k]+dis[j,k]-c-0.000001)/(c-2*dis[j,k]))+1;
                                        if (du[k]+(2*m+1)*dis[j,k]<du[j])then
                                                du[j]:=du[k]+(2*m+1)*dis[j,k];
                                        end;
                                if (dis[j,k]<c)and(du[j]>0) then
                                        begin
                                        if (du[k]+dis[j,k]<c+small)and(du[k]+dis[j,k]<du[j]) then
                                                du[j]:=du[k]+dis[j,k];
                                        end;
                                end;
                du[k]:=-1;
                end else break;
until false;

if mincost[s]<max then writeln(mincost[s]:0:4)
        else writeln('unreachable');
end;


PROCEDURE Main;
var
        i,j                             :Integer;
begin
for i:=1 to n do
        for j:=1 to n do
        begin
        dis[i,j]:=sqrt(sqr(data[i].x-data[j].x)+sqr(data[i].y-data[j].y)) * u;
        end;
Dij;
end;

BEGIN
//assign(input,'p.in');
//reset(input);
readln(c,u);
while (c<>0.00)or(u<>0.00) do
        begin
        readln(n,s,t);
        inc(s);inc(t);
        for i:=1 to n do readln(data[i].x,data[i].y);
        Main;
        readln(c,u);
        end;
END.