Semua codingan pascal :: semester 2

binary_search_me.pas

Program binarysearch;
{ Uses crt; }
const
    nmin = 1;
    nmax = 100;

type
    arrint = array [nmin..nmax] of integer;

var
    x      : integer;
    tabint : arrint;
    n,i    : integer;
    indeks : integer;

function binarysearch(xx : integer): integer;
    var
        i : integer;
        atas, bawah, tengah : integer;
        ditemukan : boolean;
        indeksxx : integer;
begin
    atas  := 1;
    bawah := n;
    ditemukan:=false;
    indeksxx:=0;
    while ((atas <= bawah) and (not ditemukan)) do
    begin
        tengah:= (atas+bawah) div 2;
        if xx = tabint[tengah] then
            begin
                ditemukan:= true;
                indeksxx := tengah;
            end
        else
            begin
                if xx = tabint[tengah] then
                    bawah:= tengah - 1
                else
                    atas:= tengah + 1;
            end;
    end;
    binarysearch:=indeks;
end;

begin
    { clrscr; }
    write('input nilai n = '); readln(n);
    for i:= 1 to n do
    begin
        write('Tabint[',i,'] = '); readln(tabint[i]);
    end;
  
    write('Nilai yang dicari = '); readln(x);
    
    indeks:=binarysearch(x);
    if indeks <> 0 then
        write(x,' ditemukan pada indeks ke-',indeks)
    else
        write(x,' tidak ditemukan');
        readln;
end.

Bubble_Sort.pas

Program Bubble_Sort;
uses crt;
const
     max = 10;
type
    aarraayy = array[1..max] of integer;
var
    data:aarraayy;
      procedure bacadata(var data:aarraayy);
        begin
          data[1] := 18; data[2] := 14; data[3] := 20; data[4] := 13; data[5] := 11; 
		  data[6] := 19; data[7] := 12; data[8] := 17; data[9] := 10; data[10] := 15;
      end;
      procedure tampildata(data:aarraayy);
        var
          i:integer;
        begin
          for i := 1 to max do  begin
              write(data[i], ' ');
            end;   end;
      procedure apung(var data:aarraayy);
        var
          i,j,temp:integer;
        begin
          for i:=1 to max-1 do   begin
              for j:=max downto i+1 do    begin
                   if data[j] < data[j-1] then   begin
                       temp := data[j];
                       data[j] := data[j-1];
                       data[j-1] := temp;
                     end;  end;   end;   end;

{PROGRAM UTAMA}
begin
  clrscr;
  writeln('PENGURUTAN APUNG');
  writeln();
  writeln('DATA SEBELUM DIURUTKAN');
  bacadata(data);
  tampildata(data);
  writeln();
  apung(data);
  readln;
  writeln('DATA SESUDAH DIURUTKAN');
  tampildata(data);
  readln;
end.

bubble_sort2.pas

program bubble_sort2;
uses crt;
const nmax = 100;
var A : array[1..nmax] of integer;

 procedure baca (var A:array of integer; var n : integer);
  var
   i:integer;
  begin
   for i:=1 to n do
    begin
     write('Elemen ke ',i,' : ');readln(A[i]);
    end;
    readln;
  end;

 procedure cetak(A:array of integer; n:integer);
  var
    i:integer;
  begin
   for i:=1 to n do
     begin
       writeln('Data ke ',i,' : ',A[i]);
     end;
   end;

 procedure bubble(var A:array of integer; n: integer);
  var
   i,j,temp:integer;
  begin
   for i:=1 to n-1 do
     for j:=n downto i+1 do
       if A[j] < A[j-1] then
         begin
           temp:=A[j];
           A[j]:=A[j-1];
           A[j-1]:=temp;
         end;
  end;

{program utama}
var
  b:integer;
begin
  clrscr;
  write('Masukan banyak elemen : ');readln(b);
    baca(A,b);
    writeln();
    writeln('DATA SEBELUM DIURUTKAN');
    cetak(A,b);
    writeln();
    bubble(A,b);
    writeln('DATA SESUDAH DIURUTKAN');
    cetak(A,b);
  readln;
end.

bubble_sort3.pas

program bubble_sort3;
uses crt;

const
     max = 10;

type
    larik = array[1..max] of integer;

var
    data:larik;
    tahap, langkah:integer;
    ulang:char;

    procedure insert_data(var data:larik);

    begin
         data[1] := 24;
         data[2] := 41;
         data[3] := 73;
         data[4] := 88;
         data[5] := 89;
         data[6] := 64;
         data[7] := 41;
         data[8] := 18;
         data[9] := 64;
         data[10] := 73;
    end;

    procedure show_data(data:larik);

    var
         i:integer;

    begin
         for i := 1 to max do
         begin
              write(data[i], ' ');
         end;
    end;

    procedure ascending_bubble_sort(var data:larik; var tahap, langkah:integer);

    var
         i, j, temp:integer;

    begin
         tahap := 0;
         langkah := 0;
         for i := 1 to max - 1 do
         begin
              textcolor(14);gotoxy(37,12+tahap+langkah);writeln('TAHAP ',i);
              for j := max downto i + 1 do
              begin
                   if (data[j] < data[j - 1]) then
                   begin
                        temp := data[j];
                        data[j] := data[j - 1];
                        data[j - 1] := temp;
                   end;

                   inc(langkah);
                   writeln();
                   delay(300);
                   gotoxy(25,12+tahap+langkah);
                   textcolor(15);show_data(data);

              end;
              inc(tahap);writeln();
         end;
    end;

begin
     repeat
           textcolor(15);gotoxy(25,2);write('ASCENDING BUBBLE SORT');
           textcolor(14);gotoxy(25,3);write('~~~~~~~~~~~~~~~~~~~~~');
           textcolor(10);gotoxy(29,5);write('DATA SEBELUM DIURUTKAN');
           insert_data(data);
           textcolor(15);gotoxy(25,7);
           show_data(data);
           textcolor(10);gotoxy(29,10);write('PROSES PENGURUTAN DATA');
           textcolor(15);ascending_bubble_sort(data, tahap, langkah);
           textcolor(10);gotoxy(29,14+tahap+langkah);write('DATA SESUDAH DIURUTKAN');
           textcolor(15);gotoxy(25,16+tahap+langkah);show_data(data);
           textcolor(14);gotoxy(16,18+tahap+langkah);write('Pengurutan Terdiri Dari : ',tahap, ' Tahap & ',langkah,' Langkah');
           textcolor(14);gotoxy(22,20+tahap+langkah);write('Ulangi Proses Pengurutan [Y/T] : ');readln(ulang);
           clrscr();
     until (ulang = 'T') or (ulang = 't');
end.

Bubble_Sort4.pas

Program Bubble_Sort4;
uses crt;
const
     max = 10;
type
    aarraayy = array[1..max] of integer;
var
    data:aarraayy;

      procedure bacadata(var data:aarraayy; n:integer);
        var
          i:integer;
        begin
          for i:=1 to n do
            begin
              writeln('Masukan Data ke',i,' : ');readln(data[i]);
            end;
        end;

      procedure tampildata(data:aarraayy);
        var
          i:integer;
        begin
          for i := 1 to max do
            begin
              write(data[i], ' ');
            end;
        end;

      procedure apung(var data:aarraayy);
        var
          i,j,temp:integer;
        begin
          for i:=1 to max-1 do
            begin
              for j:=max downto i+1 do
                begin
                   if data[j] < data[j-1] then
                     begin
                       temp := data[j];
                       data[j] := data[j-1];
                       data[j-1] := temp;
                     end;

                end;
            end;
        end;

{PROGRAM UTAMA}
var
  a : integer;
begin
  clrscr;

  writeln('PENGURUTAN APUNG');
  writeln();
  writeln('Masukan banyak data ; ');readln(a);
  bacadata(data,a);
  writeln('DATA SEBELUM DIURUTKAN');
  tampildata(data);
  writeln();
  apung(data);
  readln;
  writeln('DATA SESUDAH DIURUTKAN');
  tampildata(data);
  readln;
end.