Contoh Function Recursive

contoh program sederhana yang menggunakan function recursive tanpa menggunakan loop….

uses crt;
var bil:integer;

function hasil1(x:integer):longint; {fungsi unk bilangan x positif}
begin
if (x mod 2) 0 then dec(x); {jika bil bil bukan genap, maka dikurangi satu}
if x=0 then hasil1:=0 else hasil1:=x+hasil1(x-2); {deret terjadi x+(x-2)+(x-4)+……+0}
end;

function hasil2(x:integer):longint; {fungsi untuk x bilangan negatif}
begin
if (x mod 2) 0 then inc(x); {misal x=-11,maka x=x+1=-10}
if x=0 then hasil2:=0 else hasil2:=x+hasil2(x+2); {deret menjadi x+(x+2)+(x+4)+….+0}
end;

begin
write(‘masukkan bilangan sembarang ‘);
readln(bil);
if bil>=0 then writeln(‘Jumlah genap dari ‘,bil,’ adalah ‘,hasil1(bil))
else writeln(‘jumlah genap dari ‘,bil,’ adalah ‘,hasil2(bil));
end.

Selengkapnya...

Recursive Function

Recursive Function untuk menentukan pangkat n suatu bilangan..program ini sangatlah sederhana. tapi untuk yang tidak mengerti mungkin ini sungguh sangat sulit untuk membuatnya…

uses wincrt;
var bil,n:integer;

function pangkat(x,m:integer):longint;
begin
if m=0 then pangkat:=1 else
pangkat:=x*pangkat(x,m-1); {lakukan rekursif dengan mengurngi pangkatnya yaitu m}
end;

begin
write(‘masukkan bilangan sembarang ‘);readln(bil);
write(‘akan dipangkatkan berapa? ‘); readln(n);
if n<0 then writeln('maaf hanya menghitung pangkat positif') {pengecekan jika n<0} else writeln('hasil ',bil,' pangkat ',n,' adalah ',pangkat(bil,n)); end.

Selengkapnya...

Program Toko Kue

Program ini untuk penginputan kue berdasarkan rasa yang telah tersedia, serta berbagai informasi antara lain melakukan pencarian rasa, informasi harga kue tersebut, stok kue, serta merekap hasil jumlah kue yang terjual dan total pendapatan dari toko kue itu buka hingga tutup. program ini menggunkan beberapa menu dan procedure, yang terdapat 5 record. listingnya sebagai berikut :

uses wincrt;
type kue=record
rasa:string;harga:longint;
stok:byte;
end;
larikkue=array[1..5] of kue;
var
bronis:larikkue;
lagi:boolean;isi,terjual,i:byte;
pil:1..6;
hasil:longint;


procedure isiarray(var x:larikkue);
begin
{isi rasa bisa dilakukan secara manual}
x[1].rasa:='coklat';x[2].rasa:='oroginal';x[3].rasa:='keju';x[4].rasa:='bluberi';x[5].rasa:='kacang';
{isi harga ke dalam array dengan if}
for i:=1 to 5 do {karena toko hanya menyediakan 5 rasa}
begin
if (x[i].rasa='coklat') then x[i].harga:=25000 else if (x[i].rasa='original') then x[i].harga:=23000 else
if (x[i].rasa='keju') then x[i].harga:=26500 else if (x[i].rasa='blueberi') then x[i].harga:=26000 else
x[i].harga:=24500;
end;
end;uses wincrt;
type kue=record
rasa:string;harga:longint;
stok:byte;
end;
larikkue=array[1..5] of kue;
var
bronis:larikkue;
lagi:boolean;isi,terjual,i:byte;
pil:1..6;
hasil:longint;


procedure isiarray(var x:larikkue);
begin
{isi rasa bisa dilakukan secara manual}
x[1].rasa:='coklat';x[2].rasa:='oroginal';x[3].rasa:='keju';x[4].rasa:='bluberi';x[5].rasa:='kacang';
{isi harga ke dalam array dengan if}
for i:=1 to 5 do {karena toko hanya menyediakan 5 rasa}
begin
if (x[i].rasa='coklat') then x[i].harga:=25000 else if (x[i].rasa='original') then x[i].harga:=23000 else
if (x[i].rasa='keju') then x[i].harga:=26500 else if (x[i].rasa='blueberi') then x[i].harga:=26000 else
x[i].harga:=24500;
end;
end;



procedure isistok(var x:larikkue);
begin
for i:= 1 to 5 do
begin
write('masukkan tambahan stok untuk rasa ',x[i].rasa, ' = '); {mengisi stok untuk msg2}
readln(isi); x[i].stok:=x[i].stok+isi;
end;
end;

procedure cari(var x:larikkue);
var cari:string;
ketemu:boolean;
ulang:char;

begin
ulang:='y';
while ulang='y' do
begin
ketemu:=false;
writeln('Anda akan mengecek stok untuk rasa? ');readln(cari);
for i:=1 to 5 do
begin if x[i].rasa=cari then
begin
writeln('bronis rasa ',cari,' dengan harga @Rp',x[i].harga,
' masih tersedia sebanyak ',x[i].stok,' kue');
ketemu:=true;
end;
end;
if not ketemu then writeln('rasa ',cari,' tidak tersedia');
writeln;write('mau cek stok rasa lain? ');readln(ulang);
end;
end;

procedure jual(var x:larikkue);
var beli:string;
ulang:char;
belanja:longint;cacah,n:byte;
ketemu:boolean;
label ulangi;


begin
ulang:='y';cacah:=0;belanja:=0;ketemu:=false;
while ulang='y' do
begin
write('Rasa yang akan dibeli ==> ');readln(beli);
for i:=1 to 5 do
begin
if (x[i].rasa =beli) and (x[i].stok<>0) then
begin
ketemu:=true;
ulangi: writeln('rasa ',beli,' ada. berapa buah mau beli rasa tersebut? ');
readln(n);
if x[i].stok ');readln(ulang);
end;
if ketemu then
begin
writeln('Anda telah membeli kue sejumlah ',cacah,' buah, total pembayaran Rp ',belanja);
writeln('Terimakasih selamat datang kembali');
end
else
writeln('Terimakasih');
end;

procedure cetak(x:larikkue);
begin
writeln('DAFTAR STOK BRONIS ENAK MURAH');
writeln('===================================');
writeln('rasa harga stok');
writeln('-----------------------------------');
for i:=1 to 5 do writeln(x[i].rasa:10,' ',' ',x[i].harga,x[i].stok:4);
writeln('-----------------------------------');
end;

begin
lagi:=true;
isiarray(bronis);
while lagi do
begin
clrscr;
writeln('TOKO BRONIS ENAK MURAH');
writeln('1.Mengisi/tambah stok bronis');
writeln('2.Mencari dan Mengecek stok bronis rasa tertentu');
writeln('3.Penjualan');
writeln('4.Cetak stok');
writeln('5.Rekap');
writeln('6. Tutup toko');
writeln('Pilih <1-6>? ');readln(pil);
case pil of
1: isistok(bronis);
2: cari(bronis);
3: jual(bronis);
4: cetak(bronis);
5: begin
writeln('Saat ini sudah terjual kue sebanyak ',terjual);
writeln('Pendapatan mencapai Rp',hasil);
end;
6: begin
writeln('Terimakasih');lagi:=false;
end;
end;
readln;
end;
end.

Selengkapnya...