Praktikum 7 Array: Variabel Berdimenasi / Jajaran Variabel

1. Program Olah data
Program olahdata;
uses wincrt;
var x:array[1..100] of real; {maksimum 100 data}
n,i,j:integer;
s,m,v,d:real;
begin
writeln('Program Olah Data Sederhana:');writeln;
write('Cacah data: 100 <= ');readln(n);
writeln('Data acak dalam rentang 0 - 100:');
writeln;
{hasilkan data langsung hitung jumlahnya}
s:=0;
randomize;
for i:=1 to n do
begin
x[i]:=random(101);
writeln(' Data ke-',i,': ',x[i]:5:2);
s:=s+x[i];
if i mod 15 = 0 then
begin write('Tekan ENTER ...');readln;end;
end;
m:=s/n; {rata-rata}
v:=0;{hitung varians}
for i:=1 to n do v:=v+sqr((x[i]-m));
v:=v/n;
{urutkan data dari terbesar ke terkecil ...}
for i:=1 to n-1 do
for j:=i+1 to n do
if x[i]<x[j] then {tukar nilai x[i] dan x[j]}
begin
d:=x[i];x[i]:=x[j];x[j]:=d;
end;
{cetak data ...}
writeln;
writeln('Jumlah data = ',s:5:3);
writeln('Rata-rata = ',m:5:3);
writeln('varians = ',v:5:3);
writeln('Simpangan baku = ',sqrt(v):5:3);
writeln;
writeln('Data setelah diurutkan:');writeln;
for i:=1 to n do

begin write(x[i]:8:2); if i mod 8 = 0 then writeln; end;



2. Program Tripel Phytagoras
Program Tripels;
uses wincrt;
var A,B,C : array[1..100] of integer;
n : integer;

p,q,r,i: integer;
begin
writeln('Mencetak daftar Triple Pythagoras ...');
write('Maksimum nilai yang diinginkan, 2<n<182 : ');
readln(n);
i:=1;
for r:=3 to n do
for q:=1 to r-1 do
for p:=1 to q do
if (p<>q) AND (p*p+q*q=r*r) then
begin
A[i]:=p;B[i]:=q;C[i]:=r;
write(A[i]:5,B[i]:5,C[i]:5);
writeln(' Cek:':5,p*p:5,'+':3,q*q:6,'=':3,r*r:7);
inc(i);
if (i mod 21 = 0) then
begin
write('Tekan ENTER untuk melihat lanjutannya ...');
readln;
end;
end;
end.

3. Program Mencetak Segitiga Pascal
Program Pascal3;
uses wincrt;
var P : array[1..25,1..25] of integer;
n : integer;
i,j: integer;
begin
writeln('Mencetak Segitiga Pascal ...');
write('Banyaknya baris yang diinginkan, n<=15 : ');
readln(n);
P[1,1]:=1; writeln(P[1,1]:5);
for i:=2 to n do
begin
P[i,1]:=1;write(P[i,1]:5);
for j:=2 to i do
begin
P[i,j]:=P[i-1,j-1]+P[i-1,j]; write(P[i,j]:5);
end;
writeln;
end;

end.

4. Program Faktor
Program Fakbils;
uses wincrt;

type pembagi= array[1..50] of integer;
var a:integer;
faktor:pembagi;
lagi:char;
p,bf:integer;
label baca;
begin
baca:
clrscr;
Write('Masukkan sebuah bilangan asli > 1 : ');
readln(a); if a<2 then goto baca;
bf:=1;faktor[bf]:=1;
if a>3 then
for p:=2 to round(int(a/2)) do if a mod p = 0 then
begin inc(bf); faktor[bf]:=p; end;
inc(bf);faktor[bf]:=a;
{cetak faktor:}
Writeln('Faktor-faktor dari ',a,' adalah: ');
for p:=1 to bf do writeln(faktor[p]:5);
if bf=2 then writeln('Jelas bahwa ', a,' adalah prima!')
else writeln ('Jelas bahwa ', a,' adalah komposit!');
write('Mau coba lagi? <Y/T>: ');readln(lagi);
if upcase(lagi)='Y' then goto baca;
donewincrt;

end.

5. Program Bujur sangkar ajaib
Program BSA3;
uses wincrt;
var BSA : array[1..15,1..15] of integer;
n,i,j,k,jumlah: integer;
label baca;
begin
baca:
writeln('Bujur Sangkar Ajaib Berukuran Ganjil');
write('Banyaknya baris yang diinginkan, n<=15 : ');
readln(n);
if (n mod 2 = 0) or (n<3) or (n>15) then goto baca;
i:=1;j:=(n+1) div 2;
for k:=1 to n*n do
begin
BSA[i,j]:=k;
if k mod n = 0 then
if i+1>n then i:=1 else inc(i);
if k mod n <>0 then
begin
if i-1<1 then i:=n else dec(i);
if j+1>n then j:=1 else inc(j);
end;
end;
jumlah:=0;

for i:=1 to n do
begin
jumlah:=jumlah+BSA[i,i];
for j:=1 to n do write(BSA[i,j]:5);
writeln;
end;
writeln('Jumlah baris/kolom/diagonal = ',jumlah);

end.

6. Program Fibbonaci
Program Fibonaci;
uses wincrt;
var F : array[1..100] of integer;
n,i: integer;
label baca;
begin
baca:
writeln('Barisan Bilangan Fibonacci');
write('Banyaknya suku barisan, n<=23 : ');
readln(n);
if (n<3) or (n>23) then goto baca;
F[1]:=1;F[2]:=1;
for i:=3 to n do F[i]:=F[i-1]+F[i-2];
for i:=1 to n do
begin
write(F[i]:6);
if i mod 10 = 0 then writeln;
end;

end.