Program Invers dan Determinan Matriks

program invers_dan_determinan;
uses wincrt;
var matrik,adjoin:array[1..2,1..2] of integer;
det,i,j:integer;
begin for i:=1 to 2 do
begin writeln('masukkan baris ',i,' matrik');
readln(matrik[i,1],matrik[i,2]);
end;
writeln;
writeln;
writeln('bentuk matrik');
for i:=1 to 2 do
begin for j:=1 to 2 do

write(matrik[i,j]:5);
writeln;
end;
writeln;
writeln;
writeln('adjoin matrik');
adjoin[1,1]:=matrik[2,2];
adjoin[1,2]:=-matrik[1,2];
adjoin[2,1]:=-matrik[2,1];
adjoin[2,2]:=matrik[1,1];
begin for i:=1 to 2 do
begin write('|');
for j:=1 to 2 do
begin write(' ',adjoin[i,j],' ');
if j = 2 then write('|');
end;
writeln;
end;
writeln;

det := (matrik[1,1] * matrik[2,2]) - (matrik[1,2] * matrik[2,1]);
writeln; writeln;

writeln('determinan matrik=', det);writeln;
writeln; writeln;
begin
writeln('invers matrik');
begin
for i := 1 to 2 do begin
write('|');
for j := 1 to 2 do begin
write(' ',adjoin[i,j]/det:0:0,' ');
if j = 2 then write('|');
end;
write;
writeln;
writeln;
end;
end;
end;
end;
end.

»»  READMORE...

Program Matriks di Pascal

program matrik_kali;
uses wincrt;
var a,b,c: array[1..10,1..10] of real;
i,j,k,baris1,kolom1,baris2,kolom2:integer;

begin
writeln('ukuran matrik A ');
read(baris1,kolom1);
write('masukan nilai matrik');
for i:=1 to baris1 do
for j:=1 to kolom1 do
read(a[i,j]);

write('ukuran matrik B ');
read(baris2,kolom2);
writeln('masukan nilai matrik');
for i:=1 to baris2 do
for j:=1 to kolom2 do
read(b[i,j]);


if kolom1=baris2 then
for i:=1 to baris1 do
for j:=1 to kolom2 do
begin
c[i,j]:=0;
for k:=1 to kolom1 do
c[i,j]:=c[i,j]+a[i,k]*b[k,j];
end
else
write('ukuran matrix tidak sesuai syarat');

writeln('hasil perkalian');
for i:=1 to baris1 do
begin
for j:=1 to kolom2 do
write(c[i,j]:0:0,' ');
writeln
end;
begin if (baris1=baris2) and (kolom1=kolom2) then
begin
for i:=1 to baris2 do
for j:=1 to kolom2 do
c[i,j]:= a[i,j]+b[i,j]
end
else
writeln('ukuran matrik tidak sama');

writeln('hasil penjumlahan');
for i:=1 to baris1 do
begin
for j:=1 to kolom1 do
write(c[i,j]:0:0,' ');
writeln;
end;
end;
begin if (baris1=baris2) and (kolom1=kolom2) then
begin
for i:=1 to baris2 do
for j:=1 to kolom2 do
c[i,j]:= a[i,j]-b[i,j]
end
else
writeln('ukuran matrik tidak sama');

writeln('hasil pengurangan');
for i:=1 to baris1 do
begin
for j:=1 to kolom1 do
write(c[i,j]:0:0,' ');
writeln;
end; end; end.

»»  READMORE...

Program Pascal Terapan

program kombinasi_faktorial;

uses wincrt;

var

fn,fk,fn_k,Kombinasi:real;

i,n,k:integer;

begin

write('Masukkan bilangan n =');readln(n);

write('Masukkan bilangan k =');readln(k);

fn:=1;

fk:=1;

fn_k:=1;

for i:= 2 to n do{Menghitung n faktorial}

fn:=fn*i;

for i := 2 to k do{Menghitung k faktorial}

fk:=fk*i;

for i:= 2 to (n-k) do{ menghitung n-k faktorial}

fn_k:=fn_k*i;

kombinasi:=fn/(fk*fn_k);

writeln(n,' Kombinasi ',k, ' = ',Kombinasi:0:0);

end.

 

Program Deret_mencari_suku_ke_n;

uses wincrt;

Var

i:integer;

y,jum:real;

begin

clrscr;

jum:=0;

i:=0;

while jum <= 1.9999 do

begin

i:=i+1;

y:=1/exp((i-1)*ln(2));

jum:=Jum+y;

writeln(y:0:4);

end;

writeln('Jumlah deret 1.9999 diperoleh Jika Banyak suku = ',i);

end.

 

Program Menghitung_Koefisien_Persamaan_Regresi;

uses wincrt;

type data=array[1..100]of integer;

var

x,y :data;

N,d,j :Integer;

ratax,ratay :real;

SXY,SX,SX2,SY:real;

A,B :real;

Procedure Regressi;

begin

N:=0;

repeat

write('Nilai data x= ');readln(d);

if d<>0 then begin

N:=N+1;

x[N]:=d;

write('Nilai data y = ');readln(y[N]);

end;

until d=0;

SXY:=0; SX:=0; SX2:=0; SY:=0;

for j:= 1 to N do

begin

SXY:=SXY+x[j]*y[j];

SX:=SX+x[j];

SY:=SY+y[j];

SX2:=SX2+x[j]*x[j];

end;

A:=((SX2-(SX)*SY))/N;

A:=A/(SX2-(SX*SX)/N);

ratay:=SY/N;

ratax:=SX/N;

B:=ratay-A*rataX;

writeln('N= ',N);

writeln('Jumlah x= ',SX:0:2);

writeln('Jumlah y= ',SY:0:2);

writeln('Jumlah x dikali y =',SXY:0:2);

writeln('Jumlah x kwadrat=',SX2:0:2);

writeln('Rata-rata x=',ratax:0:2);

writeln('Rata-rata y=',ratay:0:2);

writeln('Y= ', A:0:2,'X- ', B:0:2);

end;

begin

regressi;

end.

*note:untuk berhenti memasukkan data, masukkan karakter '0' pada data x

 

program mendeteksi_bil_prima;

uses wincrt;

var

bil,i,x :word;

prima :boolean;

batas :integer;

lagi :char;

begin

repeat

clrscr;

write('Masukkan bilangan :');read(bil);

batas:=round(sqrt(bil))+1;

prima:=true;

if (bil=2 ) or (bil=3) then

prima:=true

else

for i:= 2 to batas do

if bil mod i = 0 then

prima:=false;

if prima = true then

writeln(bil,' Adalah prima')

else

writeln(bil,' Bukan prima');

write('Lagi......[Y/T]');lagi:=upcase(readkey);

writeln(lagi);

until lagi <> 'Y';

end.

»»  READMORE...

Program Pascal Terapan dengan Array

Program Menghitung_Banyak_Vokal ;

uses wincrt;

var

nama :string;

i,vok :integer;

BEGIN

clrscr;

vok:=0;

write('Banyak Vokal dalam kalimat berikut =');readln(nama);

for i:=1 to length(nama) do

case nama[i] of

'A','a','U','u','I','i','E','e','O','o':vok:=vok+1;

end;

writeln('Jumlah Vokalnya :',vok);

READLN;

END.

 

program banyak_huruf_dalam_kalimat;

uses wincrt;

var n:array[1..26] of integer;

i,j:integer;

kata : String;

begin

for i:=1 to 26 do n[i]:=0;

write('Ketikkan sebuah kalimat : ');readln(kata);

for i:=1 to length(kata) do

for j:=1 to 26 do

if ord(upcase(kata[i]))=64+j then

inc(n[j]);

for i:=1 to 13 do

writeln(chr(64+2*i-1),' = ',n[2*i-1],' ',chr(64+2*i),' =

',n[2*i]);

end.

 

Program menghitung_sigma_data;

uses wincrt;

var

x:array[1..10] of integer;

i,jum,n : integer;

begin

clrscr;

jum:=0;

write('Masukkan data =');readln(n);

for i:= 1 to n do

begin

write('Data ke-',i ,'=');readln(x[i]);

jum:=jum+x[i];

end;

writeln('Jumlah = ',jum);

end.

 

Program mencari_suku_ke_i_deret_fibonacci;

uses wincrt;

var

x:array[1..100] of integer;

i,n:integer;

lagi:char;

function fibo(n:integer):integer;

begin

if (n = 1) or (n=2) then

fibo:=1

else

fibo:=fibo(n-1)+fibo(n-2);

end;

begin

repeat

write('Suku deret Fibonacci keberapa :');readln(n);

writeln('Suku ke ', n,' =', fibo(n));

write('Lagi ......[Y/T]');lagi:=upcase(readkey);

writeln(lagi);

until lagi <> 'Y';

end.

 

program mencari_mean_data;

uses wincrt;

var

x:array[1..10] of integer;

i,n,jum,njum:integer;

rata:real;

begin

clrscr;

jum:=0;

write('Masukkan banyak data =');readln(n);

for i:= 1 to n do

begin

write('Masukkan data ke-',i, '=');readln(x[i]);

jum:=jum+x[i];

njum:=njum+1;

Rata:=jum/njum;

end;

writeln('Jumlah = ',jum);

writeln('Rata-rata = ',rata:0:2);

end.

 

Program Nilai_Maximum_Minimum;

uses wincrt;

var a : array[1..100] of integer;

b,c : integer; jumlah:longint;

min,max : real;

begin

writeln('Mencari Nilai Maximum dan Minimum');

writeln('=================================');

write('Banyak Data yang akan diinput : ');read(b);

jumlah:=0;

for c:=1 to b do

begin

write('Masukkan data ke-',c,' = ');readln(a[c]);

jumlah:=jumlah+a[c];end;

begin

max:=a[1];

min:=a[1];

for c:=2 to b do

if a[c]>max then max:=a[c]

else if a[c]<min then min:=a[c];{mencari nilai maximum dan

minimum}

writeln('');

writeln('Nilai Minimum = ',min:0:2);

writeln('Nilai Maximum = ',max:0:2);

readln;

end;

end.

»»  READMORE...

Program Pascal Menggunakan Array

Mencari Deret fibonacci dengan Array

1 1 2 3 5 8 ...



program fibonacci;

uses wincrt;

var

i,n: integer;

deret: array[1..100] of integer;

begin

clrscr;

write('banyaknya suku =');

readln(n);

writeln;

for i := 1 to n do

begin

if (i = 1) or (i = 2) then

begin

deret[i]:=1;

write(deret[i],' ');

end

else

begin

deret[i]:=deret[i-2]+deret[i-1];

write(deret[i], ' ');

end;

end;    

end.



Membaca Karakter dari Belakang

program balik_nama;
uses wincrt;
Var
I : word ;
Nama : string [255] ;
Begin
Write ( 'Nama Anda ?' ) ; readln ( Nama ) ;
Writeln ;
Writeln ( 'Nama Anda jika dibaca terbalik adalah : ' );
For I := ord (Nama [0] ) downto 1 do
Write (Nama [I] ) ;
End.


Mencari Deret Segitiga Pascal dengan Array

program deret_segitiga_pascal;
uses wincrt;

var num:array[1..100] of longint;

i,j,n,batas:integer;

begin

writeln('deret segitiga pascal');

write('mencari deret segitiga pascal hingga pangkat ke n=');readln(n);

num[1]:=1;

writeln(1);

for i:=1 to n do

begin

batas:=(i+1) div 2;

if not odd(i) then

num[batas+1]:=num[batas]*2;

for j:=batas downto 2 do

num[j]:=num[j]+num[j-1];

for j:=1 to batas do

write(num[j],' ');

if not odd(i) then write(num[batas+1],' ');

for j:=batas downto 1 do

write(num[j],' ');

writeln;

end;

end.

end;    

end.


Mencari Bilangan Prima hingga bilangan n

Program Bilangan_Prima;

Uses wincrt;

Var

Prima : Array[1..100] of Integer;

i,j,n : Integer;

bil : Integer;

Begin

write ('mencari bilangan prima hingga n =');

readln (n);

ClrScr;

For i := 2 to n Do

Begin

Prima[i]:=i;

For j:= 2 to i-1 Do

Begin

bil := (i mod j);

If bil = 0 then Prima[i]:=0;

End;

If Prima[i]<> 0 Then Write(Prima[i],' ');

End;

End.



Mencari Karakter ke-i

Program mencari_karakter_ke_i;

Uses wincrt;

Var

Nama : string;

i : Integer;

Begin

write ('nama Anda: ');

readln (nama);

For i:= 1 to Length(nama) Do

Writeln('karakter ke-',i,' dari ',Nama,'= ',Nama[i]);

End.

Mencari Banyaknya Karakter

Program Hitung_Huruf;
Uses WinCrt;
Var
Teks : string;
banyak : array['A'..'Z'] of byte;
i : byte;
begin
Write('Masukkan Suatu Kalimat :');
Readln(Teks);
for i:=1 to length(teks) do
banyak[upcase(teks[i])]:=banyak[upcase(teks[i])]+1;
for i:=1 to 26 do
if (banyak[upcase(chr(64+i))]<>0) then
writeln(upcase(chr(64+i)),' banyaknya
=',banyak[upcase(chr(64+i))]);
end.

»»  READMORE...