Program TLSort (4 type Sorting and The Time[Effectivity])

program TLSort;

Uses Dos,crt;

Const maks   = 20000; {dpt ditambahkan selama tidak out of memory}

Type  indeks = 1..maks;{Indeks Data}

	  Data   = array[indeks] of integer;



var Banyak, i : integer;

    A,B       : Data; {Data A=data Awal, Data B:Data Setelah Pengurutan}

    jam1,mnt1,dtk1,mdtk1 : word; {waktu awal pengurutan}

    jam2,mnt2,dtk2,mdtk2 : word; {waktu akhir pengurutan}



Procedure Identitas; {Prosedur identitas program ini}

begin

   GotoXy(20,5); Writeln('Muchamad Dachlan Zaim (M0507028)');

   GotoXy(20,6); Writeln('   Program Uthek2 Pointer v.1   ');

   GotoXy(20,7); Writeln('      Tanggal 20 Maret 2008     ');  

end;



Procedure BuatData(var X:Data; n:integer);

begin    {Prosedur untuk membuat data secara random}

   randomize;

   for i := 1 to n do X[i] := random(10000);

end;



Procedure CetakData(X:data);

begin  {Prosedur untuk mencetak data bilangan}

   for i := 1 to Banyak do writeln(i:10,'  ',A[i]); 

end;



Procedure ulang(X:data;var Y:data; n:integer);

begin {prosedur untuk memindahkan data yang belum diurut(X) dengan yang sudah urut(Y)}

  for i:=1 to n do Y[i]:=X[i];

end;



procedure bubbleSort(X:Data; var Y:data; n:integer);

var swap     : boolean; {Prosedur pengurutan dengan bubble sort}

    i, titip : integer;

begin

  repeat

    swap := false; 

    for i:=1 to n-1 do 

       begin

       if (X[i]>X[i+1]) then 

          begin

          titip  := X[i];   {Pengecekan satu per satu bilangan sebelum dan sesudah}

          X[i]   := X[i+1]; {jika bil sebelum>bil sesudah, maka bil tersebut ditukar}

          X[i+1] := titip;  {penempatannya}

          swap   := true;

          end

       end;

  until not(swap);

  Ulang(X,Y,n);

end;



procedure selectionSort(X:Data; var Y:data; n: integer);

var i, j, min, titip: integer;

begin

  for i:=1 to n-1 do 

    begin

    min := i;

    for j:=i to n do 

       begin

       if (X[j]       end;

    titip  := X[i];   {}

    X[i]   := X[min]; {}

    X[min] := titip;  {}

    end;

  Ulang(X,Y,n);

end;



procedure insertionSort(X:Data; var Y:data; n:integer);

var i, j, nilai: integer; wis:boolean;

begin

  for i:=2 to n do 

    begin

    nilai := X[i];

    j     := i-1;

    wis   := false;

    while not(wis) do

	    begin

	      if j<= 1 then wis := true

	      else if nilai>=a[j-1] then wis := true

	      else begin

	           a[j] := a[j-1];

	           j    := j-1

               end

	    end;

    a[j] := nilai;

    end;

  ulang(X,Y,n);

end;







Procedure MergeSort(X:Data; var Y:data; n:integer);

  procedure merge(var X:Data; p,q,r: integer);

  var i,j,k: integer;

      Y: Data;

  begin

    i := p;   k := p;   j := q+1;

    while ((i<=q) and (j<=r)) do 

       begin

       if ( X[i] <= X[j] ) then 

            begin

            Y[k] := X[i];

            i    := i+1;

            end

       else begin

            Y[k] := X[j];

            j    := j+1

            end;

       k := k+1;

       end;

    while ( i <= q ) do 

       begin

       Y[k] := X[i];

       k    := k+1; 

       i    := i+1;

       end;

    while (j<=r) do 

       begin

       Y[k] := X[j];

       k    := k+1; 

       j    := j+1;

       end;  

    for i:=p to r do X[i]:=Y[i];  

  end; 



  procedure merge2(var X:Data; p,r:integer);

  var q: integer;

  begin

     if (p        begin

        q:=(p+r)div 2;

        merge2(X, p, q);

        merge2(X, q+1, r);

        merge (X, p, q, r);

        end;

  end;

begin

  Merge2(A,1,Banyak);

  ulang(X,Y,n);

end;





Function L0(w: word):string ;

var s : string ;

begin

  Str(w:0,s);

  if w<10 then s:='0' + s;

  L0 := s ;

end ;



Procedure CetakWaktu(jamB,jamA,mntB,mntA,dtkB,dtkA,mdtkB,mdtkA:word);

var jamC,mntC,dtkC,mdtkC:word;

begin

  jamC:=0; mntC:=0; dtkC:=0; mdtkC:=0;

  writeln(L0(jamA),' : ',L0(mntA),' : ',L0(dtkA),' : ',L0(mdtkA));

  writeln(L0(jamB),' : ',L0(mntB),' : ',L0(dtkB),' : ',L0(mdtkB));

  if(mdtkB-mdtkA)<0 then begin mdtkC:=mdtkB+100-mdtkA; dtkB:=dtkB-1;end

    else mdtkC:=mdtkB-mdtkA;

  if(dtkB-dtkA)<0   then begin dtkC:=dtkB+60-dtkA;    mntB:=mntB-1;end

    else dtkC:=dtkB-dtkA; 

  if(mntB-mntA)<0   then begin mntC:=mntB+60-mntA;    jamB:=jamB-1;end

    else mntC:=mntB-mntA;

  jamC:=jamB-jamA;  

  WriteLn(L0(jamC),' : ',L0(mntC),' : ',L0(dtkC),' : ',L0(mdtkC));  

end;



Procedure Menu;

begin

  clrscr;

  identitas;

  write('Masukkan Banyak Bilangan yang Akan dirandom: ' ); read(Banyak);

  BuatData(A,Banyak);

  CetakData(A);  

  readln;

  getTime(jam1,mnt1,dtk1,mdtk1); BubbleSort(A,B,Banyak);  getTime(jam2,mnt2,dtk2,mdtk2);

  Writeln('Waktu Bubble'); 

  CetakWaktu(jam2,jam1,mnt2,mnt1,dtk2,dtk1,mdtk2,mdtk1);

  readln;

  getTime(jam1,mnt1,dtk1,mdtk1); InsertionSort(A,B,Banyak);  getTime(jam2,mnt2,dtk2,mdtk2);

  Writeln('Waktu Insertion'); 

  CetakWaktu(jam2,jam1,mnt2,mnt1,dtk2,dtk1,mdtk2,mdtk1);

  readln;

  getTime(jam1,mnt1,dtk1,mdtk1); SelectionSort(A,B,Banyak);  getTime(jam2,mnt2,dtk2,mdtk2);

  Writeln('Waktu Selection'); 

  CetakWaktu(jam2,jam1,mnt2,mnt1,dtk2,dtk1,mdtk2,mdtk1);

  readln;

  getTime(jam1,mnt1,dtk1,mdtk1); MergeSort(A,B,Banyak);  getTime(jam2,mnt2,dtk2,mdtk2);

  Writeln('Waktu Merge'); 

  CetakWaktu(jam2,jam1,mnt2,mnt1,dtk2,dtk1,mdtk2,mdtk1);

  readln;

  Write('Mau lihat hasil Datanya?? '); readln;

  

  CetakData(A);

  readln;

end;



begin

  Menu; 

end.