Programul care determina arborele
partial de cost minim al unui gaf
program Arbore_partial_de_cost_minim;
type lista=record
x,y,z:integer;
end;
var a,b:array[1..100,1..100] of boolean; {matricile de adiacenta}
v:array[1..1000] of lista; {lista de costuri si legaturi}
u:array[1..100] of boolean;
j,i,n,nrv,nrleg:integer;
f,g:text;
(**********************)
procedure citire_date;
var x,y,z:integer;
begin
assign(f,'arbore.in'); reset(f);
readln(f,n);
nrv:=0; {numarul de legaturi este initial 0}
fillchar(a,sizeof(a),false); {se initializeaza matricile a si b cu false pe toate pozitiile}
fillchar(b,sizeof(b),false);
while not eof(f) do begin
readln(f,x,y,z);
{x si y sunt doua noduri iar z este costul legaturii dintre ele}
inc(nrv);
v[nrv].x:=x;
v[nrv].y:=y;
v[nrv].z:=z;
{se adauga in lista urmatoarea legatura citita din fisier}
end;
close(f);
end;
(**********************)
procedure sortare; {se sorteaza crescator, dupa cost, lista de legaturi}
var f:boolean;
i:integer;
aux:lista;
begin
repeat
f:=true;
for i:=1 to nrv-1 do begin
if v[i].z>v[i+1].z then begin
aux:=v[i];
v[i]:=v[i+1];
v[i+1]:=aux;
f:=false;
end;
end;
until f=true;
end;
(**********************)
function aciclic:boolean; {functia are valoarea true daca nu exista ciclu in graf}
var f:boolean;
i:integer;
procedure back(x:integer);
var i:integer;
begin
if u[x] then f:=false else begin
u[x]:=true;
for i:=1 to n do
if a[x,i] then begin
a[x,i]:=false;
a[i,x]:=false;
back(i);
end;
end;
end;
begin
fillchar(u,sizeof(u),false);
f:=true;
for i:=1 to n do
if not(u[i]) then back(i);
aciclic:=f;
end;
(**********************)
procedure prog;
var j:integer;
begin
nrleg:=0; {numarul de legaturi este initial 0}
j:=0; {contorul listei de legaturi este initial 0}
repeat
inc(j); {se trece la urmatoarea legatura din lista}
b[v[j].x,v[j].y]:=true; {se introduce noua legatura in graf}
b[v[j].y,v[j].x]:=true;
a:=b; {se copie matricea b in
a pentru a se verifica existenta ciclurilor}
{este necesara aceasta
operatie deoarece matricea b va fi distrusa daca se va verifica}
{pe ea existenta
ciclurilor}
if aciclic=true then inc(nrleg)
{daca nu exista cicluri atunci creste cu 1 numarul de legaturi din graf}
else begin {altfel se scoate legatura j din graf}
b[v[j].x,v[j].y]:=false;
b[v[j].y,v[j].x]:=false;
end;
until nrleg=n-1; {se repeta aceste operatii pana cand numarul de legaturi din graf este n-1}
{aceasta este conditia pentru
ca graful b sa fie arbore}
end;
(**********************)
Begin
citire_date;
sortare;
prog;
assign(g,'arbore.out'); rewrite(g);
for i:=1 to n do
for j:=i to n do begin
if b[i,j]=true then
writeln(g,i,' ',j);
end;
close(g);
End.