program tugas_alpro2;
uses wincrt;
const garis='------------------------------------------';
type id_mahasiswa = record
     nim,nama: string;
     tugas,uts,uas,skor:real;
     end;
type larik = array [1..10] of id_mahasiswa;
var
   mhs:larik;
   i,n:integer;
   temp_mean:real;
procedure urut_tampil(n :integer; var mhs1:larik);
var
   i,j,k:integer;
   temp1:real;
   temp2,temp3:string;
   temp4,temp5,temp6:real;
   ketemu:boolean;
begin
     for i := 2 to n do
     begin
         temp1:= mhs1[i].skor;
         temp2:= mhs1[i].nim;
         temp3:= mhs1[i].nama;
         temp4:= mhs1[i].tugas;
         temp5:= mhs1[i].uts;
         temp6:= mhs1[i].uas;
         j := i-1;
         ketemu:=false;
         while (j>=1) and (not ketemu) do
         begin
               if temp1 < mhs1[j].skor then
                  begin
                       mhs1[j+1].skor:= mhs1[j].skor;
                       mhs1[j+1].nim:=mhs1[j].nim;
                       mhs1[j+1].nama:=mhs1[j].nama;
                       mhs1[j+1].tugas:=mhs1[j].tugas;
                       mhs1[j+1].uts:=mhs1[j].uts;
                       mhs1[j+1].uas:=mhs1[j].uas;
                       j:= j-1;
                  end
                  else
                  begin
                  ketemu:=true;
                  end;
         end;
             mhs1[j+1].skor :=temp1;
             mhs1[j+1].nim:=temp2;
             mhs1[j+1].nama:=temp3;
             mhs1[j+1].tugas:=temp4;
             mhs1[j+1].uts:=temp5;
             mhs1[j+1].uas:=temp6;
         end;
         begin
         writeln(garis);
         writeln('no !  nim ! nama ! tugas ! uts ! uas ! skor');
         writeln(garis);
         for i:= 1 to n do
         begin
         write(i,' !  ',mhs1[i].nim,' !  ',mhs1[i].nama,' !  ',mhs1[i].tugas:0:2);
         write('   ! ',mhs1[i].uts:0:2,' !  ',mhs1[i].uas:0:2,' !  ',mhs1[i].skor:0:2);
         writeln;
         writeln(garis);
         end;
         end;
end;
procedure min_max(n:integer;var mhs1:larik);
var
   temp_min,temp_max:real;
   min,max:real;
begin
     temp_min:=mhs1[1].skor;
     temp_max:=mhs1[1].skor;
     for i:= 1 to n do
         begin
           if temp_min <= mhs1[i].skor then
           min:=temp_min
           else
           min:=mhs1[i].skor;
           if temp_max >=  mhs1[i].skor then
           max:=temp_max
           else
           max:=mhs1[i].skor;
         end;
     writeln('nilai min:',min:0:2);
     writeln('nilai max:',max:0:2);
end;
procedure mean_sd(n:integer;mhs1:larik);
var
   temp1,jum1,jum,jum2,kuadrat,mean,pembagi,varian,sd:real;
   varian0,sd0:string;
begin
     temp1:=0;
     jum1:=0;
     jum:=0;
     for i := 1 to n do
     begin
          kuadrat:=sqr(mhs1[i].skor);
          jum1:=jum1+kuadrat;
          jum:=jum+mhs1[i].skor;
     end;
     jum2:=sqr(jum);
     mean:=jum/n;
     if n >=1 then
     begin
     pembagi:=n*(n-1);
     varian:= (jum1-jum2)/pembagi;
              if varian >= 0 then
              sd:=sqrt(varian) else
              sd0:='standar deviasi tidak dapat dihitung';
     end
     else
     varian0:='pembagi = 0,, perhitungan varian dihentikan';
     writeln('mean=',mean:0:2);
     if varian >= 0 then
     writeln('standar deviasi=',sd:0:2)
     else
     writeln(sd0);
     if n >=1 then
     writeln('varian=',varian:0:2) else
     writeln(varian0);
end;
function hitung(mhs:larik):real;
var
   temp:real;
begin
     temp:= (mhs[i].tugas+2*mhs[i].uts+3*mhs[i].uas)/6;
     hitung:=temp;
end;
begin
     write('masukkan banyak data:');readln(n);
     for i := 1 to n do
         begin
              write('nim:');readln(mhs[i].nim);
              write('nama:');readln(mhs[i].nama);
              write('tugas:');readln(mhs[i].tugas);
              write('uts :');readln(mhs[i].uts);
              write('uas :');readln(mhs[i].uas);
              mhs[i].skor:= hitung(mhs);
         end;
     urut_tampil(n,mhs);
     min_max(n,mhs);
     mean_sd(n,mhs);
     readln;
     donewincrt;
end.
skip to main  |
      skip to sidebar
 
--
My Clock
Link Situ Kesukaan
Archives
About Me
Followers
Pengunjung Online
Shoutmix
Trafik
-
-
Editing by uliantony.co.cc




1 komentar: tugas_Ap2
August 26, 2009 at 5:13 AM
test..
Post a Comment