- Program Menghitung Bilangan Prima
uses wincrt;
var
batas : real;
n:integer;
i,j,jumlah :word;
prima: array[1..1000] of char;
begin
write('bilangan prima antara 1 sampai dengan '); read (n);
writeln('------------------------------------');
batas:=sqrt(n);
jumlah:=0;
writeln;
for i:=2 to n do
begin
if prima[i]<>'*' then
begin
write(i:5);
jumlah:=jumlah+1;
if i<batas then
begin
j:=i;
while j<n do
begin
j:=j+i;
prima[j] := '*';
end;
end;
end;
end;
writeln;
writeln;
writeln;
writeln('ada sejumlah ',jumlah, ' bilangan prima');
end.
- Program Bilangan Ganjil Genap
Program mengetahui_bilangan_ganjil_atau_genap;
uses wincrt;
var b:integer;
begin
write ('bilangan = '); readln (b);
if (b mod 2)=1 then
write ('ganjil')
else
write (' genap');
end.
- Program Luas dan Keliling Lingkaran
Program Luas_Lingkaran_dan_Keliling_Lingkaran;
uses wincrt;
const
phi=3.142857;
var
r, Luas, Keliling:real;
begin
write ('masukkan jari-jari lingkaran: ');readln(r);
Luas:=(phi*r*r);
Keliling:=(phi*2*r);
writeln ('luas:', Luas:10:3);
writeln ('keliling:', Keliling:10:3);
end.
- Program Volume dan Luas Permukaan Kubus
uses wincrt;
var
alas, volume, luas_permukaan:real;
begin
write('masukkan luas alas =');readln(alas);
volume:=alas*alas*alas;
luas_permukaan:=6*(alas*alas);
writeln('volume=',volume:5:2);
writeln('luas_permukaan=',luas_permukaan:5:2);
end.
- Program Luas Permukaan Tabung dan Kerucut
uses wincrt;
const
phi=3.142857;
var
r, t, s, luas_permukaan_tabung, luas_permukaan_kerucut:real;
begin
write('masukkan jari-jari =');readln(r);
write('masukkan tinggi =');readln(t);
write('masukkan selimut_kerucut =');readln(s);
luas_permukaan_tabung:=((2*phi*r*r)+(2*phi*r*t));
luas_permukaan_kerucut:=((phi*r*r)+(phi*r*s));
writeln('luas_permukaan_tabung=',luas_permukaan_tabung:5:2);
writeln('luas_permukaan_kerucut=',luas_permukaan_kerucut:5:2);
end.
- Program Konversi Biner ke Desimal
uses wincrt;
var
desimal,b,sisa,biner:integer;
begin
write (' angka biner '); readln (biner);
b:=0;
repeat
sisa:= biner mod 10;
biner:= biner div 10;
if (b=0) then
b:=1
else
b:=b*2;
desimal:= desimal+sisa*b;
until biner = 0;
write ('desimal=', desimal );
end.
- Program Konversi Desimal ke Biner
uses wincrt;
var
desimal,d,sisa,biner:integer;
begin
write (' angka desimal '); readln (desimal);
d:=0;
repeat
sisa:= desimal mod 2;
desimal:= desimal div 2;
if (d=0) then
d:=1
else
d:=d*10;
biner := biner+sisa*d;
until desimal = 0;
write ('biner=', biner );
end.
- Program Konversi Suhu
uses wincrt;
var
celcius,kelvin:integer;
fahrenheit:real;
begin
write('Masukkan suhu dalam celcius = ');readln(celcius);
fahrenheit:=(9/5*celcius)+32;
kelvin:=celcius+273;
writeln('Suhu dalam fahrenheit = ',fahrenheit:5:2);
writeln('Suhu dalam kelvin = ',kelvin);
end.
- Program Mengurutkan Angka
Uses wincrt;
Const
NMaks = 1000;
Type
Larik = Array [1..NMaks] of Integer;
Var
n : Integer;
bil : Larik;
Procedure Urut(var L:Larik; N:Integer);
Var
I : Integer;
K : Integer;
Temp : Integer;
Begin
For I:=1 to N-1 do
Begin
For K:=N downto I+1 do
Begin
If L[K] < L[K-1] then
Begin
Temp:=L[K];
L[K]:=L[K-1];
L[K-1]:=Temp;
End;
End;
End;
End;
Procedure ProsesUrut(L:Larik; N:Integer);
Var
k:integer;
Begin
For k:=1 to N do
Begin
Write('Data ke-',k,' : ');Readln(L[k]);
end;
Urut(L,N);
clrscr;
Writeln('Data Tersebut Setelah Diurutkan dari yang Terkecil ke yang Terbesar Menjadi : ');
For k:=1 to N do
Begin
Write(L[k],' ');
End;
End;
Begin
Clrscr;
writeln('*************************');
Writeln('Program Mengurutkan Angka');
writeln('*************************');
writeln;
Write('Masukkan Jumlah Data yang Ingin Diurutkan : ');Readln(n);
clrscr;
ProsesUrut(bil,n);
writeln;
end.
- Program Bentuk Matrik
uses wincrt;
var
x:array[1..100,1..100] of integer;
p,l,i,j:integer;
begin
write('banyaknya kolom = '); read(p);
write('banyaknya baris = '); read(l);
writeln('tulis kebawah sebanyak baris kali kolom');
for i:=1 to l do
for j:=1 to p do
readln(x[i,j]);
writeln('bentuk matriknya : ');
for i:=1 to l do
begin
for j:=1 to p do
write(x[i,j],' ');
writeln;
end;
end.
- Program Penjumlahan dan Pengurangan Matrik
uses wincrt;
type
larik=array[1..25,1..25] of real;
var
i,j,k:byte;
bar,col:byte;
a,b,c,d,e:larik;
begin
write ('baris matrik ? ');readln(bar);
write ('kolom matrik ? ');readln(col);
writeln;
writeln ('matrik pertama');
for i:=1 to bar do
begin
for j:=1 to col do
begin
write ('nilai[',i,',',j,']');readln(a[i,j]);
end;
writeln;
end;
writeln;
writeln ('matrik kedua');
writeln;
for i:=1 to bar do
begin
for j:=1 to col do
begin
write ('nilai[',i,',',j,']');readln(b[i,j]);
end;
writeln;
end;
writeln;
writeln;
for i:=1 to bar do
begin
for j:=1 to bar do
begin
for k:=1 to col do
d[i,j]:=a[i,j]+b[i,j]
end;
end;
writeln;
for i:=1 to bar do
begin
for j:=1 to bar do
begin
for k:=1 to col do
e[i,j]:=a[i,j]-b[i,j]
end;
end;
clrscr;
writeln ('matrik pertama:');
for i:=1 to bar do
begin
for j:=1 to col do
begin
write (a[i,j]:0:0,' ');
end;
writeln;
end;
writeln ('matrik kedua:');
for i:=1 to bar do
begin
for j:=1 to col do
begin
write (b[i,j]:0:0,' ');
end;
writeln;
end;
writeln ('hasil penjumlahan matrik:');
writeln;
for i:=1 to bar do
begin
for j:=1 to col do
write(d[i,j]:9:2);
writeln;
end;
writeln ('hasil pengurangan matrik:');
writeln;
for i:=1 to bar do
begin
for j:=1 to col do
write(e[i,j]:9:2);
writeln;
end;
end.
- Program Perkalian Matrik
uses wincrt;
var a,b,c: array[1..10,1..10] of integer;
i,j,k1,k2,b1,b2,sum,r:integer;
begin
write('Masukkan baris Matrik A = ');readln(b1);
write('Masukkan kolom Matrik A = ');readln(k1);
write('Masukkan baris Matrik B = ');readln(b2);
write('Masukkan kolom Matrik B = ');readln(k2);
for i:=1 to b1 do
for j:=1 to k1 do
readln(a[i,j]);
writeln;
for i:=1 to b2 do
for j:=1 to k2 do
readln(b[i,j]);
writeln;
writeln('Matrik A');
writeln('==================');
for i:=1 to b1 do
begin
for j:=1 to k1 do
write(a[i,j],' ');
writeln;
end;
writeln;
writeln('Matrik B');
writeln('===================');
for i:=1 to b2 do
begin
for j:=1 to k2 do
write(b[i,j],' ');
writeln;
end;
writeln;
writeln('Matrik A*B');
writeln('================');
for i:=1 to b1 do
begin
for j:=1 to k2 do
begin
sum:=0;
for r:=1 to k1 do
sum:=sum+a[i,r]*b[r,j];
c[i,j]:=sum;
write(c[i,j]:2,' ');
end;
writeln;
end;
end.
- Program Statistika (Median)
uses Wincrt;
var
x: array [1..100] of integer;
n,i,pos:integer;
md:real;
lagi:char;
Begin
lagi:='y';
while lagi='y' do
begin
writeln('=============');
Writeln('Program median');
Writeln('=============');
Writeln;
writeln('*dalam program mini ini, data yang harus dimasukkan nanti harus sudah urut*');
writeln;
Write('Masukkan Jumlah Data (n): ');
readln(n);
clrscr;
Writeln;
For i:= 1 to n do
Readln(x[i]);
Writeln;
For i:= 1 to n do
if (n mod 2 = 1) then
begin
pos:=(n div 2)+1;
md:=x[pos];
end
else
begin
pos:=(n div 2);
md:=(x[pos]+x[pos+1])/2;
end;
writeln;
Writeln('Median dari data berjumlah ', n,' tadi adalah : ',md:4:2);
writeln;
writeln('*terimakasih sudah menggunakan program ini*');
writeln('hitung lagi?');
readln(lagi);
end;
end.
- Program Statistika (Standard Deviasi dan Varian)
program mean_var_stdev;
uses wincrt;
var
i,n:integer;a,b,c,d:real;x:array[1..100] of integer;
begin
write('masukkan jumlah data: ');readln(n);
a:=0;
for i:=1 to n do
begin
write('x[',i,']= ');readln(x[i]);
a:=a+x[i];
end;
writeln;
writeln('rata-rata: ',a/n:0:2);
for i:=1 to n do
begin
b:=x[i]-(a/n);
c:=sqr(b);
d:=d+c;
end;
writeln('varians: ',d/(n-1):0:2);
writeln('stddev: ',sqrt(d/(n-1)):0:2);
end.
- Program Statistika (Nilai Maksimum Minimum)
uses wincrt;
var
a : array[1..100] of real;
i,n : integer;
max,min : real;
begin
writeln ('masukkan banyaknya data:'); readln(n);
max:=-9999;
min:=9999;
clrscr;
for i:=1 to n do begin
writeln ('data ke: ',i); readln (a[i]);
if max<(a[i]) then max := (a[i]);
if min>(a[i]) then min := (a[i]);
end;
writeln('nilai maksimum : ', max:6:2);
writeln('nilai minimum : ', min:6:2);
end.
- Program Statistika (Peluang Binomial)
uses wincrt;
var
i,j,k,n,x:longint;
a,b,c,d,e,p:real;
begin
writeln('nilai n = ');readln(n);
writeln('nilai x dari n = ');readln(x);
writeln('peluang sukses p = ');readln(p);
a:=1;
b:=1;
c:=1;
d:=1;
e:=1;
for i:=1 to n do
a:=a*i;
for j:=1 to x do
begin
b:=b*j;
c:=c*p;
end;
for k:=1 to (n-x) do
begin
d:=d*k;
e:=e*(1-p);
end;
writeln(a/(b*d)*c*e:0:4);
end.
0 komentar:
Posting Komentar