图论的实际应用之二 最小树型图 (300分)

现在基本原理我已经看懂了
但是程序自己还写不出来
看来只能去看看书上的程序了

這兩天到書城找了一些數據結構的書，沒有找到這方面的東西。太專業了。
昨天我思考了一下對這個問題是否可以這樣
為了保證村村有水，所以對每一個點都得有入邊。
我們先對每一個點找其最小的入邊（最小的出邊暫時沒有意義）
這樣可以得到幾個相互之間沒有連通的子圖，在子圖內部則已經是互通且是造價最小的。
如果這幾個圖都是有水圖（即這個圖有入水點），那就應該沒什麼問題了；如果它們中間存在無水圖，那現在我們的任務是求幾個子圖之間的最小聯路之和。使其有水。
這個最小聯路的定義應該是：A圖的a點與B圖的b點之間的距離減去目的點原來的入邊的值的最小值。
如：a與b1之間聯上後有v(a,b1),再減去原來在B圖中b1的入邊bk,b1
即min(v(a,b1)-v(bk,b1))
現在有一個問題就是假如A圖是沒有水的圖，而B圖是有水圖，而剛好bk點是入水點，那麼這時B圖也沒水了。
也就是說，最小聯路不能保證使無水圖都有水，而且有可能產生新的無水圖

to lichdr:
你的观点已经非常类似用顶点收缩的算法来求了。能自己总结出来也属不易，呵呵。

lichdr的算法中，在把每个圈都收缩成一个顶点，其他点到这个顶点的距离像lichdr所说这样求，构成一个新的图，把新的图再执行一次算法，直到图中没有圈为止，还原图，就求出了最小树形图。这就是顶点收缩算法

我是不见实现不散分的.

這幾天比較忙，寫程序得費點時間。
等一等

“我”回來了。初步的代碼，過兩天帖上來。
用程序實現比較的麻煩，思路還得重新理一理

前兩天寫了一下，不過今天發現了一些問題
在形成新的環的過程中，我用一個 bv來放它的原始點，就是說連向這個新點時，可以知道連向的是它的原來的哪一個點。但現在有一個問題，當環套環時，開大環時碰到了小環，這時必須把那原來的一條邊還原，看來得重組數據結構。
我的程序比較的冗長，還是先把它貼出來再說
{$APPTYPE CONSOLE}
program mingraphi;
const max=100;
type inset=record
bv:integer;//原始点
v:integer;
s:real;
end;

type vertex=record
grano:integer;
//所属图号。0表示已通水，等于自身时表示是一个孤点
lindex:integer;
//所用的边,开始时总是用最小边（即为1）
inner:array[1..max] of inset;
//?入边的集合
end;

var
a:array[0..max,1..max] of real;
stkv:array[1..max] of integer;
i,j,k,n,m,count,ocount:integer;
point:array [1..max] of vertex;
t:inset;
cost:real;
procedure merge(seg1,seg2:array of inset;var tot:array of inset);
//合并
var
si,sj,tk:integer;
fs1,fs2:real;
begin
fs1 := seg1[1].s;
fs2 := seg2[1].s;
si := 2;
sj := 2;
tk := 1;
while (seg1[si].s >= 0) and (seg2[sj].s >= 0)do
begin
if ((seg1[si].s - fs1) <= (seg2[sj].s - fs2)) then
begin
tot[tk] := seg1[si];
tot[tk].s := tot[tk].s - fs1;
si := si + 1;
end
else
begin
tot[tk] := seg2[sj];
tot[tk].s := tot[tk].s - fs2;
sj := sj + 1;
end;
tk := tk + 1;
end;
if seg1[si].s <> 0 then
while si <= maxdo
begin
tot[tk] := seg1[si];
tot[tk].s := tot[tk].s - fs1;
si := si + 1;
tk := tk + 1;
end
else
while sj <= maxdo
begin
tot[tk] := seg2[sj];
tot[tk].s := tot[tk].s - fs2;
sj := sj + 1;
tk := tk + 1;
end;
end;

procedure setcolor(graphno,ograno:integer);
var ki:integer;
begin
for ki := 1 to maxdo
if point[ki].grano = ograno then
point[ki].grano := graphno;
end;

procedure newpoint(pp,stkk,loopoint:integer);
//成环后，新增点
var
tin0,tin1:array[1..max] of inset;
ai,ki,f:integer;
begin
ki := stkk;
for ai := 1 to maxdo
tin0[ai] := point[stkv[ki]].inner[ai];
ki := ki -1;
f := 1;
while stkv[ki] <> loopointdo
begin
if f = 1 then
merge(tin0,point[stkv[ki]].inner,tin1)
else
merge(tin1,point[stkv[ki]].inner,tin0);
f := (f + 1) mod 2;
ki := ki - 1;
end;
if f = 1 then
merge(tin0,point[stkv[ki]].inner,tin1)
else
merge(tin1,point[stkv[ki]].inner,tin0);
f := (f + 1) mod 2;
point[pp].grano := pp;
point[pp].lindex := 1;
if f = 0 then
point[pp].inner := tin0
else
point[pp].inner := tin1;　//這個地方居編譯通不過，
　　　　　　　　　　　　　　　　　　　說是不兼容的類型，不知為何
ki := ki - 1;
point[stkv[ki]].inner[point[stkv[ki]].lindex].v := pp;
end;

begin
read;
for i:=0 to ndo
for j:=1 to ndo
read(a[i,j]);
for i:=1 to ndo
//对每个点的入边排序?
begin
k := 0;
point.grano := i;
point.lindex := 1;
for j:=0 to ndo
begin
if a[j,i] <> 0 then
begin
k := k + 1;
point.inner[k].v := j;
point.inner[k].bv := i;
point.inner[k].s := a[j,i];
m := k;
while (m > 1) and (point.inner[m-1].s > point.inner[m].s)do
begin
t := point.inner[m];
point.inner[m] := point.inner[m-1];
point.inner[m-1] := t;
m := m-1;
end;
end;
end;
for m := k + 1 to maxdo
point.inner[m].s := -1;
end;

count := n;
ocount := 0;
while count <> ocountdo
//没有产生新的圈为止
begin
m := count;
for i := ocount + 1 to mdo
begin
if point.grano <> i then
continue;
j := i;
k := 1;
while (j <> 0) and (point[j].grano = j)do
begin
point[j].grano := count + 1;
if point[j].inner[1].bv <> j then
point[point[j].inner[1].bv].lindex
:= point[point[j].inner[1].bv].lindex + 1;
stkv[k] := j;
k := k + 1;
j := point[j].inner[point[j].lindex].v;
end;
if j = 0 then
setcolor(0,point[stkv[k-1]].grano);
//碰到了入水点
if point[stkv[k-1]].grano <> point[j].grano then
//碰上了处理过的点
setcolor(point[j].grano,point[stkv[k-1]].grano)
else

begin
newpoint(count+1,k-1,j);
count := count + 1;
end;
end;
ocount := m;
end;

cost := 0;
for i := 1 to ndo
begin
write(point.inner[point.lindex].v,i);
cost := cost + point.inner[point.lindex].s;
end;
write(cost);
end.

你通不过的地方，可能是要先把所有的入度初始化为零