Welcome to my site

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.

Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum. ed ut perspiciatis unde omnis iste.

" Small is the number of people who see with their own eyes, think with their own minds and feel with their own hearts " (Albert Hermann Einstein)

= contact me at ndre@engineer.com or click on my facebook badge =

Tampilkan postingan dengan label PROGRAM PASCAL. Tampilkan semua postingan
Tampilkan postingan dengan label PROGRAM PASCAL. Tampilkan semua postingan

SORTING AND SEARCHING / MEMPERBAIKI DAN PENCARIAN PADA PASCAL

Andri Nur 1 comment


program sorting search;
uses wincrt,crt;
Const x : array[1..6] of Integer = (15,13,11,18,16,17);
var cari, flag, sec, max, i, n, min, k, temp, tempat_min : integer;
begin
clrscr;
n:=6;
    for k := 1 to n do
    begin
       min := x[k];
       for i := k to n do
       begin
          if (x[i] <= max) then
          begin
             min := x[i];
             tempat_min := i;
          end;
       end;
    temp := x[k];
    x[k]:=x[i];
    x[tempat_min] := temp;
end;
write('Setelah Diurutkan : ');
    for i:=1 to n do
    begin
       write(x[i],' ');
    end;
flag:=0;
cari:=17;
for i := 1 to 6 do
if (x[k]=cari) then begin flag:=1; end;
if flag=1 then
begin
writeln;
writeln('Data yang di cari : ',cari);
writeln('Data Ada!!');
end else
begin
writeln;
writeln('Data yang di cari : ',cari);
writeln('Data Tidak Ada!!');
end;
readln;
end.
Read more »

Posted in:

TREE – BINARY TREE / POHON BINER PADA PASCAL

Andri Nur No comments


uses crt;
Type
Tree = ^Simpul;
Simpul = Record
Info : char;
Kiri : Tree;
Kanan : Tree;
End;

Function BARU(Hrf : Char) : Tree;
Var Temp : Tree;
Begin
New(Temp);
Temp^.Info := Hrf;
Temp^.Kiri := NIL; Temp^.Kanan := NIL;
BARU := Temp;
End;

Procedure MASUK(Var Pohon : Tree; Hrf : Char);
Begin
If Pohon = NIL Then
Pohon := BARU(Hrf)
Else
Begin
If Pohon^.Info > Hrf then
MASUK(Pohon^.Kiri,Hrf)
Else If Pohon^.Info < Hrf then
MASUK(Pohon^.Kanan,Hrf)
Else
Writeln('Karakter', Hrf, 'Sudah ada di Tree');
End;
End;

Procedure PREORDER(Temp : Tree);
Begin
If Temp <> NIL Then
Begin
Write(Temp^.Info,' ');
PREORDER(Temp^.Kiri);
PREORDER(Temp^.Kanan);
End;
End;

Procedure INORDER(Temp : Tree);
Begin
If Temp <> NIL Then
Begin
INORDER(Temp^.Kiri);
Write(Temp^.Info,' ');
INORDER(Temp^.Kanan);
End;
End;

Procedure POSTORDER(Temp : Tree);
Begin
If Temp <> NIL Then
Begin
POSTORDER(Temp^.Kiri); {Kunjungi cabang kiri}
POSTORDER(Temp^.Kanan); {Kunjungi cabang kanan}
Write(Temp^.Info,' '); {Cetak isi simpul}
End;
End;

var
poon:tree;
Begin
clrscr;

MASUK(poon,'b');
MASUK(poon,'c');
MASUK(poon,'u');
MASUK(poon,'e');
MASUK(poon,'a');
writeln('PERORDER:');
PREORDER(poon);
writeln;
writeln('INORDER:');
INORDER(poon);
writeln;
writeln('POSTORDER:');
POSTORDER(poon);
readln;
end.
Read more »

Posted in:

QUEUE / ANTRIAN PADA PASCAL

Andri Nur No comments


uses crt;
type
    PPNode = ^PNode;
    PNode = ^TNode;
    TNode = record
          data : integer;
          next : PNode;
    end;

procedure tambah(d,b : PPNode ; nilai : integer);
var
   temp : PNode;
begin
        new(temp);
        temp^.data := nilai;
        temp^.next := nil;

        if (d^ = nil) then
        begin
             d^ := temp;
        end
        else
        begin
             b^^.next := temp;
        end;
        b^ := temp;
end;

procedure hapus(d,b : PPNode);
var
   temp : PNode;
begin
     if (d^ = nil) then
     begin
          writeln('Tidak terdapat record dalam queue');
     end
     else
     begin
          temp := d^;
          d^ := temp^.next;
          dispose(temp);
          if (d^ = nil) then
          begin
               b^ := nil;
          end;
     end;
end;

procedure tampilkan(q : PNode);
var
   nilai : integer;
begin
     while(q<> nil) do
     begin
          nilai := q^.data;
          writeln(nilai);
          q := q^.next;
     end;
end;

var
   depan, belakang : PNode;
begin
     clrscr;

     depan := nil;
     belakang := nil;

     tambah(@depan, @belakang, 100);
     tambah(@depan, @belakang, 200);
     tambah(@depan, @belakang, 300);
     tambah(@depan, @belakang, 400);

     writeln('Nilai dalam queue');
     tampilkan(depan);

     hapus(@depan, @belakang);

     writeln;
     writeln('Setelah record terdepan Dihapus : ');
     tampilkan(depan);

     readln;
end.

Read more »

Posted in:

STACK / TUMPUKAN PADA PASCAL

Andri Nur No comments


uses crt;
const max = 10;
var top, i : byte;
    pil, temp, e : char;
    stack : array[1..max] of char;

procedure pushAnim;
begin
     for i := 1 to 18 do
         begin
              gotoxy(24+i,7);write(temp);delay(30);
              gotoxy(24,7);clreol;
         end;
     for i := 1 to 14-top do
         begin
              delay(8000);
              gotoxy(42,6+i);write(' ');
              gotoxy(42,7+i);write(temp);
         end;
     end;

procedure popAnim(temp : char);
begin
     for i := 1 to 14-top do
         begin
              delay(30);
              gotoxy(42,22-i-top);write(' ');
              gotoxy(42,21-i-top);write(temp);
         end;
     for i := 1 to 19 do
         begin
              gotoxy(40+i,7);write(temp);delay(30);
              gotoxy(16,7);clreol;
         end;
     end;

procedure push(e : char);
begin
     inc(top);
     stack[top]:=e;
     pushAnim;
end;

procedure pop(e : char);
begin
     if top <> 0 then
     begin
          e := stack[top]; popAnim(e);
          dec(top);
     end else
     begin
          gotoxy(1,7);write('stack sudah kosong ');readkey;
          gotoxy(1,7);clreol;
         end;
     end;

begin
clrscr;
       writeln ('animasi stack ');
       writeln ('1. push ');
       writeln ('2. pop ');
       writeln ('3. exit ');
       writeln ('pilihan [1/2/3] = ');
       gotoxy(59,6);write(' ');
       gotoxy(59,8);write(' ');
       gotoxy(37,10);write('       ');
       for i := 1 to 11 do
           begin
                gotoxy(38,10+i);
                if i = 11 then write('³_______³') else write('³_______³');
           end;
       top := 0;
       repeat
             gotoxy(19,5);clreol;
             pil := readkey; write(pil);
             if pil = '1' then
                begin
                     if top <> max then
                     begin
                      gotoxy(1,7);write('masukkan satu huruf = ');
                      temp := readkey; write(temp);
                      push(temp);
                      gotoxy(1,7);clreol;
                end else
                begin
                      gotoxy(1,7);write('stack sudah penuh ');readkey;
                      gotoxy(1,7);clreol;
                end;
             end else
       if pil = '2' then pop(temp);
       until pil = '3'
end.

Read more »

Posted in:

DOUBLE LINK LIST PASCAL

Andri Nur No comments

uses crt;
type
   Pnode = ^node;
   node = record
          info:char;
          before,next:Pnode;
end;

double = object
   awal,baru,akhir:Pnode;
   procedure initial;
   procedure tambah_awal(p:char);
   procedure tambah_akhir(p:char);
   procedure cetak;
End;

procedure double.initial;
begin
   awal:=nil;
   akhir:=nil;
end;

procedure double.tambah_awal(p:char);
begin
   new(baru);
   baru^.info:=p;
   baru^.before:=nil;
   if awal=nil then
   begin
      awal:=baru;
      akhir:=baru;
   end
   else
   begin
      baru^.next:=awal;
      awal^.before:=baru;
      awal:=baru;
   end;
end;

procedure double.tambah_akhir(p:char);
begin
   new(baru);
   baru^.info:=p;
   baru^.next:=nil;
   if awal=nil then
   begin
      awal:=baru;
      akhir:=baru;
   end
   else
   begin
      baru^.before:=akhir;
      akhir^.next:=baru;
      akhir:=baru;
   end;
end;

procedure double.cetak;
var
   bantu:pnode;
   c:char;
begin
   bantu:=awal;
   repeat
   if (bantu =awal)  then
      textcolor(lightgreen);
      if (bantu =akhir) then
         textcolor(lightred);
         write(bantu^.info,'-');
         repeat
            c:=readkey;
         until ord(c) in[75,77,27];
         case  ord(c) of
            75: if bantu <>awal then bantu:=bantu^.before;
            77: if bantu <> akhir then bantu:=bantu^.next;
         end;
      textcolor(white);
   until c=#27;
end;

var
    list:double;
    k:char;
begin
   clrscr;
   textcolor(white);
   writeln('    -Program Double Linked List-');
   repeat
      write('Karakter : ');
      k:=readkey;
      if not(k in [#13,#27]) then
         list.tambah_akhir(upcase(k));
         writeln(k);
   until k=#27;writeln;
   list.cetak;
end.
Read more »

Posted in:

ARRAY DAN RECORD PASCAL

Andri Nur 1 comment

uses crt;
type
Rmhs = Record
nm,npm,kls: string;
end;
var
mhs: array [1..5] of Rmhs;
n, i : integer;
begin
clrscr;
write ('masukkan banyak data : ');
readln (n);
writeln;
for i:= 1 to n do
begin
write('masukkan nama ke-',i,' : ');
readln(mhs[i].nm);
write('masukkan npm ke-',i,' : ');
readln(mhs[i].npm);
write('masukkan kelas ke-',i,' : ');
readln(mhs[i].kls);
writeln;
end;
clrscr;
for i := 1 to n do
begin
writeln('Nama ke-',i,' : ',mhs[i].nm);
writeln('NPM ke-',i,' : ',mhs[i].npm);
writeln('Kelas ke-',i,' : ',mhs[i].kls);
writeln;
end;
readkey;
end.
Read more »

Posted in:
 
This Theme Modified by Kapten Andre based on Structure Theme from MIT-style License by Jason J. Jaeger