Selasa, 01 Desember 2009

program larik

program contoh_larik¬;
uses wincrt;
const max=100;
type larikint = array [1..max] of integer;
var
a : larikint; i : integer;
n : integer; u : real;
akh : char; id : integer;
x : integer; idx : integer;
procedure bacalarik (var a: larikint; n : integer);
var
i : integer;
begin
for i := 1 to n do
begin
write ('masukan nilai a[',i,'] : '); readln (a[i]);
end;
end;
procedure cetaklarik (a : larikint; n : integer);
var
i : integer;
begin
for i := 1 to n do
writeln ('a[',i,'] = ',a[i]);
end;
procedure hitungratata (a : larikint; n : integer; var u : real);
var
i : integer;
jumlah : real;
begin
i := 1;
jumlah := 0;
for i := 1 to n do
jumlah := jumlah + a[i];
u := jumlah/n;
end;
procedure carimaks (a : larikint; n: integer; var id : integer);
var
i : integer;
begin
id := 1;
for i := 2 to n do
if (a[i]) > (a[id]) then
id := i ;
end;
procedure carimin (a : larikint; n : integer; var id : integer);
var
i : integer;
begin
id := 1;
for i := 2 to n do
if (a[i]) < (a[id]) then id := i; end; procedure caritemp (a : larikint; n : integer; x : integer; var idx : integer); var i : integer; begin i := 1; while (i < n ) and (a[i] <> x) do
i := i + 1 ;

if a[i] = x then
idx := i
end;
{program utama}
begin
clrscr;
repeat;
writeln ('CONTOH PROGRAM LARIK (ARRAY)');
writeln (‘created by: andre septian’);
writeln;
begin
writeln (' baca jumlah data (n) ; '); readln (n);
writeln;
writeln ('baca larik');
bacalarik (a,n);
writeln;
writeln ('cetak data');
cetaklarik (a,n);
writeln;
hitungratata (a,n,u);
writeln;
writeln('rata- rata data = ', u:10:6);
carimaks (a,n,id);
writeln;
writeln ('Nilai terbesar : ',a[id]);
x := a[id];
caritemp (a,n,x,idx);
writeln ('bertempat pada larik ke : ',idx);
carimin (a,n,id);
writeln;
writeln ('Nilai terkecil adalah : ',a[id]);
x := a[id];
caritemp (a,n,x,idx);
writeln ('bertempat pada larik ke: ',idx);
end;
writeln;
writeln;
writeln (' ulangi program [y/t] : '); read (akh);
until (akh = 't') ;
end.







Tugas Struktur Data II
20/10/09

Dibuat oleh : Andre Septian
NPM : 08-14-1-0090
Jurusan :Teknik Informatika A

Tidak ada komentar:

Posting Komentar