Monday 29 October 2012

Koding Program Sorting Array dengan Urutan Ascending


Program Sorting Array dengan Urutan Ascending

program sorting;
uses crt;

const
     nmax = 50;
type
    rdata = record
         nim      : integer;
         nama     : string[30];
         alamat   : string[50];
         end;
    aData = array [1..nmax] of rdata;


var
{variabel global}
    data         : aData;
    plh, ch      : char;
    x            : integer;

{fungsi menu awal}
function menu : char;
var
   c : char;
begin
     clrscr;
     writeln('--- Program Sorting Array dengan Urutan Ascending ---');
     writeln;
     writeln('1: Insertion Sort');
     writeln('2: Selection Sort');
     writeln('3: Bubble Sort');
     writeln('4: Keluar Program');
     repeat
           writeln;
           write('Pilih >> ');
           c := readkey;
           writeln(c);
           if not (c in ['1'..'4']) then
              writeln('Pilihan salah ...');
     until(c in ['1'..'4']);
     menu := c;
end;

procedure inputData(var A : aData; var n : integer);
var
   i : integer;
begin
     repeat
           write('Berapa banyak data? ');
           readln(n);
           if n>0 then
           begin
                writeln;
                for i:=1 to n do
                begin
                     writeln('Mahasiswa ke-',i);
                     write('NIM    : '); readln(data[i].nim);
                     write('Nama   : '); readln(data[i].nama);
                     write('Alamat : '); readln(data[i].alamat);
                     writeln;
                end;
           end
           else
               writeln('Input salah...')
     until(n>0);
end;

{prosedur Insertion Sort}
procedure iS(var A : aData; var ndata : integer);
var
   temp,i,j : integer;
   temp2,temp3 : string[50];
begin
     clrscr;
     writeln('Input Data Insertion Sort');
     writeln;
     inputData(A,ndata);
     {rutin kode}
     for i:=2 to ndata do
     begin
          temp := A[i].nim;
          temp2 := A[i].nama;
          temp3 := A[i].alamat;

          j := i-1;
          while ((temp<A[j].nim) and (j>=1)) do
          begin
               A[j+1].nim := A[j].nim;
               A[j+1].nama := A[j].nama;
               A[j+1].alamat := A[j].alamat;
               j := j-1;
          end;
          A[j+1].nim := temp;
          A[j+1].nama := temp2;
          A[j+1].alamat := temp3;
     end;
end;

{prosedur untuk tukar data}
procedure tukar(i,j : integer);
var
   temp : integer;
   temp2 : string[50];
begin
     temp := data[i].nim;
     data[i].nim := data[j].nim;
     data[j].nim := temp;

     temp2 := data[i].nama;
     data[i].nama := data[j].nama;
     data[j].nama := temp2;

     temp2 := data[i].alamat;
     data[i].alamat := data[j].alamat;
     data[j].alamat := temp2;
end;

{prosedur Selection Sort}
procedure sS(var A : aData; var ndata : integer);
var
   i,j,pos : integer;
begin
     clrscr;
     writeln('Input Data Selection Sort');
     writeln;
     inputData(A,ndata);

     {rutin kode}
     for i:=1 to ndata-1 do
     begin
          pos := i;
          for j:=i+1 to ndata do
              if (A[pos].nim > A[j].nim) then
                 pos := j;
          if (pos<>i) then
             tukar(pos,i);
     end;
end;

{prosedur Bubble Sort}
procedure bS(var A : aData; var ndata : integer);
var
   i,j : integer;
begin
     clrscr;
     writeln('Input Data Bubble Sort');
     writeln;
     inputData(A,ndata);

     {rutin kode}
     for i:=1 to ndata-1 do
         for j:=ndata downto i+1 do
             if (A[j].nim < A[j-1].nim) then
                  tukar(j,(j-1));
end;

{prosedur tampil data yang terurut Ascending}
procedure showUrut(A : aData; var ndata : integer);
var
   i : integer;
begin
     clrscr;
     writeln('Tampilan Data Terurut');
     writeln;
     for i:=1 to ndata do
     begin
          writeln('NIM    : ',A[i].nim);
          writeln('Nama   : ',A[i].nama);
          writeln('Alamat : ',A[i].alamat);
          writeln;
     end;
end;

{program utama}
begin
     repeat
           plh := menu;
           case plh of
                '1' : iS(data,x);
                '2' : sS(data,x);
                '3' : bS(data,x);
                '4' : exit;
           end;

           writeln;
           writeln('Next >> Tampilan setelah data diurutkan...');
           write('Tekan sembarang karakter untuk berikutnya...') ;
           readkey;
           showUrut(data,x);
           repeat
                 writeln;
                 write('Tekan >> 1: Kembali ke Menu, 0: Keluar Program');
                 ch := readkey;
                 if not (ch in ['1','0']) then
                    writeln(' >> Pilihan salah...');
           until(ch in ['1','0']);
     until(ch = '0');
end.

No comments: