--

Program Pascal Palindrom

Friday, January 22, 2010 mencoba sebuah karya dunia maya 1 komentar
Program Pascal Mengecek sebuah Kata Palindrom atau tidak.
Berikut Source cedenya:

uses crt;
var i,j,panjang :integer;
kata : string;
palin: boolean;
begin
clrscr;
writeln('Kata = ');readln(kata);
panjang:=length(kata);
j:=panjang;
palin:=true;
for i:=1 to (panjang div 2) do
begin
if kata[i]<>kata[j] then
begin
palin:=false;
end;
j:=j-1;
end;
if palin then
writeln('kata ' ,kata, ' adalah palindrom')
else
writeln('kata ' ,kata, ' adalah bukan palindrom');
readln;
end.

Program Pascal Metnum

mencoba sebuah karya dunia maya 0 komentar
Program Pascal Menghitung akar dengan metode bagi dua dan regulapalsi.
Materi Metode Numerik.
Berikut Source Codenya:

uses crt;
var
a,b:real;
function fungsi(x:real):real;
var
fx:real;
begin
fx:=exp(x)-5*(x*x);
fungsi:=fx;
end;
procedure bagidua(a,b:real);
const ep=0.000000001;
var
c:real;
i:integer;
begin
i:=0;
repeat
inc(i);
c:= (a+b)/2;
if fungsi(c) = 0 then
begin
a:=c;
b:=c;
end;
if fungsi(a)*fungsi(c) < 0 then
b:= c
else
a:=c;
writeln('iterasi:',i);
writeln('a:',a:0:7);
writeln('b:',b:0:7);
writeln('fa:',fungsi(a):0:7);
writeln('fc:',fungsi(c):0:7);
writeln('c:',c:0:7);
writeln;
until abs(a-b) < ep;
writeln('akar X1=',c:0:5);
end;
procedure regulapalsi(a,b:real);
const ep=0.000001;
var
c:real;
i:integer;
begin
i:=0;
repeat
inc(i);
c:=b-(fungsi(b)*(b-a) / (fungsi(b)-fungsi(a)));
if fungsi(c) =0 then
begin
a:=c;
b:=c;
end
else
if fungsi(a)*fungsi(c) < 0 then
b:=c
else
a:=c;
writeln('iterasi:',i);
writeln('a:',a);
writeln('b:',b);
writeln('fa:',fungsi(a));
until abs(a-b) > ep;
writeln('akar x2=',c:0:5);
end;
begin
write('a:');readln(a);
write('b:');readln(b);
bagidua(a,b);
readln;
end.

Program Pascal Menghitung Mean

mencoba sebuah karya dunia maya 0 komentar
Program Pascal Menghitung nilai rata-rata (Mean).
Berikut Source codenya:

uses crt;
var
x: array [1..100] of integer;
n,i,sum:integer;
mean: real;
begin
write('n:');readln(n);
sum:=0;
for i := 1 to n do
begin
write('x',i,'=');readln(x[i]);
sum:=sum+x[i];
end;
mean:= sum/n;
writeln('mean=',mean);
readln;

end.

Program Pascal MakMin

mencoba sebuah karya dunia maya 0 komentar
Program Pascal mencari nilai Maksimum dan Minimum dari sebuah kumpulan nilai, dimana type data yang digunakan adalah array (Larik).
Berikut Source codenya:

uses crt;
var
i,jum :integer;
data :array[1..10]of integer;
min,max :integer;
total : real;
begin
clrscr;
write('Jumlah Data = ');readln(jum);
for i:=1 to jum do
begin
write('data ke ',i,' : ');readln(data[i]);
end;
min:=9999 ;
max:=-9999;
total:=0;
for i:=1 to jum do
begin
if max if min>data[i] then min:=data[i];
total:=total+data[i];
end;
clrscr;
for i:=1 to jum do
writeln(data[i]);
writeln('Minimum = ',min);
writeln('Maksimum = ',max);
writeln('Rata-rata = ',total/jum:5:2);
readln;
end.

Program Pascal Membuat Polinomial

mencoba sebuah karya dunia maya 0 komentar
Program ini Merupakan Program membuat Polinomial yang telah ditentukan Polanya.
Berikut Source codenya:





program polinomial_lat3;
uses crt;
label balik;
var
j,n,k,i,r:integer;
tanya:char;
begin
balik:
clrscr;
i:=0;
repeat
write('masukkan suku ke n:');readln(n);
inc(i);
until (i=3) or (n>0) ;
if n <=0 then exit; write('sin x= '); write('x'); if n > 1 then
begin
k:=1;
for i:= 2 to n do
begin
k:=k+2;
r:=i mod 2;
if r = 0 then
write('-')
else write('+');
write('x^',k,'/',k,'!');
end;
end;
writeln;
write('apakah mau tampilkan lagi[y/t]:');readln(tanya);
if (tanya='y') and (tanya='y') then
goto balik;
end.