Fibonacci : Pascal

program Fibonacci;
uses crt;

var
i : integer;
count : integer;
numbernow : integer;
numberbefore : integer;
hasil : integer;

begin
clrscr;
write('Enter counter : ');
readln(count);
i:=1;
numbernow:=1;
numberbefore :=0;
while(i<=count) do
begin
write(numbernow,' ');

hasil := numbernow+numberbefore;
numberbefore:=numbernow;
numbernow:=hasil;
i:=i+1;
end;
end.

Convert Detik ke Jam

program ConvertJam;
uses crt;
type jam = record
h : integer;
m : integer;
s : integer;
end;
var
J : jam;
jmh,sisa : integer ;
begin
clrscr;
write('Jumlah detik = ');
readln(jmh);
J.h := jmh div 3600;
sisa := jmh mod 3600;
J.m := sisa div 60;
J.s := sisa mod 60;
write(J.h,':',J.m,':',J.s);
readln;
end.

InsertionSort : Pascal

program InsertionSort;
uses crt;
type arr = array [1..100] of integer;

var
ArrMain : arr;
i,n : integer;

procedure InsertionSort(pjg:integer;var TabInt : arr);
var
i,j,nilai : integer;
begin

for i := 1 to pjg do
begin
nilai := TabInt[i];
j:=i-1;
while ((j>0) AND (TabInt[j]>nilai)) do
begin
TabInt[j+1]:=TabInt[j];
j:=j-1;
end;
TabInt[j+1]:=nilai;
end;
end;

begin
clrscr;
write('Jumlah array : ');readln(n);
for i := 1 to n do
begin
write('Array ke-',i,' : ');
readln(ArrMain[i]);
end;

InsertionSort(n,ArrMain);
writeln;
for i:= 1 to n do
writeln('Array ke-',i,' : ',ArrMain[i]);
end.

MergeSort 2 : Pascal

program MergeSort;
uses crt;
type arr = array [1..100] of integer;

var
ArrMain,ArrUrut : arr;
n,m : integer;

procedure merge(Left:arr; pjgL:integer; Right : arr; pjgR:integer; var ArrMerge : arr);
{IS : Menerima array left dan array right untuk dibandingkan dan disusun kembali ke array merge}
{FS : Hasil penggabungan akan dikembalikan melalui variabel output ArrMerge}
var
i,j,k,m,panjang: integer;
hasil : arr;
begin
i:=1;
j:=1;
k:=1;
panjang:=pjgL+pjgR;
{membandingkan 2 array Left dan Right hingga panjang salah satu array mencapai 0 }
while ((pjgL>0) and (pjgR>0)) do
begin
{jika elemen pertama array Left lebih kecil dari elemen array Right
maka elemen pertama pada array hasil diisi oleh elemen pertama array Left}
if(Left[i]<= Right[j]) then
begin
hasil[k]:=Left[i];
i:=i+1;
k:=k+1;
pjgL:=pjgL-1;
end
{jika elemen pertama array Left lebih besar dari elemen array Right
maka elemen pertama pada array hasil diisi oleh elemen pertama array Right}
else
begin
hasil[k]:=Right[j];
j:=j+1;
k:=k+1;
pjgR:=pjgR-1;
end;
end;
{Jika array Left belum kosong dan array Right sudah kosong,
maka sisa dari Left dimasukkan ke array Hasil}
while (pjgL>0) do
begin
hasil[k]:=Left[i];
i:=i+1;
k:=k+1;
pjgL:=pjgL-1;
end;
{Jika array Left belum kosong dan array Right sudah kosong,
maka sisa dari Left dimasukkan ke array Hasil}
while (pjgR>0) do
begin
hasil[k]:=Right[j];
j:=j+1;
k:=k+1;
pjgR:=pjgR-1;
end;
{Mengembalikan nilai ke variabel output ArrMerge}
ArrMerge:=hasil;
for m:= 1 to panjang do
writeln('Array Merge ke-',m,' : ',hasil[m]);
end;

procedure mergesort(pjg:integer;A : arr;var ArrHasil : arr);
{IS : Menerima Array yang akan dibagi menjadi 2 array yaitu array Left dan array Right}
{FS : Mengembalikan array yg terurut melalui variabel output ArrHasil}
var
middle,i,pjgLeft,pjgRight : integer;
ArrLeft,ArrRight : arr;
begin
if pjg <= 1 then
ArrHasil := A
else
begin
middle := pjg div 2;
for i:=1 to middle do
ArrLeft[i]:=A[i];

for i:=(middle+1) to pjg do
ArrRight[i-middle]:=A[i];
pjgLeft := pjg div 2;
pjgRight := (pjg+1) div 2;
for m:= 1 to pjgLeft do
writeln('Array Left ke-',m,' : ',ArrLeft[m]);
for m:= 1 to pjgRight do
writeln('Array Right ke-',m,' : ',ArrRight[m]);
{rekursif procedure mergesort dengan output akan disimpan di ArrLeft}
mergesort(pjgLeft,ArrLeft,ArrLeft);
{rekursif procedure mergesort dengan output akan disimpan di ArrRight}
mergesort(pjgRight,ArrRight,ArrRight);
{memanggil procedure merge untuk menyatukan ArrLeft dan ArrRight
dan mengembalikan 1 array terurut melalui ArrHasil}
merge(ArrLeft,pjgLeft,ArrRight,pjgRight,ArrHasil);
end;
end;

begin
clrscr;
write('Jumlah array : ');readln(n);
for m := 1 to n do
begin
write('Array ke-',m,' : ');
readln(ArrMain[m]);
end;
writeln;
writeln('LANGKAH MERGE SORT');
writeln('-------------------');
mergesort(n,ArrMain,ArrUrut);
writeln;
writeln('HASIL ARRAY TERURUT');
writeln('---------------------');
for m:= 1 to n do
writeln('Array Urut ke-',m,' : ',ArrUrut[m]);

readln;
end.

MergeSort : Pascal

program MergeSort;
uses crt;
type arr = array [1..100] of integer;

var
ArrMain,ArrUrut : arr;
n,m : integer;
function merge(Left:arr; pjgL:integer; Right : arr; pjgR:integer) :arr;
var
i,j,k,m,panjang: integer;
hasil : arr;
begin
i:=1;
j:=1;
k:=1;
panjang:=pjgL+pjgR;
while ((pjgL>0) and (pjgR>0)) do
begin
if(Left[i]<= Right[j]) then
begin
hasil[k]:=Left[i];
i:=i+1;
k:=k+1;
pjgL:=pjgL-1;
end
else
begin
hasil[k]:=Right[j];
j:=j+1;
k:=k+1;
pjgR:=pjgR-1;
end;
end;
while (pjgL>0) do
begin
hasil[k]:=Left[i];
i:=i+1;
k:=k+1;
pjgL:=pjgL-1;
end;
while (pjgR>0) do
begin
hasil[k]:=Right[j];
j:=j+1;
k:=k+1;
pjgR:=pjgR-1;
end;
merge:=hasil;
for m:= 1 to panjang do
writeln('Array Hasil ke-',m,' : ',hasil[m]);
end;

function mergesort(pjg:integer;A : arr):arr;
var
middle,i,pjgLeft,pjgRight : integer;
ArrLeft,ArrRight,ArrHasil : arr;
begin
if pjg <= 1 then
mergesort := A
else
begin
middle := pjg div 2;
for i:=1 to middle do
ArrLeft[i]:=A[i];

for i:=(middle+1) to pjg do
ArrRight[i-middle]:=A[i];
pjgLeft := pjg div 2;
pjgRight := (pjg+1) div 2;
for m:= 1 to pjgLeft do
writeln('ArrayLeft ke-',m,' : ',ArrLeft[m]);
for m:= 1 to pjgRight do
writeln('ArrayRight ke-',m,' : ',ArrRight[m]);
ArrLeft:=mergesort(pjgLeft,ArrLeft);
ArrRight:=mergesort(pjgRight,ArrRight);
mergesort:=merge(ArrLeft,pjgLeft,ArrRight,pjgRight);
end;
end;

begin
clrscr;
write('Jumlah array : ');readln(n);
for m := 1 to n do
begin
write('Array ke-',m,' : ');
readln(ArrMain[m]);
end;
writeln;
ArrUrut := mergesort(n,ArrMain);

for m:= 1 to n do
writeln('Array Urut ke-',m,' : ',ArrUrut[m]);
end.

{program ini dibuat dengan XCode, klo dijalankan pada Pascal Dos akan error karena tidak bisa mengembalikan nilai dalam bentuk array }

In Code

Blognya nambah lagi

Yang ini khusus blog codingan, maklum dari kuliah semster 1 udah banyak coding yg dibuat tapi pada ngilang kemana-mana, alhasil sekarang pas saya mengajar jadi harus bikin ulang lagi.

Biar mudah nyari dan ada historisnya [ keliatan peningkatan coding dari waktu ke waktu], so dibuatlah blog ini

Klo butuh copy aja.

Enjoy ^o^