拓扑序列的最小字典序列

查错

考场上又写挂的一道签到题。。。

我们发现这题要求得到一个最小字典序列

显然找到所有序列然后排序是不可取的，

那么我们不能使用平常的拓扑排序方法，怎么搞使得在每次处理拓扑顺序的时候来维护呢？

用小根堆维护入度为0的点即可，输入的时候统计入度

{$inline on}
const maxn=100010;

type node=record
       pos,next:longint;
end;

var heap,getin,head,ans:array[0..maxn] of longint;
    edge:array[0..maxn*2] of node;
    n,m,cnt,top:longint;
    check:boolean;

procedure add(u,v:longint); inline;
begin
    inc(cnt);
    edge[cnt].pos:=v;
    edge[cnt].next:=head[u];
    head[u]:=cnt;
end;

procedure swap(var a,b:longint); inline;
begin
    a:=a xor b;
    b:=a xor b;
    a:=a xor b;
end;

procedure up(i:longint); inline;
var j:longint;
begin
    j:=i>>1;
    while j>0 do
    begin
        if heap[i]then
            begin
                swap(heap[i],heap[j]);
                i:=j;
                j:=j>>1;
            end
        else break;
    end;
end;

procedure down(i:longint); inline;
var j:longint;
begin
    j:=i<<1;
    while j<=top do
        begin
            if (jand (heap[j]>heap[j+1]) then inc(j);
            if heap[i]>heap[j] then
                begin
                    swap(heap[i],heap[j]);
                    i:=j;
                    j:=j<<1;
                end
            else break;
        end;
end;

procedure init;
var i,x,y:longint;
begin
    read(n,m);
    for i:=1 to m do
        begin
            read(x,y);
            add(x,y);
            inc(getin[y]);
        end;
    for i:=1 to n do
        if getin[i]=0 then
            begin
                inc(top);
                heap[top]:=i;
            end;
    check:=true;
end;

procedure main;
var i,j,x,y:longint;
begin
    for j:=1 to n do
        begin
            if (top=0) then
                begin
                    check:=false;
                    break;
                end;
            x:=heap[1];
            ans[j]:=x;
            swap(heap[1],heap[top]);
            dec(top);
            down(1);
            i:=head[x];
            while i<>0 do
                begin
                    y:=edge[i].pos;
                    dec(getin[y]);
                    if getin[y]=0 then
                        begin
                            inc(top);
                            heap[top]:=y;
                            up(top);
                        end;
                    i:=edge[i].next;
                end;
        end;
end;

procedure print;
var i:longint;
begin
    if not check then writeln('OMG.')
    else 
        begin
            for i:=1 to n-1 do
            write(ans[i],' ');
            writeln(ans[n]);
        end;
end;

begin
    init;
    main;
    print;
end.

View Code

 

转载于:https://www.cnblogs.com/logichandsome/p/4068359.html