FWATER - Tưới nước đồng cỏ

Tác giả: ladpro98

Ngôn ngữ: Pascal

{$MODE OBJFPC}
program fwater;
uses    math;
type    edge=record
        x,y,w:longint;
        end;
const   fi='';
        maxn=303;
        maxm=10*maxn*maxn;
var     e:array[1..maxm] of edge;
        lab:array[1..maxn] of longint;
        res,n,m:longint;

procedure input;
var     inp:text;
        i,j,c:longint;
begin
        assign(inp,fi);reset(inp);
        readln(inp,n);
        for i:=1 to n do
        begin
                readln(inp,c);
                inc(m);
                e[m].x:=n+1;
                e[m].y:=i;
                e[m].w:=c;
        end;
        for i:=1 to n do
        begin
                for j:=1 to n do
                begin
                        read(inp,c);
                        if i=j then continue;
                        inc(m);
                        e[m].x:=i;
                        e[m].y:=j;
                        e[m].w:=c;
                end;
                readln(inp);
        end;
        close(inp);
end;

procedure sort(l,r:longint);
var     i,j:longint;
        p,t:edge;
begin
        if l>=r then exit;
        i:=l;j:=r;
        p:=e[random(r-l+1)+l];
        repeat
                while e[i].w<p.w do inc(i);
                while e[j].w>p.w do dec(j);
                if i<=j then
                begin
                        if i<j then
                        begin
                                t:=e[i];
                                e[i]:=e[j];
                                e[j]:=t;
                        end;
                        inc(i);
                        dec(J);
                end;
        until i>j;
        sort(l,j);sort(i,r);
end;

function root(u:longint):longint;
begin
        if lab[u]<=0 then exit(u);
        result:=root(lab[u]);
        lab[u]:=result;
end;

procedure union(p,q:longint);
begin
        if lab[p]<lab[q] then lab[q]:=p
        else
        begin
                if lab[p]=lab[q] then dec(lab[q]);
                lab[p]:=q;
        end;
end;

procedure process;
var     i,k,p,q:longint;
begin
        k:=0;
        sort(1,m);
        for i:=1 to m do
        begin
                p:=root(e[i].x);
                q:=root(e[i].y);
                if p<>q then
                begin
                        inc(k);
                        inc(res,e[i].w);
                        union(p,q);
                end;
                if k=n then exit;
        end;
end;

begin
        input;
        process;
        write(res);
end.

Download