ALgoritMa Prim Dan KruSkaL

program algo_prim;
{menyelesaikan permasalahan pohon merentang minimum dengan algoritma prim}

type
        sEdge = record
                iv,tv,we : integer;
        end;
        {iv : simpul asal
        tv : simpul terminal
        we : bobot sisi}

        list = array[0..100] of integer;
        tEdge = array[0..1000] of sEdge;

        tGraph = record
                nVer,nEd : integer;
                ve : list;
                ed : tEdge;
        end;
        {nVer : banyak simpul
        nEd : banyak sisi
        ve : himpunan simpul
        ed : himpunan sisi}

var
        graph : tGraph; {graf awal}
        mst : tGraph; {pohon merentang minimum = hasil}
        total : integer; {bobot pohon merentang minimum}

function member(x,n : integer; L:list) : boolean; {mengecek keberadaan elemen x dalam L}
var i : integer;
begin
        i := 1;
        while (x<>L[i]) and (i<n) do
                inc(i);
        member := (x = L[i]);
end;

procedure baca(var G : tGraph); {membaca masukkan graf}
var
        i,x,y,w : integer;
        fi : text;

begin
writeln('PETUNJUK :');
writeln('langkah 1 :masukkan 2 angka (artinya nilai kolom 1 & 2) pada baris 1,menyatakan bahwa banyaknya wilayah dan banyaknya jalur ');
writeln('langkah 2 :masukkan 3 angka(artinya nilai kolom 1, 2 & 3) pada baris ke 2,3,4...dst sesuai yg dibutuhkan,dimana kolom 1, 2 & 3 masing-masing adalah simpul awal, simpul tujuan dan besarnya bobot antar simpul' );

        readln(G.nVer,G.nEd);
        G.ed[0].we := 32760;

        for i:=1 to G.nEd do
        begin
                readln(x,y,w);
                G.ed[i].iv := x;
                G.ed[i].tv := y;
                G.ed[i].we := w;
                G.ve[i] := i;
        end;
end;

procedure span(G : tGraph; var T : tGraph);
{mendapatkan pohon merentang minimum T dari graf G}
var
        i, mEd : integer;
begin
        {initial}
        total := 0;
        T.ve[1] := G.ve[1];
        T.nVer := 1;

        while (T.nVer<G.nVer) do
        begin
                mEd := 0;

                for i:=1 to G.nEd do
                        if (member(G.ed[i].iv,T.nVer,T.ve) xor member(G.ed[i].tv,T.nVer,T.ve)) then
                                if (G.ed[i].we<G.ed[mEd].we) then
                                        mEd := i;
                T.ed[T.nVer] := G.ed[mEd];
                total := total + G.ed[mEd].we;

                inc(T.nVer);
                if member(G.ed[mEd].iv,T.nVer,T.ve)
                then
                T.ve[T.nVer] := G.ed[mEd].tv
                else
                    T.ve[T.nVer] := G.ed[mEd].iv;
        end;

        T.nEd := T.nVer -1;
end;

procedure tulis(G : tGraph); {menuliskan hasil pohon dan bobot yang diperoleh}
var i,j : integer;

begin
        writeln(total);
        for i:=1 to G.nEd do
                writeln(G.ed[i].iv,' ',G.ed[i].tv,' ',G.ed[i].we);
        writeln;
end;

begin
        baca(graph);
        span(graph,mst);
        tulis(mst);
        readln;
end.





program kruskal;
{menyelesaikan permasalahan pohon merentang minimum dengan algoritma kruskal}
type
sEdge = record
iv,tv,we : integer;
end;
{iv : simpul asal
tv : simpul terminal
we : bobot sisi}
list = array[0..100] of integer;
tEdge = array[0..1000] of sEdge;
tGraph = record
nVer,nEd : integer;
ve : list;
ed : tEdge;
end;
{nVer : banyak simpul
nEd : banyak sisi
ve : himpunan simpul
ed : himpunan sisi
}
var
graph : tGraph; {graf awal}
mst : tGraph; {pohon merentang minimum = hasil}
total : integer; {bobot pohon merentang minimum}

function member(x,n : integer; L:list) : boolean;
{mengecek keberadaan elemen x dalam L}
var i : integer;
begin
i := 1;
while (x<>L[i]) and (i<n) do
inc(i);
member := (x = L[i]) and (n<>0);
end;
procedure swap(var a,b: sEdge);
{menukar dua sisi}
var t : sEdge;
begin
t := a;
a := b;
b := t;
end;

procedure sort(var data: tEdge; i, j : integer);
{sorting sisi secara menaik dengan quicksort}
var k,l,p : integer;
begin
p := data[i].we;
k := i+1;
l := j;
while ((data[k].we<=p) and (k<j)) do
inc(k);
while ((data[l].we>p) and (l>i)) do
dec(l);
while (k<l) do begin
swap(data[k],data[l]);
while ((data[k].we<=p) and (k<j)) do
inc(k);
while ((data[l].we>p) and (l>i)) do
dec(l);
end;
swap(data[i],data[l]);
if (i<l) then sort(data,i,l-1);
if (l<j) then sort(data,l+1,j);
end;
procedure baca(var G : tGraph);
{membaca masukkan graf}
var
i,x,y,w : integer;
fi : text;
begin
readln(G.nVer,G.nEd);
G.ed[0].we := 32760;
for i:=1 to G.nEd do
begin
readln(x,y,w);
G.ed[i].iv := x;
G.ed[i].tv := y;
G.ed[i].we := w;
G.ve[i] := i;
end;
end;

procedure tulis(G : tGraph);
{menuliskan hasil pohon dan bobot yang diperoleh}
var i,j : integer;
begin
writeln(total);
for i:=1 to G.nEd do
writeln(G.ed[i].iv,' ',G.ed[i].tv,' ',G.ed[i].we);
writeln;
end;

procedure span(G : tGraph; var T : tGraph);
{mendapatkan pohon merentang minimum T dari graf G}
var
i,j : integer;
path: list;
nol : integer;
{tree disini tidak terhubung}
function cycle : boolean;
begin
cycle:= (member(G.ed[i].iv, T.nVer,T.ve) and member(G.ed[i].tv, T.nVer,T.ve));
{perlu dibuat pengecekan yang labih baik}
end;
begin
sort(G.ed,1,G.nEd);
{inisialisasi}
i := 1;
T.nEd := 1;
T.ed[1] := G.ed[1];
T.nVer := 2;
T.ve[1] := G.ed[1].iv;
T.ve[2] := G.ed[1].tv;
repeat
inc(i);
nol:= 0;
if not(cycle) then
begin
{menggabungkan pohon}
if not(member(G.ed[i].iv, T.nVer,T.ve)) then begin
inc(T.nVer);
T.ve[T.nVer] := G.ed[i].iv;
end;
if not(member(G.ed[i].tv, T.nVer,T.ve)) then begin
inc(T.nVer);
T.ve[T.nVer] := G.ed[i].tv;
end;
inc(T.nEd);
T.ed[T.nEd] := G.ed[i];
total := total + G.ed[i].we;
end;
until (T.nEd = G.nVer-1);
end;

begin
baca(graph);
span(graph,mst);
tulis(mst);
end.

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

0 komentar:

Poskan Komentar