Program Bobot Nilai (Pascal)

Kudena.blogspot.com-Senen(30/3) , hay anak-anak kuliah yang sedang galau dengan program pascal,ini nih ada contoh tugas pascal larik dalam record Program Nilai Mahasiswa,penasaran ? langsung copas dan perlajari saja kode dibawah ini :

program program_mhs;
uses crt;

const max=10;

type mhsku=record
nim,nama:string;
mk:array[1..max] of string;
sks:array[1..max] of byte;
nilai:array[1..max] of char;
ip:real;
end;
larik=array[1..max] of mhsku;

var mhs:larik;
i,j,m,jumsks,pil:byte;
n:array[1..max] of byte;

function bobot(y:char):byte;
begin
case y of
'A':bobot:=4;'a':bobot:=4;
'B':bobot:=3;'b':bobot:=3;
'C':bobot:=2;'c':bobot:=2;
'D':bobot:=1;'d':bobot:=1;
'E':bobot:=0;'e':bobot:=0;
'0':bobot:=0; end;
end;

procedure isi_data(var x:larik);
var mutu:real; ni,ya:char;
begin
repeat
clrscr;
jumsks:=0;mutu:=0;
writeln('isi identitas mahasiswa');
inc(m);
write('masukkan nim     :   > ');readln(x[m].nim);
write('masukan nama     :  > ');readln(x[m].nama);
write('banyaknya matkul : > ');readln(n[m]);writeln;
for i:=1 to n[m] do
begin
write('mata kuliah ke ',i,' : ');readln(x[m].mk[i]);
write('sks    : ');readln(x[m].sks[i]);
write('nilai  : ');readln(ni);
if (ni<>'A')and(ni<>'a')and(ni<>'B')and(ni<>'b')and
(ni<>'C')and(ni<>'c')and(ni<>'D')and(ni<>'d')and
(ni<>'E')and(ni<>'e') then begin writeln('salah');readln;exit;end else
x[m].nilai[i]:=ni;
jumsks:=jumsks+x[m].sks[i];
mutu:=mutu+ (bobot(x[m].nilai[i])*x[m].sks[i]);
writeln;
end;
x[m].ip:=mutu/jumsks;
write('isi lagi ? > ');readln(ya);
until (ya<>'y') or (m>=max);
end;

procedure cetak_semua(x:larik);
begin
clrscr;
writeln('cetak semua');writeln;
for i:=1 to m do
begin
writeln('data mahasiswa ke ',i);
jumsks:=0;
writeln('nim  = ',x[i].nim);
writeln('nama = ',x[i].nama);writeln;
writeln('-------------------------------------------------');
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
writeln('-------------------------------------------------');
for j:=1 to n[i] do
writeln(j:2,x[i].mk[j]:20,x[i].sks[j]:6,x[i].nilai[j]:6,bobot(x[i].nilai[j])*x[i].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[i].ip:0:2);
writeln;writeln('----------------------------------------');
end;
readln;
end;

procedure cetak_nomor(x:larik);
var no:byte;
begin
clrscr;
jumsks:=0;
writeln('cetak nomor');writeln;
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);writeln;
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do
writeln(j:2,x[no].mk[j]:20,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[no].ip:0:2);
end;
readln;
end;

procedure cetak_nim(x:larik);
var nims:string;pos:byte;ada:boolean;
begin
clrscr;
jumsks:=0;ada:=false;
writeln('cetak nim');writeln;
write('nim > ');readln(nims);
for i:=1 to m do if x[i].nim=nims then begin ada:=true;pos:=i; end;
if not ada then writeln('nim ',nims,' tidak ditemukan') else
begin
writeln('nim  = ',x[pos].nim);
writeln('nama = ',x[pos].nama);writeln;
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[pos] do
writeln(j:2,x[pos].mk[j]:20,x[pos].sks[j]:6,x[pos].nilai[j]:6,bobot(x[pos].nilai[j])*x[pos].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[pos].ip:0:2);
end;
readln;
end;

procedure cetak_data(var x:larik);
var pil1:byte;
begin
repeat
clrscr;
writeln('cetak data');
writeln(' 1. cetak semua');
writeln(' 2. cetak berdasar nomor record');
writeln(' 3. cetak berdasar nim');
writeln(' 4. kembali');
write('pilih > ');readln(pil1);
case pil1 of
1: cetak_semua(x);
2: cetak_nomor(x);
3: cetak_nim(x);
4: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil1=4;
readln;
end;

procedure tampilkan(x:larik);
begin
writeln('no':2,'nim':12,'nama':18);
for i:=1 to m do writeln(i:2,x[i].nim:12,x[i].nama:18);
end;

procedure edit_identitas(var x:larik);
var no,pil2:byte;
begin
clrscr;
writeln('edit identitas');
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('1. nim  =',x[no].nim);
writeln('2. nama =',x[no].nama);
writeln('3. selesai');
write('pilih > ');readln(pil2);
case pil2 of
1: begin write('nim baru  > ');readln(x[no].nim); end;
2: begin write('nama baru > ');readln(x[no].nama); end;
3: writeln('edit selesai');
else writeln('tidak sesuai');
end;
readln;
until pil2=3;
end;
end;

procedure edit_mk(var x:larik);
var no,no2,pil2:byte;
begin
clrscr;
writeln('edit mata kuliah');
write('masukkan nomor record : ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);
writeln('no':2,'mata kuliah':16,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do
writeln(j:2,x[no].mk[j]:16,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln(j+1:2,' selesai');
write('nomor mk : ');readln(no2);
if (no2<1) or (no2>n[no]+1) then writeln('record tidak tersedia') else
if (no2=n[no]+1) then writeln('selesai') else
begin
repeat
clrscr;
writeln('1. matkul  = ',x[no].mk[no2]);
writeln('2. sks     = ',x[no].sks[no2]);
writeln('3. nilai   = ',x[no].nilai[no2]);
writeln('4. selesai');
write('pilih > ');readln(pil2);
case pil2 of
1: begin write('matkul baru : ');readln(x[no].mk[no2]); end;
2: begin write('sks baru    : ');readln(x[no].sks[no2]); end;
3: begin write('nilai baru  : ');readln(x[no].nilai[no2]); end;
4: writeln('edit selesai');
else writeln('tidak sesuai');
end;
readln;
until pil2=4;
end;
readln;
until no2=j+1;
end;
end;

procedure edit_data(var x:larik);
var pil2:byte;
begin
repeat
clrscr;
writeln('edit data');
writeln(' 1. edit identitas');
writeln(' 2. edit mata kuliah');
writeln(' 3. kembali');
write('pilih > ');readln(pil2);
case pil2 of
1: if m=0 then writeln('belum ada data.') else edit_identitas(x);
2: if m=0 then writeln('belum ada data.') else edit_mk(x);
3: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil2=3;
readln;
end;

procedure hapus_mahasiswa(var x:larik);
var no:byte;ya2:char;
begin
clrscr;
jumsks:=0;
writeln('hapus mahasiswa');
tampilkan(x);
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
writeln('nim  =',x[no].nim);
writeln('nama =',x[no].nama);
write('yakin ingin menghapus : ');readln(ya2);
if (ya2='Y')or(ya2='y') then
begin
for i:=no to m-1 do x[i]:=x[i+1];
x[m].nim:='';
x[m].nama:='';
for j:=1 to n[m] do
begin
x[m].mk[j]:='';
x[m].sks[j]:=0;
x[m].nilai[j]:='0';
end;
dec(m);
writeln('penghapusan selesai');
end
else writeln('tidak sesuai');
readln;
end;
end;

procedure hapus_mk(var x:larik);
var no,no2:byte;ya2:char;
begin
clrscr;
writeln('hapus mata kuliah');
tampilkan(x);
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);
writeln('no':2,'mata kuliah':16,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do writeln(j:2,x[no].mk[j]:16,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln(j+1:2,' selesai');
write('nomor mk > ');readln(no2);
if (no2<1) or (no2>n[no]+1) then writeln('record tidak tersedia') else
if (no2=n[no]+1) then writeln('selesai') else
begin
writeln('matkul  =',x[no].mk[no2]);
writeln('sks     =',x[no].sks[no2]);
writeln('nilai   =',x[no].nilai[no2]);
write('yakin ? > ');readln(ya2);
if (ya2='Y')or(ya2='y') then
begin
for i:=no2 to n[no2]-1 do begin x[no].mk[i]:=x[no].mk[i+1];x[no].sks[i]:=x[no].sks[i+1];x[no].nilai[i]:=x[no].nilai[i+1]; end;
x[m].mk[n[no2]]:='';
x[m].sks[n[no2]]:=0;
x[m].nilai[n[no2]]:='0';
dec(n[no2]);
writeln('penghapusan selesai');
end
else writeln('tidak sesuai');
readln;
end;
readln;
until no2=j+1;
end;
readln;
end;

procedure hapus_data(var x:larik);
var pil2:byte;
begin
repeat
clrscr;
writeln('edit data');
writeln(' 1. hapus mahasiswa');
writeln(' 2. hapus mata kuliah');
writeln(' 3. kembali');
write('pilih > ');readln(pil2);
case pil2 of
1: if m=0 then writeln('belum ada data.') else hapus_mahasiswa(x);
2: if m=0 then writeln('belum ada data.') else hapus_mk(x);
3: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil2=3;
readln;
end;

begin
repeat
clrscr;
writeln('pengolahan data mahasiswa');
writeln(' 1. isi data');
writeln(' 2. cetak data');
writeln(' 3. edit data');
writeln(' 4. hapus data');
writeln(' 5. keluar');
write('pilih > ');readln(pil);
case pil of
1: if m>=max then writeln('sudah penuh.') else isi_data(mhs);
2: if m=0 then writeln('belum ada data.') else cetak_data(mhs);
3: if m=0 then writeln('belum ada data.') else edit_data(mhs);
4: if m=0 then writeln('belum ada data.') else hapus_data(mhs);
5: writeln('sampai jumpa.');
else writeln('pilihan salah.');
end;
readln;
until pil=5;
readln;
end.

Program Pascal (Struk Pembayaran)

Kudena.blogspot.com-Minggu(28/3) , oke waktunya program pascal :D , kali ini programnya berkaitan dengan struk pembayaran,ini dia hasil outputnya :

dan ini kode pascalnya gan :

program minggu_3;

uses crt;

const max=10;

const garis='===========================================================';

type rec_struk=record

nomer,tanggal,kasir:string;

nama:array[1..max] of string;

harga,jumlah:array[1..max] of real;

qtt:array[1..max] of byte;

total:real;

end;

type larik=array[1..max] of rec_struk;

var struk:larik; i,n1,n2:byte;

ya:char;

procedure isi_struk(var x:larik);

Begin

repeat

inc(n1);

            writeln(garis);

            writeln('          Beta Mart IST AKPRIND YOGYAKARTA');

            writeln(garis);

            x[n1].total:=0;n2:=0;

            write('Masukan nomer struk  : ');readln(x[n1].nomer);

            write('Masukan Nama Kasir   : ');readln(x[n1].kasir);

            write('Masukan tanggal      : ');readln(x[n1].tanggal);

repeat

begin

clrscr;

inc(n2);

            writeln(garis);

            writeln('          Beta Mart IST AKPRIND YOGYAKARTA');

            writeln(garis);

writeln('jika mau berhenti masukan nama barang = selesai');

write('Masukan nama barang : ');readln(x[n1].nama[n2]);

if x[n1].nama[n2]<>'selesai' then

begin

write('masukan harga barang : Rp.');readln(x[n1].harga[n2]);

write('masukan jumlah barang : ');readln(x[n1].qtt[n2]);

x[n1].jumlah[n2]:=x[n1].harga[n2]*x[n1].qtt[n2];

x[n1].total:=x[n1].total+x[n1].jumlah[n2];

end;end;

until (x[n1].nama[n2]='selesai') or (n2>=max);

dec(n2);

write('Apakah anda ingin hapus data dan isi lagi ? <y/t>');readln(ya);

until (ya<>'y');

end;

procedure cetak_struk(var x:larik);

var bayar,kembali:real; label ulang;

begin

clrscr;

writeln;

writeln(garis);

writeln('            Struk Beta Mart IST AKPRIND YOGYAKARTA '); writeln;

writeln(garis);

writeln;

writeln('Nomer      : ',x[n1].nomer);

writeln('Nama Kasir : ',x[n1].kasir);

writeln('Tanggal    : ',x[n1].tanggal); writeln;

writeln('No          Nama Barang      Harga      Qtt        Jumlah');

writeln(garis);

writeln(garis);

for i:=1 to n2 do

writeln(i:2,'',x[n1].nama[i]:15,'          ',x[n1].harga[i]:8:2,'     ',x[n1].qtt[i]:3,'     ',x[n1].jumlah[i]:8:2);

writeln(garis);

writeln('total belanja = Rp',x[n1].total:10:2);

ulang:

write('bayar         = Rp   ');readln(bayar);

if bayar<x[n1].total then begin writeln('pembayaran kurang,ulangi'); goto ulang; end else

begin kembali:=bayar-x[n1].total;

writeln('kembali       = Rp   ',kembali:8:2);

writeln('terimakasih,selamat berkunjung kembali');

writeln(garis);

end;

end;

begin

isi_struk(struk);

cetak_struk(struk);

readln;

end.

Tugas Aljabar Linier (Bu Naniek Widyastuti)

Kudena.blogspot.com-Minggu(8/3), Sontak kaget mendengar Aljabar linier ada PK (Pekerjaan Kost) dan banyak dari Seonggok Kaum pria tidak mengetahui hal tersebut,yah mungkin karna kurang fokus dan lavarr yang sedang melanda disiang hari,terlebih negara api saat itu sedang menyerah,hoho..
yups langsung saja kesoal dan pembahasannya,cekidoottt .. :

1.Contoh matrik persegi panjang 5 x 3 :

sebelum kesoal admin akan menjelaskan apa itu 5 x 3,jadi angka 5 mewakili barisnya (turun kebawah) dan tiga mewakili Kolom (melebar kesamping). Jadi intinya P x L lah,sampai sini paham ? baiklah,langsung kejawabannya :

Matrik 5x3

2.Diketahui matrik bujursangkar 5 x 5,buatlah :

a. Matrik bujur sangkar, c. Matrik Segitiga atas,

b. Matrik diagonal, d. Matrik segitiga bawah

Sebelum kejawaban,admin akan menjelas kan pengertian dari matrik2 yang akan dibuat. 
Yang pertama adalah matrik bujur sangkar : merupakan suatu matrik yang dimana cacah baris dan cacah kolomnya sama atau konstan,
Yang kedua matrik diagonal : Merupakan matrik bujur sangkar dengan elemen-elemen pada diagonal utamanya bernilai real dan elemen lainnya 0,
Kemudian matrik segitiga atas : merupakan suatu matrik bujursangkar dengan elemen dibawah diagonal utama bernilai 0 dan elemen lainnya bernilai real,
Sedangkan matrik segitiga bawah kebalikan matrik segitiga atas,paham ? lanjut kejawaban :

3.Beri 2 contoh matrik Simetris

Sebelum kejawaban,admin akan menjelaskan pengertiannya,jadi matrik simetris itu adalah suatu matrik yang apabila ditranspose hasilnya konstan (tetap),yang belum tau apa itu transpose kunjungi saja arsip diKudena.blogspot.com,lanjut kejawaban :

       

4. Perhatikan Matrik dibawah ini








 Hitunglah : 

1. A + B(t)
2. B(t) - A
3. B x A
4. A x B "keterangan : (t) adalah transpose"

Jawab : Untuk kasus nomer 1 dan 2 itu tidak bisa diHitung karena Tidak terdefinisi/tidak cocok antara Orde A dan Orde B transpose nya .. 

untuk kasus nomer 3 dan 4 hasilnya berbeda loh kawan kawan,karena didalam perkalian matrik itu A x B tidak sama dengan B x A,diingat2 yah ^^
Bwat jawaban Nomer 3 dan 4 spesial saya kasih caranya ajah,supaya agan2 lebih paham dan mengerti tentang Matrik perkalian,ini dia caranya :

itulah jawaban dari Tugas pertama Aljabar linier..mohon comentarnya/likenya gan !! ^^