次短路（非严格）

最新推荐文章于 2025-02-21 19:47:32 发布

原创最新推荐文章于 2025-02-21 19:47:32 发布 · 741 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#次短路 #Pascal

图论专栏收录该内容

3 篇文章

订阅专栏

这篇博客探讨了在图中寻找次短路的方法，特别是在最短路唯一的情况下。内容涉及如何通过SPFA算法先找出最短路径，然后通过删除边的方式重新计算以找到次短路。这是一个涉及图论和算法的问题。

这里的次短路是指最短路只有一条情况下的次短路，如果有两条及两条以上的最短路时则输出最短路题目

求次短路的思路就是首先求出最短路后，记录最短路的路径，枚举删变（注意数组模拟链表要删双向边）后再次SPFA，求出即可。

program pro;
var
        i,j,n,m,num,tot:longint;
        min,cmin:real;
        flag:boolean;
        point:array[0..205]of record x,y:longint; end;
        link:array[0..45000]of record ke,po,ne,br:longint; pr:real; bj:boolean; end;
        pre:array[0..250]of record num,po:longint; end;
        que:array[0..10000]of longint;
        st:array[0..250]of longint;
        dis:array[0..250]of real;
        team:array[0..250]of boolean;

function fd(x,y:longint):real;
begin
        exit(sqrt(sqr(point[x].x-point[y].x)+sqr(point[x].y-point[y].y)));
end;

procedure make(x,y:longint; z:real; br:longint);
begin
        inc(tot);
        link[tot].ne:=st[x];
        st[x]:=tot;
        link[tot].po:=y;
        link[tot].ke:=x;
        link[tot].pr:=z;
        link[tot].br:=br;
end;

procedure init;
var
        ii,u,v:longint;
        c:real;
begin
        readln(n,m);
        for ii:=1 to n do readln(point[ii].x,point[ii].y);
        for ii:=1 to m do
        begin
                readln(u,v);
                c:=fd(u,v);
                make(u,v,c,1);
                make(v,u,c,-1);
        end;
end;

procedure spfa(x:longint);
var
        h,t,ke,po:longint;
        temp:longint;
begin
        fillchar(que,sizeof(que),0);
        fillchar(dis,sizeof(dis),$5f);
        fillchar(team,sizeof(team),false);

        dis[x]:=0; team[x]:=true; que[1]:=x; h:=0; t:=1;
        while h<=t do
        begin
                inc(h);
                ke:=que[h]; team[ke]:=false;
                temp:=st[ke];
                while temp<>0 do
                begin
                        po:=link[temp].po;
                        if (not link[temp].bj)and(dis[po]>dis[ke]+link[temp].pr) then
                        begin
                                dis[po]:=dis[ke]+link[temp].pr;
                                if not flag then
                                begin
                                        pre[po].po:=ke;
                                        pre[po].num:=temp;

                                end;
                                if (not team[po]) then
                                begin
                                        inc(t);
                                        que[t]:=po; team[po]:=true;

                                end;
                        end;
                        temp:=link[temp].ne;
                end;

        end;
        flag:=true;
end;

procedure main;
var
        po:longint;
begin
        flag:=false;
        fillchar(pre,sizeof(pre),0);
        spfa(1);
        min:=dis[n]; cmin:=maxlongint;
        po:=n;
        while po<>1 do
        begin
              num:=pre[po].num;
              link[num].bj:=true;
              link[num+link[num].br].bj:=true;
              spfa(1);
              if dis[n]=min then
              begin
                        writeln(dis[n]:0:2);
                        closef;
                        halt;
              end;
              if (dis[n]>min)and(dis[n]<cmin) then cmin:=dis[n];
              link[num].bj:=false;
              link[num+link[num].br].bj:=false;
              po:=pre[po].po;
        end;
        writeln(cmin:0:2);
end;

begin
        init;
        main;
end.