Minggu, 15 Februari 2009

MergeSort 2 : Pascal

program MergeSort;
uses crt;
type arr = array [1..100] of integer;

var
ArrMain,ArrUrut : arr;
n,m : integer;

procedure merge(Left:arr; pjgL:integer; Right : arr; pjgR:integer; var ArrMerge : arr);
{IS : Menerima array left dan array right untuk dibandingkan dan disusun kembali ke array merge}
{FS : Hasil penggabungan akan dikembalikan melalui variabel output ArrMerge}
var
i,j,k,m,panjang: integer;
hasil : arr;
begin
i:=1;
j:=1;
k:=1;
panjang:=pjgL+pjgR;
{membandingkan 2 array Left dan Right hingga panjang salah satu array mencapai 0 }
while ((pjgL>0) and (pjgR>0)) do
begin
{jika elemen pertama array Left lebih kecil dari elemen array Right
maka elemen pertama pada array hasil diisi oleh elemen pertama array Left}
if(Left[i]<= Right[j]) then
begin
hasil[k]:=Left[i];
i:=i+1;
k:=k+1;
pjgL:=pjgL-1;
end
{jika elemen pertama array Left lebih besar dari elemen array Right
maka elemen pertama pada array hasil diisi oleh elemen pertama array Right}
else
begin
hasil[k]:=Right[j];
j:=j+1;
k:=k+1;
pjgR:=pjgR-1;
end;
end;
{Jika array Left belum kosong dan array Right sudah kosong,
maka sisa dari Left dimasukkan ke array Hasil}
while (pjgL>0) do
begin
hasil[k]:=Left[i];
i:=i+1;
k:=k+1;
pjgL:=pjgL-1;
end;
{Jika array Left belum kosong dan array Right sudah kosong,
maka sisa dari Left dimasukkan ke array Hasil}
while (pjgR>0) do
begin
hasil[k]:=Right[j];
j:=j+1;
k:=k+1;
pjgR:=pjgR-1;
end;
{Mengembalikan nilai ke variabel output ArrMerge}
ArrMerge:=hasil;
for m:= 1 to panjang do
writeln('Array Merge ke-',m,' : ',hasil[m]);
end;

procedure mergesort(pjg:integer;A : arr;var ArrHasil : arr);
{IS : Menerima Array yang akan dibagi menjadi 2 array yaitu array Left dan array Right}
{FS : Mengembalikan array yg terurut melalui variabel output ArrHasil}
var
middle,i,pjgLeft,pjgRight : integer;
ArrLeft,ArrRight : arr;
begin
if pjg <= 1 then
ArrHasil := A
else
begin
middle := pjg div 2;
for i:=1 to middle do
ArrLeft[i]:=A[i];

for i:=(middle+1) to pjg do
ArrRight[i-middle]:=A[i];
pjgLeft := pjg div 2;
pjgRight := (pjg+1) div 2;
for m:= 1 to pjgLeft do
writeln('Array Left ke-',m,' : ',ArrLeft[m]);
for m:= 1 to pjgRight do
writeln('Array Right ke-',m,' : ',ArrRight[m]);
{rekursif procedure mergesort dengan output akan disimpan di ArrLeft}
mergesort(pjgLeft,ArrLeft,ArrLeft);
{rekursif procedure mergesort dengan output akan disimpan di ArrRight}
mergesort(pjgRight,ArrRight,ArrRight);
{memanggil procedure merge untuk menyatukan ArrLeft dan ArrRight
dan mengembalikan 1 array terurut melalui ArrHasil}
merge(ArrLeft,pjgLeft,ArrRight,pjgRight,ArrHasil);
end;
end;

begin
clrscr;
write('Jumlah array : ');readln(n);
for m := 1 to n do
begin
write('Array ke-',m,' : ');
readln(ArrMain[m]);
end;
writeln;
writeln('LANGKAH MERGE SORT');
writeln('-------------------');
mergesort(n,ArrMain,ArrUrut);
writeln;
writeln('HASIL ARRAY TERURUT');
writeln('---------------------');
for m:= 1 to n do
writeln('Array Urut ke-',m,' : ',ArrUrut[m]);

readln;
end.

2 komentar:

  1. Komentar ini telah dihapus oleh pengarang.

    BalasHapus
  2. sist tolong dong mergesortnya yang tipe datanya array of record
    minimal fieldnya 3 atau 4 deh
    saya lagi belajar itu, error terus

    thanks :)

    BalasHapus