SCOLLECT - Trò chơi nhặt quà

Tác giả: khuc_tuan

Ngôn ngữ: Pascal

//{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q+,R+,S+,T-,U-,V+,W-,X+,Y+,Z1}
// {$APPTYPE CONSOLE}
 {$mode delphi}

uses
    Math;

type
    Edge = class;
    List = class
        e : Edge;
        n : List;
    end;
    Node = class
        trace : Edge;
        id, fx : integer;
        ke : List;
        ken : List;
        constructor init(id, fx : integer);
    end;
    Edge = class
        u, v : Node;
        flow, cost, cap: integer;
        constructor init(u, v : Node; cost, cap : integer);
    end;

procedure AddList(var l : List; e : Edge);
var
    p : List;
begin
    p := List.Create;
    p.e := e;
    p.n := l;
    l := p;
end;

constructor Node.init(id, fx : integer);
begin
    self.id := id;
    self.fx := fx;
end;

constructor Edge.init(u, v : Node; cost, cap : integer);
begin
    self.u := u;
    self.v := v;
    self.cost := cost;
    self.cap := cap;
    self.flow := 0;
    AddList(u.ke, self);
    AddList(v.ken, self);
end;

var
    kk, i, j, nlist, nodecount, m, n : integer;
    a : array[1..150,0..300] of char;
    source, dest : array[1..150,1..150] of Node;
    start, finish : Node;
    // vs : array[1..50000] of boolean;
    EdgeList : array[1..100000] of Edge;
    res : integer;
    dist : array[0..50000] of integer;

{
function calccost(e : Edge) : integer;
begin
    calccost := e.u.fx + e.cost - e.v.fx;
end;

function dfs(u : Node) : boolean;
var
    p : List;
begin
    if u.id = finish.id then begin dfs := true; exit; end;
    if vs[u.id] then begin dfs := false; exit; end;
    vs[u.id] := true;
    
    p := u.ke;
    while p<>nil do
    begin
        if (calccost(p.e)=0) and (p.e.flow < p.e.cap) then
        begin
            if dfs(p.e.v) then
            begin
                inc(p.e.flow);
                res := res + p.e.cost;
                dfs := true;
                exit; 
            end;
        end; 
        p := p.n;
    end;

    p := u.ken;
    while p<>nil do
    begin
        if (calccost(p.e)=0) and (p.e.flow > 0) then
        begin
            if dfs(p.e.u) then
            begin
                dec(p.e.flow);
                res := res - p.e.cost;
                dfs := true;
                exit;
           end;
        end;
        p := p.n;
    end;
    dfs := false;
end;

procedure suanhan;
var
    dmin, i, j : integer;
    e : Edge;
begin
    dmin := 1000000000;
    for i:=1 to nlist do
    begin
        e := edgelist[i];
        if vs[e.u.id] and (not vs[e.v.id]) and (e.flow < e.cap) then
            dmin := min(dmin,calccost(e));
        if vs[e.v.id] and (not vs[e.u.id]) and (e.flow > 0) then
            dmin := min(dmin,-calccost(e));
    end;

    for i:=1 to m do
        for j:=1 to n do
        begin
            if not vs[source[i,j].id] then inc(source[i,j].fx, dmin);
            if not vs[dest[i,j].id] then inc(dest[i,j].fx, dmin);
        end;

end;
}

const
    MAXQ = 1000000;
var
    Q : array[0..MAXQ] of Node;
    lq, rq : integer;

procedure add(n : Node);
begin
    inc(rq);
    if rq > MAXQ then rq := 1;
    Q[rq] := n;
end;

function pop : Node;
begin
    pop := Q[lq];
    if lq = rq then
    begin
        lq := 1;
        rq := 0;
    end
    else
    begin
        inc(lq);
        if lq > MAXQ then lq := 1;
    end;
end;
    
procedure findbest;
var
    u, v : Node;
    p : List;
begin
    lq := 1; rq := 0;
    add(start);
    fillchar( dist, sizeof(dist), $1f);
    dist[start.id] := 0;
    while rq <> 0 do
    begin
        u := pop;
        p := u.ke;
        while p<>nil do begin
            if (p.e.flow < p.e.cap) and (dist[p.e.v.id] > dist[u.id] + p.e.cost) then
            begin
                dist[p.e.v.id] := dist[u.id] + p.e.cost;
                p.e.v.trace := p.e;
                add(p.e.v);
            end;
            p := p.n;
        end;

        p := u.ken;
        while p<>nil do begin
            if (p.e.flow > 0) and (dist[p.e.u.id] > dist[u.id] - p.e.cost) then
            begin
                dist[p.e.u.id] := dist[u.id] - p.e.cost;
                p.e.u.trace := p.e;
                add(p.e.u);
            end;
            p := p.n;
        end;
    end;
    v := finish;
    if dist[v.id] = dist[0] then exit;
    while v<>start do
    begin
        if v=v.trace.v then
        begin
            inc(v.trace.flow);
            inc(res, v.trace.cost);
            v := v.trace.u;
        end
        else
        begin
            dec(v.trace.flow);
            dec(res,v.trace.cost);
            v := v.trace.v;            
        end;
    end;
end;

    
begin
    readln(n, m);
    for i:=1 to m do
    begin
        readln(a[i]);
        move( a[i][0], a[i][1], 150); 
    end;
    nlist := 0;
    nodecount := 0;
    for i:=1 to m do
        for j:=1 to n do
        begin
            inc(nodecount);
            source[i,j] := Node.init(nodecount,1000000 - nodecount);
            inc(nodecount);
            dest[i,j] := Node.init(nodecount,1000000 - nodecount);
            if a[i,j]='*' then begin inc(nlist); EdgeList[nlist] := Edge.init(source[i,j], dest[i,j], -1, 1); end;
            if (a[i,j]='*') or (a[i,j]='.') then begin inc(nlist); EdgeList[nlist] := Edge.init(source[i,j], dest[i,j], 0, 10); end;
        end;
    for i:=1 to m do
        for j:=1 to n do
        begin
            if i<m then begin inc(nlist); EdgeList[nlist] := Edge.init(dest[i,j], source[i+1,j], 0, 10); end;
            if j<n then begin inc(nlist); EdgeList[nlist] := Edge.init(dest[i,j], source[i,j+1], 0, 10); end;
        end;

    start := source[1,1];
    finish := dest[m,n];

    for kk:=1 to 2 do findbest();

    {
    for kk:=1 to 2 do
    begin
        fillchar( vs, sizeof(vs), false);
        while(not dfs(start)) do
        begin
            suanhan;
            fillchar( vs, sizeof(vs), false);
        end;
    end;
    }
    writeln(-res);
end.

Download