selamat datang di blogku... silakan dibaca... di comment... dan jangan lupa be my blog followers yah?...

Program PIK

PROGRAM INVERS

Program invers;
uses wincrt;
label  hitung;
var
    mat,adj : array [1..5,1..5] of integer;
    det,i,j : integer;
    c:char;

begin

  clrscr;
         { tampilan awal keterangan matrik }
  gotoxy(20,4);
  writeln('Matriks Ordo 2 x 2');

  gotoxy(15,5);
  writeln('-------------------------');

  gotoxy(15,7);
  writeln('1. Input data matrik ');

  gotoxy(15,8);
  writeln('2. Menentukan Adjoin Matrik');

  gotoxy(15,9);
  writeln('3. Mencari determinan matriks');

  gotoxy(15,10);
  writeln('4. Mencari Invers matriks');
  readln;

   if c = #13 then goto hitung;

           {end tampilan awal keterangan matrik}

           {mulai proses input}
hitung:
      begin
        clrscr;
        writeln('Input Matrik Ordo 2x2');
        writeln('-------------------------');
        for i := 1 to 2 do begin
           for j:= 1 to 2 do begin
               write('matrik ke ',i,' ',j,': ');readln(mat[i,j]);
           end;
           writeln;
        end;

        for i := 1 to 2 do begin
         write('|');
          for j := 1 to 2 do begin
            write(' ',mat[i,j],' ');
              if j = 2 then write ('|');
          end;
          writeln;
        end;
                 {end proses input matrik}

        writeln;
        writeln;
                 {mulai adjoin matrik dan determinan}

        writeln('Adjoin matrik Ordo 2x2');
        writeln('-----------------------');

        adj[1,1] := mat[2,2];
        adj[1,2] := mat[1,2] * -1;
        adj[2,1] := mat[2,1] * -1;
        adj[2,2] := mat[1,1];

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

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

        write('Determinan dari matrik diatas adalah ');
        writeln(det);
        writeln;
                  {end of adjoin and determinan}

                  {mulai menghitung invers matrik}

        writeln('Invers Matrik ');
        writeln('----------------');
        writeln;

        for i := 1 to 2 do begin
         write('|');
          for j := 1 to 2 do begin
            write(' ',adj[i,j]/det:3:2,' ');
              if j = 2 then write('|');
          end;
          writeln;writeln;writeln;
       end;
                    {end of hitung invers matrik}

       end;
readln;
end.
--------------------------------------------------------------------------------------------------------------------------------
PROGRAM STATISTIKA DESKRIPTIF

program modus;
uses wincrt;
var i,n,j,modus:integer;
A,frek:array[1..100] of integer;
begin
readln(n);
for i:=1 to n do
readln(A[i]);
writeln;
for i:=1 to n-1 do
begin
for j:=i+1 to n do
if A[i]=A[j] then
frek[i]:=frek[i]+1;
end;
modus:=1;
for i:=1 to n do
begin
write(frek[i],' ');
if frek[modus]<frek[i] then
modus:=i;
end;
write('modus: ',A[modus],' sebanyak ',frek[modus]+1);
end.


program atatistika_deskriptif;
uses wincrt;
var n,i,j,tengah:integer;
a:real;
data:array [0..100] of real;

begin
writeln('SELAMAT DATANG DI PROGRAM STATISTIKA DESKRIPTIF');WRITELN('***=============================***');writeln;
writeln('Berapa jumlah data yang ingin anda dimasukan? (max 100)');
write('silahkan masukan data:');
READLN(N); WRITELN;
{syntax untuk memasukkan data dalam array}
for i:=1 to n do
begin
write('data ke-',i,' = ');
readln(a);
data[i]:=a;
end;
{syntax untuk mengurutkan data pada array}
for i:=1 to n do
for j:=i+1 to n do
begin
if data[i]>data[j] then
begin
data[0]:=data[j];
data[j]:=data[i];
data[i]:=data[0];
end;
end;
for i:=1 to n do begin
writeln(data[i]:0:2);
end;
writeln('min =',data[1]:0:2);
writeln('maks=',data[n]:0:2);
if n mod 2 = 1 then
begin
tengah:=(n+1) div 2;
end
else
begin
tengah:=(n div 2);
end;
if n mod 2 = 1 then writeln('=> nilai median = ',data[tengah]:0:2)
else
writeln('=> nilai median = ',(data[tengah]+data[tengah+1])/2:0:2);
if n mod 2 = 1 then
begin
tengah:=(n+1) div 2;
end;
end.
-------------------------------------------------------------------------------------------------------------------------------
 PROGRAM PENJUMLAHAN

program penjumlahan;
uses wincrt;
var i,a,n,hasil,f:integer;

begin
writeln('masukkan angka');readln(n);

a:=n;
for i:=n downto 2 do
begin

hasil:=n*n;
write ((n-1)+a,'+');
a:=a-2;

 end;
 begin

   if n<0 then write ('')
  else if(n<=1) then write ('1')
else write(1,'=',hasil);
end;
end.
-------------------------------------------------------------------------------------------------------------
PROGRAM STATISTIKA



Program 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.




uses wincrt;
type a=record
             no:array[1..10] of integer;
             nama:array[1..10] of string;
             sks:array[1..10] of integer;
             nilai:array[1..10] of string;
             angka:array[1..10] of real;
             SNA:array[1..10] of real;
             end;
var b:a;
    n,i:integer;
    c,d,e:real;

procedure jmlsks(jml:integer;var sumsks:real;aaaa:a);
 var j:integer;
     begin sumsks:=0;
       for j:=1 to jml do
           sumsks:=sumsks+aaaa.sks[j];
     end;
procedure jmlSNA(jml:integer;var sumSNA:real;aaaa:a);
           var j:integer;
           begin sumSNA:=0;
                 for j:=1 to jml do
                     sumSNA:=sumSNA+aaaa.SNA[j];
           end;
begin write('jumlah mata kuliah = ');
         readln(n);
for i:=1 to n do
    begin
    clrscr;
         writeln('*masukkan data mata kuliah ke ',i,' *');
         writeln;
         b.no[i]:=i;
         write('nama matkul                       = ');
                    readln(b.nama[i]);
         write('jumlah sks                        = ');
                    readln(b.sks[i]);
         write('nilai huruf (A/AB/B/BC/C/D/E)     = ');
                    readln(b.nilai[i]);
                    if b.nilai[i]='A'  then b.angka[i]:=4 else
                    if b.nilai[i]='AB' then b.angka[i]:=3.5 else
                    if b.nilai[i]='B'  then b.angka[i]:=3 else
                    if b.nilai[i]='BC' then b.angka[i]:=2.5 else
                    if b.nilai[i]='C'  then b.angka[i]:=2 else
                    if b.nilai[i]='D'  then b.angka[i]:=1 else
                    b.angka[i]:=0;
         b.SNA[i]:=b.sks[i]*b.angka[i];
         writeln;
         writeln;
    end;
writeln('========================================================================');
writeln('no  nama mata kuliah        sks     nilai huruf     nilai angka     SNA');
writeln('========================================================================');
for i:=1 to n do
writeln(b.no[i]:2,b.nama[i]:18,'      ',b.sks[i]:4,'      ',b.nilai[i]:7,'     ',b.angka[i]:8:1,'     ',b.SNA[i]:8:1);

writeln('========================================================================');
jmlsks(n,c,b);
jmlSNA(n,d,b);
e:=d/c;
writeln('       JUMLAH                ',c:0:0,'                                    ',d:3:1);
writeln;
writeln('Total SKS semester ini = ',c:3:2);
writeln('Total SNA semester ini = ',d:3:2);              
writeln('Nilai IPS              = ',e:3:2);
end.









program min_max;
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 urutangka;
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 modus;
uses wincrt;
var i,n,j,modus:integer;
A,frek:array[1..100] of integer;
begin
readln(n);
for i:=1 to n do
readln(A[i]);
writeln;
for i:=1 to n-1 do
begin
for j:=i+1 to n do
if A[i]=A[j] then
frek[i]:=frek[i]+1;
end;
modus:=1;
for i:=1 to n do
begin
write(frek[i],' ');
if frek[modus]<frek[i] then
modus:=i;
end;
write('modus: ',A[modus],' sebanyak ',frek[modus]+1);
end.




program atatistika_deskriptif;
uses wincrt;
var n,i,j,tengah:integer;
a:real;
data:array [0..100] of real;

begin
writeln('SELAMAT DATANG DI PROGRAM STATISTIKA DESKRIPTIF');WRITELN('***=============================***');writeln;
writeln('Berapa jumlah data yang ingin anda dimasukan? (max 100)');
write('silahkan masukan data:');
READLN(N); WRITELN;
{syntax untuk memasukkan data dalam array}
for i:=1 to n do
begin
write('data ke-',i,' = ');
readln(a);
data[i]:=a;
end;
{syntax untuk mengurutkan data pada array}
for i:=1 to n do
for j:=i+1 to n do
begin
if data[i]>data[j] then
begin
data[0]:=data[j];
data[j]:=data[i];
data[i]:=data[0];
end;
end;
for i:=1 to n do begin
writeln(data[i]:0:2);
end;
writeln('min =',data[1]:0:2);
writeln('maks=',data[n]:0:2);
if n mod 2 = 1 then
begin
tengah:=(n+1) div 2;
end
else
begin
tengah:=(n div 2);
end;
if n mod 2 = 1 then writeln('=> nilai median = ',data[tengah]:0:2)
else
writeln('=> nilai median = ',(data[tengah]+data[tengah+1])/2:0:2);
if n mod 2 = 1 then
begin
tengah:=(n+1) div 2;
end;
end.
-------------------------------------------------------------------------------------------------------------
PROGRAM KUADRAT


program kuadratplus;
uses wincrt;
var i,n:integer;
begin
   read(n);
   if n=1 then write (1);
   if n>1 then
   begin
   for i:=n downto 2 do
   write (2*i-1,'+');
   write(1,'=');
   write (sqr(n));
   end;
   end.

 program y_urut;
uses wincrt;
var i,n,j:integer;
begin
read(n);
for i:=1 to n do
begin
for j:= 1 to i do
write (i);
writeln;
end;
end.

 program y_1234;
uses wincrt;
var i,j,n:integer;
begin
read(n);
for i:=1 to n do
begin
for j:= 1 to i do
write (j);
writeln;
end;
end.


program urut;
uses wincrt;
var i,n,j,x:integer;
begin
  read(n);
  x:=1 ;
  for i:= 1 to n do
  begin
  for j:=1to i do
  begin
  write (x);
  inc(x);
  end;
  writeln;
end;
end.

program urut_rata;
uses wincrt;
var i,n,j,x:integer;
begin
  read(n);
  x:=1 ;
  for i:= 1 to n do
  begin
  for j:=1to i do
  begin
  write (x:2,' ');
  inc(x);
  end;
  writeln;
end;
end.

program binomial;
uses wincrt;
var i,n,k,x:integer;
p,cdf:real;
function f(z:integer):real;
begin
k:=1;
for i:=1 to z do
k:=k*i;
f:=k;
end;
function c(y:integer):real;
begin
c:=f(n)/(f(n-y)*f(y));
end;
begin
readln(p,n,x);
cdf:=0;
for i:=0 to x do
cdf:=cdf+c(i)*exp(i*ln(p))*exp((n-1)*ln(1-p));
write(cdf:0:2);

end.
Powered By Blogger
 
Free Tail- Heart 1 Cursors at www.totallyfreecursors.com