PASCAL - CONTOH PROGRAM MENGGUNAKAN TREE

Listing Program:

Program PohonBiner;
Uses crt;
Type Btree = ^simpul;
    Simpul = record
    Isi : char;
    kiri,kanan : Btree;
    end;
var elemen : char;
    p, root, baru : Btree;
Procedure sisip(var root,baru : btree);
Begin
    baru^.kiri := nil;
    baru^.kanan := nil;
   if root = nil then
    root := baru
   else
     begin
      p := root;
      while p <> nil do
      begin
    if baru^.isi < p^.isi then
     begin
      if p^.kiri <> nil  then
        p := p^.kiri
      else
        begin
        p^.kiri := baru;
        p := nil;
        end;
         end
    else
     begin
    if p^.kanan <> nil then
           p := p^.kanan
        else
         begin
       p^.kanan := baru;
           p :=  nil
     end;
     end;
    end;
  end;
end;
Procedure inorder (root : btree);
begin
    if root <> nil then
    begin
        inorder (root^.kiri);
        write (root^.isi :4);
        inorder (root^.kanan);
    end;
end;
Procedure preorder (root : btree);
begin
    if root <> nil then
    begin
        write (root^.isi :4);
        preorder (root^.kiri);
        preorder (root^.kanan);
    end;
end;

procedure postorder (root : btree);
begin
  if root <> nil then
   begin
     postorder (root^.kiri);
     postorder (root^.kanan);
     write (root^.isi : 4);
   end;
end;

begin {Program Utama}
clrscr;
write('masukkan data(x = selesai) : ');readln(elemen);
repeat
    new (baru);
    baru^.isi := elemen;
    sisip (root,baru);
write('masukkan data (x = selesai : ');readln(elemen);
until elemen = 'x';
writeln;
writeln('hasil dari penelusuran pohon biner :');
write('1. Inorder   : ');inorder (root); writeln;
write('2. Postorder : ');postorder (root); writeln;
write('3. Preorder  : ');preorder (root); writeln;
readln;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.

PASCAL - CONTOH PROGRAM MENGUNAKAN LINKED LIST

Listing Program :

Program QueueLinkedList;
Uses crt;
Type pointer = ^ simpul;
      simpul  = record
    data : char;
    next : pointer;
      end;
      antrian = record
    rear,front : pointer;
      end;
var q: antrian;
    baru,bantu,hapus : pointer;
    elemen : char;
    i : integer;
Procedure enqueue;
begin
 new(baru);
 baru^.data := elemen;
 baru^.next := nil;
 if q.rear = nil then
   begin
    q.front^.data := elemen;
    q.rear := baru;
   end
 else
   begin
    baru^.next := baru;
    q.rear := nil;
   end;
end;

Procedure dequeue;
begin
  new (bantu);
  bantu := q.rear;
  if q.rear  <> q.front then
   begin
    while bantu^.next <> q.front do
       bantu := bantu^.next;
    elemen := bantu^.data;
    new (hapus);
    hapus := q.front;
    q.front := bantu;
    q.front^.next := nil;
    dispose (hapus);
   end
 else
   begin
    new (hapus);
    hapus := q.front;
    elemen := q.front^.data;
    q.front := q.rear;
    q.rear := hapus^.next;
    dispose (hapus);
   end;
end;

Procedure cetak;
begin
    write('isi antrian saat ini :');
    new (bantu);
    bantu := q.rear;
if q.rear <> nil then
  begin
    while bantu^.next <> nil do
    begin
      write(bantu^.data:4);
          bantu := bantu^.next;
    end;
    writeln(bantu^.data:4);
  end;
end;
begin {program utama}
clrscr;
write('masukkan panjang antrian :');readln (i);
for i := 1 to i do
begin
 write('masukkan elemen antrian ke',i,' : ');readln (elemen);
 enqueue;
 cetak;
end;
readln;
write('proses penghapusan elemen antrian :');
while q.rear <> nil do
begin
    readln;
    dequeue;
    writeln('elemen yang dikeluarkan :',elemen :4);
    cetak;
end;
writeln('antrian telah kosong...!');
readln;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.

PASCAL - CONTOH PROGRAM MENYUSUN BILANGAN MENGGUNAKAN SIMPUL

Listing Program :

program susunangka;
uses crt;
type pointer = ^simpul;
     simpul = record
            data : byte;
            next : pointer;
     end;

var  awal,baru,bantu : pointer;
     angka : byte;
procedure cetak;
begin
     new(bantu);
     bantu := awal;
     while bantu^.next <> nil do
     begin
          write(bantu^.data,' ');
          bantu := bantu^.next;
     end;
     write(bantu^.data);
end;

begin
     clrscr;
     new(awal);
     awal := nil;
     write('Masukkan angka [0 untuk berhenti] : ');readln(angka);
     repeat
        new(baru);
        baru^.data := angka;
        baru^.next := nil;
        if awal = nil then
           awal := baru
        else
        if baru^.data < awal^.data then
        begin
           baru^.next := awal;
           awal := baru;
        end
        else
        begin
             new(bantu);
             bantu := awal;
             while (bantu^.next <> nil) and (bantu^.next^.data < baru^.data) do
                  bantu := bantu^.next;
             baru^.next := bantu^.next;
             bantu^.next := baru;
        end;
        write('Masukkan angka [0 untuk berhenti] : ');readln(angka);
     until angka = 0;
     cetak;
     readln;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.

PASCAL - CONTOH PROGRAM SUSUN BILANGAN MENGGUNAKAN POINTER

Listing Program :

program susunangka;
uses crt;
type pointer = ^simpul;
     simpul = record
            data : byte;
            next : pointer;
     end;

var  awal,baru,bantu,hapus : pointer;
     angka,x : byte; mau : char;
procedure cetak;
begin
     new(bantu);
     bantu := awal;
     while bantu^.next <> nil do
     begin
          write(bantu^.data,' ');
          bantu := bantu^.next;
     end;
     write(bantu^.data);
end;

begin
     x := 1;
     repeat
           clrscr;
           new(awal);
           awal := nil;
           write('[0 untuk berhenti] Masukkan angka ke ',x,' : ');readln(angka);
           inc(x);
     until angka <> 0;
     repeat
        new(baru);
        baru^.data := angka;
        baru^.next := nil;
        if awal = nil then
           awal := baru
        else
        if baru^.data < awal^.data then
        begin
           baru^.next := awal;
           awal := baru;
        end
        else
        begin
             new(bantu);
             bantu := awal;
             while (bantu^.next <> nil) and (bantu^.next^.data < baru^.data) do
                  bantu := bantu^.next;
             baru^.next := bantu^.next;
             bantu^.next := baru;
        end;
        write('[0 untuk berhenti] Masukkan angka ke ',x,' : ');readln(angka);
        inc(x);
     until angka = 0;
     write('Setelah data diurutkan = ');
     cetak;
     writeln;
     repeat
       write('apakah anda ingin menghapus data angka genap ?[y/t] : ');readln(mau);
     until (mau = 'y') or (mau = 't');
     if mau = 'y' then
     begin
          while (awal^.data mod 2 = 0) and (awal^.next <> nil) do
          begin
               new(hapus);
               hapus := awal;
               awal := hapus^.next;
               dispose(hapus);
          end;
          if (awal^.next = nil) and (awal^.data mod 2 = 0) then
             awal := nil;
          if awal <> nil then
          begin
               new(bantu);
               bantu := awal;
               while bantu^.next <> nil do
               begin
                    if bantu^.next^.data mod 2 = 0 then
                    begin
                         new(hapus);
                         hapus := bantu^.next;
                         bantu^.next := hapus^.next;
                         dispose(hapus);
                    end
                    else
                        bantu := bantu^.next;
               end;
          end;
     end;
     if mau = 't' then
          write('Data masih tetap sama')
     else if awal <> nil then
     begin
          write('Data setelah semua angka genap dihapus = ');
          cetak;
     end
     else
         write('Data angka ganjil tidak ada');
     readln;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.

PASCAL - CONTOH PROGRAM MENGGUNAKAN STACK

Listing Program :

program tigastack;
uses crt;
type tumpukan = record
        isi : array[1..25] of byte;
        top : 0..25;
     end;
var t1,t2,t3 : tumpukan;
    x,n,angka,bantu : byte;
procedure tumpuk(var t : tumpukan;angka : byte);
begin
     inc(t.top);
     t.isi[t.top] := angka;
end;
procedure keluarkan(var t : tumpukan;var angka : byte);
begin
     angka := t.isi[t.top];
     dec(t.top);
end;
{procedure atur(var t : tumpukan; angka : byte);
begin
     repeat
          keluarkan(t,bantu);
          tumpuk(t3,bantu);
     until (t.isi[t.top] > angka) or (t.top = 0);
     tumpuk(t,angka);
     repeat
           keluarkan(t3,bantu);
           tumpuk(t,bantu);
     until t3.top = 0;
end;          }
procedure cetak(t : tumpukan);
begin
     repeat
          keluarkan(t,angka);
          write(angka:3);
     until t.top = 0;
end;
begin
     t1.top := 0; t2.top := 0; t3.top := 0;
     repeat
           clrscr;
           writeln('PROGRAM APLIKASI STACK(tumpukan data)':50);
           write('Banyaknya angka acak ?? [5 sampai 25] : ');readln(n);
     until n in[5..25];
     for x := 1 to n do
     begin
          write('Angka ke ',x,' : ');readln(angka);
          if angka mod 2 = 0 then
             tumpuk(t1,angka)
          else
              tumpuk(t2,angka);
     end;
     repeat
           keluarkan(t1,angka);
           if t3.top = 0 then
              tumpuk(t3,angka)
           else
           begin
                if angka > t3.isi[t3.top] then
                   tumpuk(t3,angka)
                else
                begin
                     repeat
                           keluarkan(t3,bantu);
                           tumpuk(t2,bantu);
                     until (t3.isi[t3.top] < angka) or (t3.top = 0);
                     tumpuk(t3,angka);
                     repeat
                           keluarkan(t2,bantu);
                           tumpuk(t3,bantu);
                     until t2.isi[t2.top] mod 2 = 1;
                end;
           end;
     until t1.top=0;
     repeat
           keluarkan(t3,angka);
           tumpuk(t1,angka);
     until t3.top = 0;
     writeln;
     write('Angka genap  = ');
     if t1.top = 0 then
        write('Tidak ada angka genap !')
     else
         cetak(t1);
     writeln;
     write('Angka ganjil = ');
     if t2.top = 0 then
        write('Tidak ada angka ganjil !')
     else
         cetak(t2);
     readkey;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.

PASCAL - CONTOH PROGRAM INPUT DATA MAHASISWA MENGGUNAKAN ARRAY

Listing Program :

program DataMahasiswa;
uses crt;
type MaKul = record
           sem  : char;
           kode : string[3];
           nmk  : string[40];
           sks  : byte;
           n    : char;
     end;
     DaMa = record
        nim    : string[6];
        nama   : string[25];
        al     : string[30];
        mak    : array[1..14] of makul;
      end;
var mhs : array[1..10] of DaMa;
    kul : array[1..10] of byte;
    i,j,x,y,jum,b,bobot,h,tsks,sXb : byte;
    ips : real;

begin
     clrscr;
     i := 1;
     writeln('SISTEM INFORMASI MAHASISWA');
     write('Nomor Induk Mahasiswa : ');readln(mhs[i].nim);
     repeat
        write('Nama Mahasiswa        : ');readln(mhs[i].nama);
        write('Alamat Mahasiswa      : ');readln(mhs[i].al);
        writeln('Mata Kuliah yang diprogramkan':50);
        jum := 0;j := 1;
        repeat
            write('Semester ke [1 sampai 8]        : ');readln(mhs[i].mak[j].sem);
            write('Kode Mata Kuliah                : ');readln(mhs[i].mak[j].kode);
            write('Nama Mata Kuliah                : ');readln(mhs[i].mak[j].nmk);
            write('Nilai yang diperoleh [A..E]     : ');readln(mhs[i].mak[j].n);
            write('Jumlah sks Mata Kuliah tersebut : ');readln(mhs[i].mak[j].sks);
                 jum := jum + mhs[i].mak[j].sks;
                 inc(kul[i]);
                 inc(j);
        until jum > 20;
        inc(i);
        clrscr;
        write('Nomor Induk Mahasiswa [x = selesai] : ');readln(mhs[i].nim);
     until mhs[i].nim = 'x';
     clrscr;
     h:=8;
     for y := 1 to i-1 do
     begin
        ips:=0;
        writeln('No.pokok : ',mhs[y].nim);
        writeln('Nama     : ',mhs[y].nama);
        writeln('Alamat   : ',mhs[y].al);
        writeln('Mata Kuliah yang diprogramkan':50);
        for x:=1 to 65 do
            write('=');
        writeln;
        writeln('|No| kodeMK |   Nama matakuliah           | sks | Nilai | s * b |');
        for x:=1 to 65 do
            write('=');
        writeln;
        tsks:=0; sXb:=0;
        for x := 1 to kul[y] do
        begin
             gotoxy(1,h);write('|');gotoxy(4,h);write('|');
             gotoxy(13,h);write('|');gotoxy(43,h);write('|');
             gotoxy(49,h);write('|');gotoxy(57,h);write('|');
             gotoxy(65,h);write('|');
             gotoxy(2,h);write(x);
             gotoxy(6,h);write(mhs[y].mak[x].sem,'-',mhs[y].mak[x].kode,mhs[y].mak[x].sks);
             gotoxy(15,h);write(mhs[y].mak[x].nmk);
             gotoxy(46,h);write(mhs[y].mak[x].sks);
             gotoxy(53,h);write(mhs[y].mak[x].n);
             case mhs[y].mak[x].n of
                  'A' : b:=4;
                  'B' : b:=3;
                  'C' : b:=2;
                  'D' : b:=1;
                  'E' : b:=0;
             end;
             bobot:=b*mhs[y].mak[x].sks;
             sXb := sXb + bobot;
             tsks := tsks + mhs[y].mak[x].sks;
             gotoxy(61,h);write(bobot);
             inc(h);
        end;
        ips := sXb / tsks;
        writeln;
        for x:=1 to 65 do
            write('-');
        gotoxy(30,h+1);write('JUMLAH');gotoxy(46,h+1);write(tsks);gotoxy(61,h+1);write(sXb);
        writeln;
        for x:=1 to 65 do
            write('-');
        writeln;
        gotoxy(35,h+3);writeln('Indeks prestasi semester : ',ips:2:2);
        writeln;
        inc(h,12);
     end;
     readln;
end.

Jangan lupa tinggalkan pesan berupa saran dan kritik yang bermanfaat untuk blog  ini. Untuk teman-teman yang hendak mencopy artikel ini untuk dipasang pada blog atau web-nya, dengan sangat diharapkan untuk mencantumkan Link keblog ini sebagai sumber artikel sekaligus sebagai backlink untuk blog ini. Terima kasih untuk pengertian dan kerjasamanya, mari berkembang bersama.