REVAMP - Revamping Trails

Tác giả: khuc_tuan

Ngôn ngữ: Pascal

// {$APPTYPE CONSOLE}
 {$mode delphi}

type
    List = class
        v, l : integer;
        n : List;
    end;

procedure Add(var ds : List; v, l : integer);overload;
var
    p : List;
begin
    p := List.Create;
    p.v := v;
    p.l := l;
    p.n := ds;
    ds := p;
end;

var
    m, n, k : integer;
    ke : array[1..50000] of List;
    heap, id, d : array[1..1050020] of integer;
    nh : integer;

procedure pushup(i : integer);
var
    t, j : integer;
begin
    while i>=2 do
    begin
        j := i div 2;
        if d[heap[j]] > d[heap[i]] then
        begin
            t := heap[i]; heap[i] := heap[j]; heap[j] := t;
            id[heap[i]] := i;
            id[heap[j]] := j;
            i := j;
        end
        else break;
    end;
end;

procedure pushdown(i : integer);
var
    t, j : integer;
begin
    while i*2 <= nh do
    begin
        j := i * 2;
        if (j<nh) and (d[heap[j+1]] < d[heap[j]]) then inc(j);
        if d[heap[j]] < d[heap[i]] then
        begin
            t := heap[i]; heap[i] := heap[j]; heap[j] := t;
            id[heap[i]] := i;
            id[heap[j]] := j;
            i := j;
        end
        else break;
    end;
end;

function extractmin : integer;
begin
    extractmin := heap[1];
    id[heap[1]] := 0;
    dec(nh);
    if nh > 0 then
    begin
        heap[1] := heap[nh+1];
        id[heap[1]] := 1;
        pushdown(1);
    end;
end;

procedure add(i : integer);overload;
begin
    inc(nh);
    heap[nh] := i;
    id[i] := nh;
    pushup(nh);
end;

var
    l, i, su, sv : integer;
    res, u, uk, v, vk : integer;
    p : List;

begin
    read(n,m,k);
    for i:=1 to m do
    begin
        read(u,v,l);
        Add(ke[u], v, l);
        Add(ke[v], u, l);
    end;
    fillchar( d, sizeof(d), $1f);
    res := d[1];
    d[1 * 21 + 0] := 0;
    add( 1 * 21 + 0 );
    while nh > 0 do
    begin
        su := extractmin;
        u := su div 21;
        uk := su mod 21;
        p := ke[u];
        while p<>nil do
        begin
            // khong xoa
            v := p.v;
            vk := uk;
            sv := v * 21 + vk;
            if d[sv] > d[su] + p.l then
            begin
                d[sv] := d[su] + p.l;
                if id[sv]=0 then add(sv)
                else
                begin
                    l := id[sv];
                    pushup(l);
                    pushdown(l);
                end;
            end;

            // xoa
            vk := uk + 1;
            if vk <= k then
            begin
                sv := v * 21 + vk;
                if d[sv] > d[su] then
                begin
                    d[sv] := d[su];
                    if id[sv]=0 then add(sv)
                    else
                    begin
                        l := id[sv];
                        pushup(l);
                        pushdown(l);
                    end;
                end;
            end;

            p := p.n;
        end;
    end;
    for i:=0 to k do if res > d[n * 21 + i] then res := d[n * 21 + i];
    writeln(res);
end.

Download