Widget by Restana Corporation

Monday, December 1, 2014

APLIKASI METODE TRANSPORTASI NORTWEST CORNER

APLIKASI METODE TRANSPORTASI NORTWEST CORNER

Thursday, October 9, 2014

Kumpulan Sintak Program Array di Pascal Sederhana

Menentukan Banyaknya muncul angka di array
--------------------------------------------------------
program BanyakMuncul;

var i,n,muncul,x: integer;
angka : array[1..100] of integer;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//menentukan nilai x
write('Nilai x : ');readln(x);

//algortima banyaknya kemunculan
muncul := 0;
for i:=1 to n do
begin
if (x=angka[i]) then
inc(muncul); //muncul:=muncul + 1;
end;

//menampilkan hasil
write('Banyaknya kemunculan nilai ',x,' : ',muncul);
        readln()
end.

Menentukan Jumlah Array
--------------------------------
program JumlahArray;

var i,n,jumlah : integer;
angka : array[1..100] of integer;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//algoritma penjumlahan array
jumlah:=0;
for i:=1 to n do
begin
jumlah:=jumlah+angka[i];
end;

//menampilkan jumlah yang diperoleh
writeln('Jumlahnya ', jumlah);
        readln;
end.

Mencari Posisi
-------------------
Program Mencari_Posisi;

uses crt;

var
   t : array[1..100] of integer;
   x,i,posisi,n : integer;

begin
     write('Banyaknya Bilangan : '); readln(n);

     for i := 1 to n do
         begin
              write('Posisi ke ',i, ': '); readln(t[i]);
         end;
              write('Nilai X  '); readln(x);

         posisi:=0;
         for i := 1 to n do
             begin
                  if x = t[i] then
                     posisi:=i;
             end;
         writeln('Posisi : ', posisi);
end.

Mentukan Besar 
--------------------
program nilaiTerbesar;

var i,n,besar : integer;
angka : array[1..100] of integer;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//algoritma nilai terbesar
besar := angka[1];
for i:=2 to n do
begin
if (besar<angka[i]) then
besar := angka[i];
end;

//menampilkan nilai terbesar
writeln('Nilai terbesar adalah ', besar);
end.


Menentukan Apakah semua negatif atau tidak
-----------------------------------------------------------
program semuaNegatif;

var i,n : integer;
angka : array[1..100] of integer;
jawab : string;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//algoritma penjumlahan array
jawab := 'Semua Negatif'; i:=1;
while i<=n do
begin
if angka[i]>0 then
begin
jawab := 'Tidak Semua Negatif';
end;
i:= i +1;
end;

//menampilkan jumlah yang diperoleh
writeln(jawab);
        readln;
end.

Sintak Algoritma Queue Non Circular & Circular di Pascal Struktur Data

evans-blog-praktikum-struktur-data-bahasa-java-queue copy
Queue Non Circular
--------------------------
Program UASQueueNonCircular;
uses crt;

const Nmax = 5;

type Queue = record
           isi  : array[1..Nmax] of integer;
           head : integer;
           tail : integer;
     end;

function QueueKosong (Q : Queue) : boolean;
     var
        kosong : boolean;
     begin
        if (Q.head = 0) AND (Q.tail = 0) then
           kosong := true
        else
           kosong := false;

        QueueKosong := kosong;
     end;

function QueuePenuh (Q : Queue) : boolean;
     var
        penuh : boolean;
     begin
        if (Q.head = 1) AND (Q.tail = Nmax) then
           penuh := true
        else
           penuh := false;

        QueuePenuh := penuh;
     end;

procedure ADD (var Q : Queue; angka : integer);
     begin
        if not QueuePenuh(Q) then
           if QueueKosong(Q) then
              begin
                   Q.head := 1;
                   Q.tail := 1;
                   Q.isi[Q.tail] := angka;
              end
           else
              begin
                   Q.tail := Q.tail+1;
                   Q.isi[Q.tail] := angka;
              end;
     end;

procedure REMOVE (var Q : Queue; var x : integer);
     var
        i : integer;
     begin
         if not QueueKosong(Q) then
            if (Q.head = 1) AND (Q.tail = 1) then
               begin
                  Q.head := 0;
                  Q.tail := 0;
               end
            else
               begin
                  x := Q.isi[Q.head];
                  for i := 1 to Q.tail do
                      begin
                           Q.isi[i-1] := Q.isi[i];
                      end;

                      Q.tail := Q.tail - 1;
               end;


     end;

procedure tampil(Q : Queue);
   var
      i : integer;
   begin
      for i := 1 to 5 do
          begin
               write(Q.isi[i], ' ');
          end;
          writeln;
   end;

// Contoh Program Utama
var
   Q : Queue;
   x,i : integer;
begin
   tampil(Q);
            ADD(Q,2);
   tampil(Q);
            ADD(Q,3);
   tampil(Q);
            ADD(Q,5);
   tampil(Q);
            ADD(Q,6);
   tampil(Q);
            ADD(Q,1);
   tampil(Q);
            REMOVE(Q,x);


   writeln('Nilai X : ', x);
   writeln('Tail : ', Q.tail);
   writeln('Head : ', Q.head);
   readln;

end.


Queue Circular
--------------------
Program QueueAntrian;
uses crt;

const Nmax = 100;

type Queue = record
           isi : array[1..Nmax] of integer;
           head : integer;
           tail : integer;
     end;

function QueueKosong(Q : Queue) : boolean;
     var
        kosong : boolean;
     begin
        if (Q.head = 0) and (Q.tail = 0) then
           kosong := true
        else
           kosong := false;
        QueueKosong := kosong;
     end;

function QueuePenuh(Q : Queue) : boolean;
     var
        penuh : boolean;
     begin
        if Q.tail = Nmax then
           penuh := true
        else
           penuh := false;
        QueuePenuh := penuh;
     end;

function QueueSatu(var Q :Queue) : boolean;
     var
        isisatu : boolean;
     begin
          if (Q.head=1) and (Q.tail=1) then
             isisatu := true
          else
              isisatu := false;
          QueueSatu:=isisatu;

     end;

procedure ADD(var Q : Queue; x : integer);
     begin
          if not QueuePenuh(Q) then
             if QueueKosong(Q) then
                begin
                     Q.head := 1;
                     Q.tail := 1;
                     Q.isi[Q.tail] := x;
                end
             else
                 begin
                     Q.tail := Q.tail + 1;
                     Q.isi[Q.tail] := x;
                 end;
     end;

Procedure REMOVE(var Q : Queue; var x : integer);
     var
          i:integer;
     begin
          if not QueueKosong(Q) then
             if QueueSatu(q) then
                begin
                     Q.head :=0;
                     Q.tail :=0;
                end
             else
                 begin
                 x := Q.isi[Q.head];
                 {alogoritma geser kiri}

                 for i:= 2 to Q.tail do
                     begin
                          Q.isi[i-1] := Q.isi[i];
                     end;
                 Q.tail:=Q.tail-1;
                 end;
     end;

var
   Q : Queue;
   x,i : integer;
begin
   add(Q,2);
   add(Q,3);
   add(Q,5);
   add(Q,1);
   add(Q,9);
   remove(Q,x);

   for i:=1 to Q.tail do
       begin
            writeln(Q.isi[i]);
       end;
       begin;
            writeln('Nilai x adalah : ',x);
            writeln('Nilai tail adalah : ', Q.tail);
            writeln('Nilai head adalah : ', Q.head);
       end;
readln;

end.

Sintak Algoritma Stack (TUMPUKAN) di Pascal

Pengertian Stack atau Tumpukan adalah suatu stuktur data yang penting dalam pemrograman yang mempunyai sifat LIFO (Last In First Out), Benda yang terakhir masuk ke dalam stack akan menjadi benda pertama yang dikeluarkan dari stack.  Stack (Tumpukan) adalah list linier yang dikenali elemen puncaknya (TOP) dan Aturan penyisipan dan penghapusan elemennya tertentu. Penyisipan selalu dilakukan “di atas“  TOP dan Penghapusan selalu dilakukan pada TOP.

Ilustrasi stack pada saat inisialisasi


Fungsi IsFull
Untuk memeriksa apakah stack sudah penuh?
Dengan cara memeriksa top of stack, jika sudah sama dengan MAX_STACK-1 maka full, jika belum (masih lebih kecil dari MAX_STACK-1) maka belum full

Ilustrasi

Sintak Stack :
----------------------
Program StackTumpukan;
uses crt;

const Nmax = 100;

type Stack = record
           isi : array[1..Nmax] of integer;
           top : integer;
     end;

function IsEmpty(S : Stack) : boolean; {mengecek stack kosong}
     var
        empty : boolean;
     begin
        if S.top = 0 then
           empty := true
        else
            empty := false;
        IsEmpty := empty;
     end;

function IsFull(S : Stack) : boolean; {mengecek stack penuh}
     var
        full : boolean;
     begin
        if S.top = Nmax then
           full:=true
        else
            full:=false;
        IsFull := full;
     end;

Procedure PUSH (var S:Stack; x : integer); {fungsing push/ memasukkan}
     begin
       if IsFull(S) = false then
        begin
             S.top := S.Top + 1;
             S.isi[S.top] :=x;
        end;
     end;
Procedure POP (var S : Stack; var  x : integer); {fungsi pop / mengambil/dilayani}
     begin
          if IsEmpty(S) = false then
          begin
               x:=S.isi[S.top];
               S.top := S.top-1;
          end;
          writeln('Hasil POP ', x);
     end;

// contoh program utama
var
   a,b,c,x,i : integer;
   S : Stack;
begin
   a := 5;
   b := 3;
   c := 7;
   s.top:=0;
   PUSH(S,a);
   PUSH(S,c*c);
   POP(S,x);
   b:=x;
   PUSH(S,a+b);
   POP(S,x);
   a:=x;
   POP(S,x);
   b:=x;

   for i:=1 to s.top do
       writeln(S.isi[i]);

   writeln(s.top);
      readln;

end.



Free Download KMPlayer v3.9.1.129 New Full Version



KMPlayer itself has many users and between them have been using this software so default play audio and video files, and most people also this software Mumunya to play video and a movie which also supports movie subtitle. 
KMPlayer is very suitable for those of you used to play video as well as audio for almost all kinds of audio and video files can be played back with this one so the software is not in use and KMPlayer ragunkan 3.9.1.129 is the latest version that has been released on this week.



Screen Shoot
Link Download



Free Download K-Lite Mega Codec Pack 10.8.0 Full Version



K-Lite Mega Code Pack is a file in which the existing application function Media Player Classic which is used as a media player or to play sound or video files, Where are among users also liked because light is used when running Media Player Classic and not only was in the K-Lite Code Pack also Meda already some codecs to add a file that supports the default Windows Media Player. 
K-Lite Mega Codec Pack released the latest version is 10.8.0, which certainly brought change and also codecs in it.


Screen Shoot

Link Download



Older Posts