高中OJ3516. 【NOIP2013模拟11.6A组】摧毁巴士站

30分：
枚举要摧毁的车站，判断符不符合要求。
100分：
很显然，2^48会超时。

解决办法是有选择性的进行删点。基本的思路就是，一条长度不超过k的最短路径上的点，至少有一个是要被删掉的（至于删除哪个好，可以枚举尝试），删掉一个点后再重新求最短路，如果新求出的最短路径长度仍然不超过k，那么就在新的最短路径上再找出一个点删掉，然后再求最短路径……直到求出的最短路径长度超过k，那么就找到了一个解。但这个解未必是最优的，所以要用递归的方法搜索多组解，以确保能搜到最优解。具体步骤如下。
递归进行下列操作：
1. 寻找起点到终点的最短路径，如果最短路径长度超过k，则表示已找到一种删点方案。记录该方案下的删点数目，回溯再找出下一种方案；否则进入下一步。
2. 枚举最短路径中的除1号点和n号点外的某一个点，将其删除。
3. 回到1递归继续搜索。
这样的搜索顺序使得枚举的点的数量得到控制。搜索的每一层会从L-2个点中选择一个进行删除，L是当前找到的最短路径的长度。如果当前找到的最短路径很长，虽然在这一层我们需要枚举很多个点进行删除，但也说明起点到终点的距离已经很长了，我们离答案已经很接近了。一般来说，在50个点的图中，答案应该不超过20。那么L<20。并且L比较大的情况只会出现在搜索的最后几层。这么想来，这个搜索的时间复杂度是可以接受的。

---

所以我们可以每次进行一次最短路，每次删掉最短路上的一个点，然后继续回溯。
直到最短路的长度大于k，就记录答案。

代码

var
        a:array[1..4000,1..2] of longint;
        b:array[1..50] of longint;
        c:array[1..51] of longint;
        bz:array[1..50] of boolean;
        d:array[1..10000,1..2] of longint;
        f:array[1..50] of longint;
        bz2:array[1..50,1..50] of boolean;
        xl:array[1..50] of longint;
        n,m,s,i,j,ans,h,t,x,y,tot:longint;
function pd:longint;
var
        i,j,k,l:longint;
begin
        pd:=0;
        h:=0;
        t:=1;
        fillchar(f,sizeof(f),10);
        f[1]:=0;
        d[1,1]:=1;
        d[1,2]:=0;
        while h<t do
        begin
                inc(h);
                j:=d[h,1];
                for i:=c[j] to c[j+1]-1 do
                if (bz[a[i,2]]=false) and (f[j]+1<f[a[i,2]]) then
                begin
                        k:=a[i,2];
                        f[k]:=f[j]+1;
                        inc(t);
                        d[t,1]:=k;
                        d[t,2]:=h;
                        if k=n then
                        begin
                                pd:=f[k];
                                tot:=0;
                                l:=h;
                                while d[l,1]<>1 do
                                begin
                                        inc(tot);
                                        xl[tot]:=d[l,1];
                                        l:=d[l,2];
                                end;
                                exit;
                        end;
                end;
        end;
        pd:=maxlongint;
end;
procedure dg(t:longint);
var
        dl:array[1..50] of longint;
        i,j:longint;
begin
        if t-1>=ans then
        exit;
        if pd>s then
        begin
                if ans>t-1 then
                ans:=t-1;
                exit;
        end;
        dl:=xl;
        j:=tot;
        for i:=1 to j do
        if bz[dl[i]]=false then
        begin
                bz[dl[i]]:=true;
                dg(t+1);
                bz[dl[i]]:=false;
        end;
end;
begin
        assign(Input,'bus.in'); reset(Input);
        assign(Output,'bus.out'); rewrite(Output);
        readln(n,m,s);
        for i:=1 to m do
        begin
                readln(x,y);
                bz2[x,y]:=true;
        end;
        m:=0;
        for i:=1 to n do
                for j:=1 to n do
                if bz2[i,j] then
                begin
                        inc(m);
                        a[m,1]:=i;
                        a[m,2]:=j;
                        inc(b[i]);
                end;
        c[1]:=1;
        for i:=2 to n+1 do
        c[i]:=c[i-1]+b[i-1];
        ans:=maxlongint;
        dg(1);
        writeln(ans);
        close(Input); close(Output);
end.