Program Temuan...^_^

heheheh, dari judulnya pasti bikin ketawa...
program ini nih,aku temuin di email statistika 2011....,
dan aku coba,,,,
eh, ternyata......

Program Nilai Max

program nilaimax;
uses wincrt;
var i,n,s,x: integer;

begin
write ('masukkan sejumlah data:');
readln(n);
for i:=1 to n do
   begin
   write('data ',i,'=');
   readln(x);
   if i=1 then s:=x
   else
      if x>s then s:=x
   end;
writeln('nilai maximum:',s);
end.

Program Aritmatik

program aritmatik;
uses wincrt;
var x: real;
begin
clrscr;
write('Masukkan nilai dari x = ');
readln(x);
if x<0 then x:=abs(x);
writeln('nilai x = ',x:5:2);
writeln('nilai eksponensialnya = ',exp(x):9:3);
writeln('nilai logaritma naturalnya = ',ln(x):9:3);
writeln('nilai integernya = ',int(x):9:3);
writeln('nilai fraksionalnya = ',frac(x):9:3);
writeln('nilai x dipangkatkan = ',sqr(x):9:3);
writeln('nilai x diakarkan = ',sqrt(x):9:3);
write('nilai x jika dimasukkan dalam ');
writeln('fungsi sin,cos,dan tangen: ');
writeln('- sinus = ',sin(x):9:3);
writeln('- cosinus = ',cos(x):9:3);
writeln('- tangen = ',arctan(x):9:3);
end.

Program Looping

program looping;
uses wincrt;
var  i,j: integer;
begin
   for i:= 1 to 5 do
   begin
   writeln(' ');
   for j:= 1 to 4 do

   begin
   write('   ',i+j,'-',j,'=',i-j:2);
   end;
   writeln;
   end;
   end.

=============================================================

Program Asistensi

ini nih program yang aku dapat saat asistensi menjelang ETS. bersama kak siapa ya? aku lupa... hehehe...

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 Invers

MENCARI INVERS MATRIKS
MENGUNAKAN PASCAL
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 Feedback

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.

Program XXX

program seling;
uses wincrt;
var i,j,n:integer;
a:string;        
begin
write ('banyak baris ');
readln (n);
for i:=1 to n do
begin
for j:=1 to i do
begin
if (j mod 2)=1 then
a:='*' else a:='1';
write(a,' ');
end;
writeln;end; end.


program bintang turun;
uses wincrt;
var i,n,j:integer;
begin readln (n);
for i:=1 to n do
begin for j:=1 to n do
begin if (j<i) then
write (' ') else
write ('*');
end;
writeln;
end;
end.


program angka;
uses wincrt;
var i,j,n,a:integer;
       
begin
write ('banyak suku ');
readln (n); a:=0;
for i:=1 to (n div 4)+1  do
begin
for j:=1 to 4 do
begin
a:=a+1;
if a<=n then
write (a,' ') else write(' ');
end;
writeln;
end;
 end.

Program Matriks

program matrik_penjumlahan;
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 Modus

program modusss;
uses wincrt;
var i,n,j,modus:integer;
A,frek:array[1..100] of integer;
begin
write('masukkan banyak bilangan');
readln(n);
writeln('masukan data');
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
if frek[modus]<frek[i] then
modus:=i;
end;
write('Modus: ',A[modus],' sejumlah ',frek[modus]+1);
end.

Program Mean,Var,StDv

program rata2_var_stdev;

uses wincrt;

var i,j,n,a:integer;

k,rata,varian,stdev:real;

begin

writeln('masukkan jumlah data',' ');

i:=1;

readln(n);

while i<=n do begin

write('data ke-',i,'= ');

readln(a);

inc(i);

j:=j+a;

k:=k+sqr(a);

end;

rata:=j/n;

varian:= (k-n*sqr(rata))/(n-1);

stdev:=sqrt((k-n*sqr(rata))/(n-1));

writeln('nilai rata-ratanya adalah = ',rata:2:3);

writeln('nilai variannya adalah = ',varian:2:3);

write('nilai standar deviasinya adalah = ',stdev:2:3);

end.

Program Yes No Question

program Mean_YesNoQuestion;
uses wincrt;
var
   r,n:byte;
   sum,mean: real;
   x : array[1..100] of real;
   leave: char;
begin
     leave:= 'N';
     while leave='N' do
begin
     write ('jumlah data yang riskha masukkan = '); readln (n);
     writeln;
     sum:=0;
     for r:=1 to n do
begin
     write('nilai data ke- ',r,' ','=','  '); readln (x[r]);
     sum:= sum+ x[r];
     end;
     mean:=sum/n;
     writeln;
     writeln ('jumlah data yang telah riskha masukkan adalah  ',n);
     writeln;
     writeln ('sum nilai data adalah ',sum:6:2);
     writeln;
     writeln ('mean nilai data adalah  ',mean:6:2);
     writeln;
     writeln ('do you want to leave this program? (Y/N) ? ');
     readln(leave);
     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 Bintang

program pola;
uses wincrt;
var
i,n,j:integer;
a:string;
begin
write ('buat pola hingga baris ke_');
readln(n);
writeln ;
for i:=1 to n do
begin
for j:=1 to i do
begin
if (j mod 2)=1 then
a:='*' else a:='1';
write(a, ' ');
end;
writeln;
end;
end.

Program Faktorial

program faktorial;uses wincrt;var i,n,f :integer;beginreadln (n); f:=1; i:=0;repeati:= i+1;f:=f*i;until i=n;writeln (n, 'faktorial= ',f);end.

program faktorial;

uses wincrt;

var i,n,f :integer;

begin

readln (n); f:=1; i:=0;

for i:=1 to n do

begin

f:=f*i;

writeln (n, 'faktorial= ',f);

end;

end.

program faktorial;

uses wincrt;

var i,n,f :integer;

begin

readln (n); f:=1;

while i<n do

begin

i:= i+1;

f:=f*i;

writeln (n, 'faktorial= ',f);

end;

end.

Program Else If

program mencari_nilai_mata_kuliah;

uses wincrt;

var  a:integer;

begin

  readln (a);

  if ((80<a) and (a<100)) then writeln ('a=A')

  else if a>=76 then writeln ('a=AB')

  else if a>=71 then writeln ('a=B')

  else if a>=66 then writeln ('a=BC')

  else if a>=61 then writeln ('a=C')

  else if a>=41 then writeln ('a=D')

  else writeln('a=E');

end.

Program Eksponen

program expo;

uses wincrt;

var i,n :integer;

e,f : real;

begin

e:=1; i:=0; n:=10; f:=1;

repeat

i:=i+1;

f:=f*i;

e:=e+1/f;

until i=n;

writeln ('e= ',e:11:4);

end.

Program Rata-rata

program rata_rata;

uses wincrt;

var n,i :integer;

    sum, mean, x:real;

begin

writeln ('banyaknya data= '); readln (n);

for i:= 1 to n do

begin

     writeln('data ke',i,'=');

     readln (x);

     sum:= sum+x;

     end;

mean:= sum/n;

     writeln ('rata-rata= ', mean:9:4);

     end.

program rata_rata;

uses wincrt;

var n,i :integer;

    sum, mean, x:real;

begin

writeln ('banyaknya data= '); readln (n);

repeat

i:= i +1;

     writeln('data ke',i,'=');

     readln (x);

     sum:= sum+x;

     until i=n;

     mean:= sum/n;

     writeln ('rata-rata= ', mean:9:4);

     end.

Program Faktorial

program faktorial;

uses wincrt;

var i,n,f :integer;

begin

readln (n); f:=1; i:=0;

repeat

i:= i+1;

f:=f*i;

until i=n;

writeln (n, 'faktorial= ',f);

end.

program faktorial;

uses wincrt;

var i,n,f :integer;

begin

readln (n); f:=1; i:=0;

for i:=1 to n do

begin

f:=f*i;

writeln (n, 'faktorial= ',f);

end;

end.

program faktorial;

uses wincrt;

var i,n,f :integer;

begin

readln (n); f:=1;

while i<n do

begin

i:= i+1;

f:=f*i;

writeln (n, 'faktorial= ',f);

end;

end.

Program Deret Part II

program pascal;

uses wincrt;

var   a,i:longint;

begin

     for i:=1 to 10 do

     begin

          write (i)

          end;

end.

program pascal;

uses wincrt;

var   a,i:longint;

begin

    i:=1;

     repeat

     write (i);

     i:=i+1

     until i=11;

end.