Berikut ini adalah aplikasi program Himpunan matematik yang ditulis dalam bahasa Pascal:
program himpunanBiasa;
uses crt;
var
himpA,himpB,himpTempA,himpTempB: array[1..20] of integer;
i,pil, nHimpA, nHimpB :integer;
procedure tulisHimp;
begin
writeln;
write('Himpunan A = {');
for i:=1 to nHimpA do
begin
if(i=nHimpA) then
write(' ',himpA[i])
else
write(' ',himpA[i],',');
end;
write('}');
writeln;
write('Himpunan B = {');
for i:=1 to nHimpB do
begin
if(i=nHimpB) then
write(' ',himpB[i])
else
write(' ',himpB[i],',');
end;
write('}');
end;
procedure gabungan;
var
i,j:integer;
begin
writeln('Operasi Gabungan');
writeln('================');
tulisHimp;
writeln;
writeln;
write('A U B = {');
for i:=1 to nHimpA do
write(' ',himpA[i],',');
for i:=1 to nHimpB do
begin
for j:=1 to nHimpA do
begin
if (himpB[i]=himpA[j]) then
break
else if (himpB[i]<>himpA[j]) and (j= nHimpA) then
begin
if(i=nHimpA) then
write(' ',himpB[i])
else
write(' ',himpB[i],',');
break;
end;
end;
end;
write('}');
end;
procedure irisan;
var
nHimpTemp1, nHimpTemp2: integer;
himpTemp1, himpTemp2: array [1..20] of integer;
i,j: integer;
begin
writeln('Operasi Irisan');
writeln('==============');
tulisHimp;
writeln;
writeln;
if (nHimpA > nHimpB) then
begin
write('A n B = {');
for i:=1 to nHimpA do
begin
for j:=1 to nHimpB do
begin
if (himpA[i]=himpB[j]) then
begin
if(i=nHimpA) then
write(' ',himpA[i])
else
write(' ',himpA[i],',');
end;
end;
end;
write('}');
end
else if(nHimpA < nHimpB) then
begin
writeln('A n B = {');
for i:=1 to nHimpB do
begin
for j:=1 to nHimpA do
begin
if (himpA[j]=himpB[i]) then
begin
if(i=nHimpB)then
write(' ',himpB[i])
else
write(' ',himpB[i],',');
end;
end;
end;
write('}');
end
else if(nHimpA = nHimpB) then
begin
writeln('A n B = {');
for i:=1 to nHimpA do
begin
for j:=1 to nHimpA do
begin
if(himpA[i]=himpB[j])then
begin
if(i=nHimpA)then
write(' ',himpA[i])
else
write(' ',himpA[i],',');
end;
end;
end;
write('}');
end;
end;
procedure selisih;
var
i,j:integer;
begin
writeln('Operasi Selisih');
writeln('===============');
tulisHimp;
writeln;
writeln;
write('A - B = {');
for i:=1 to nHimpA do
begin
for j:=1 to nHimpB do
begin
if (himpA[i]=himpB[j]) then
break
else if (himpA[i] <> himpB[j]) and (j= nHimpB) then
begin
if(i=nHimpA)then
write(' ',himpA[i])
else
write(' ',himpA[i],',');
break;
end;
end;
end;
write('}');
end;
procedure komplemen;
var
i,j:integer;
begin
writeln('Operasi Komplemen');
writeln('=================');
tulisHimp;
writeln;
writeln;
write('Komplemen A = {');
for i:=1 to nHimpB do
begin
for j:=1 to nHimpA do
begin
if(himpB[i]=himpA[j]) then
break
else if (himpB[i]<>himpA[j]) and (j= nHimpA) then
begin
if(i=nHimpB)then
write(' ',himpB[i])
else
write(' ',himpB[i],',');
break;
end;
end;
end;
write('}');
writeln;
write('Komplemen B = {');
for i:=1 to nHimpA do
begin
for j:=1 to nHimpB do
begin
if (himpA[i]=himpB[j]) then
break
else if (himpA[i]<>himpB[j]) and (j= nHimpB) then
begin
if(i=nHimpA)then
write(' ',himpA[i])
else
write(' ',himpA[i],',');
break;
end;
end;
end;
write('}');
end;
procedure selSimetri;
var
i,j: integer;
begin
writeln('Operasi Selisih Simetri');
writeln('=======================');
tulisHimp;
writeln;
writeln;
write('A (+) B = {');
for i:=1 to nHimpA do
begin
for j:=1 to nHimpB do
begin
if (himpA[i]=himpB[j]) then
break
else if (himpA[i]<>himpB[j]) and (j= nHimpB) then
begin
write(' ',himpA[i],',');
break;
end;
end;
end;
for i:=1 to nHimpB do
begin
for j:=1 to nHimpA do
begin
if(himpB[i]=himpA[j]) then
break
else if (himpB[i]<>himpA[j]) and (j= nHimpA) then
begin
if(i=nHimpB) then
write(' ',himpB[i])
else
write(' ',himpB[i],',');
break;
end;
end;
end;
write('}');
end;
procedure inEksklusi;
var
i,j, nHimpTempIn, nHimpTempEks:integer;
begin
nHimpTempIn:=nHimpA;
nHimpTempEks:=0;
writeln('Operasi Inklusi-Eksklusi');
writeln('========================');
tulisHimp;
writeln;
writeln;
for i:=1 to nHimpB do
begin
for j:=1 to nHimpA do
begin
if (himpB[i]=himpA[j]) then
break
else if(himpB[i]<>himpA[j]) and (j= nHimpA) then
begin
nHimpTempIn:=nHimpTempIn+1;
break;
end;
end;
end;
for i:=1 to nHimpA do
begin
for j:=1 to nHimpB do
begin
if (himpA[i]=himpB[j]) then
break
else if(himpA[i]<>himpB[j]) and (j= nHimpB) then
begin
nHimpTempEks:= nHimpTempEks+1;
break;
end;
end;
end;
for i:=1 to nHimpB do
begin
for j:=1 to nHimpA do
begin
if(himpB[i]=himpA[j]) then
break
else if(himpB[i]<>himpA[j]) and (j= nHimpA) then
begin
nHimpTempEks:= nHimpTempEks+1;
break;
end;
end;
end;
writeln('n( A U B ) = ',nHimpTempIn);
writeln('n( A (+) B ) = ',nHimpTempEks);
end;
procedure subset;
var
i,j,nilaiSubset,temp:integer;
begin
nilaiSubset:=1;
writeln('Cek Subset');
writeln('==========');
tulishimp;
writeln;
writeln;
for i:=1 to nHimpA+1 do
begin
if(temp=nHimpB)then
begin
nilaiSubset:=0;
break;
end;
if(i>nHimpA)then
break;
temp:=0;
for j:=1 to nHimpB do
begin
if (himpA[i]<>himpB[j]) then
begin
temp:=temp+1;
end;
end;
end;
if(nilaiSubset=1)then
writeln('A subset B')
else
writeln('A BUKAN subset B');
nilaiSubset:=1;
for i:=1 to nHimpB do
begin
if(temp=nHimpA)then
begin
nilaiSubset:=0;
break;
end;
if(i>nHimpB)then
break;
temp:=0;
for j:=1 to nHimpA do
begin
if (himpB[i]<>himpA[j]) then
temp:=temp+1;
end;
end;
if(nilaiSubset=1)then
writeln('B subset A')
else
writeln('B BUKAN subset A');
end;
procedure cekAnggota;
var
newAnggota: integer;
i,temp:integer;
begin
temp:=0;
writeln('Cek Keanggotaan');
writeln('===============');
tulisHimp;
writeln;
writeln;
write('Inputkan Anggota : ');readln(newAnggota);
writeln;
for i:=1 to nHimpA do
begin
if (newAnggota = himpA[i]) then
begin
temp:=1;
end;
end;
if(temp=1)then
writeln(newAnggota,' adalah ANGGOTA himpunan A')
else if(temp=0) then
writeln(newAnggota,' BUKAN anggota himpunan A');
temp:=0;
for i:=1 to nHimpB do
begin
if (newAnggota = himpB[i]) then
begin
temp:=1;
end
end;
if(temp=1)then
writeln(newAnggota,' adalah ANGGOTA himpunan A')
else if(temp=0)then
writeln(newAnggota,' BUKAN anggota himpunan A');
end;
procedure ubahHimp;
var
i,j,nHimpTempA,nHimpTempB:integer;
begin
clrscr;
himpTempA:=himpA;
himpTempB:=himpB;
nHimpTempA:=nHimpA;
nHimpTempB:=nHimpB;
writeln('Ubah Anggota Himpunan');
writeln('=====================');
writeln;
writeln('Anggota Sebelumnya:');
tulisHimp;
writeln;
writeln;
write('n(A): ');readln(nHimpA);
write('n(B): ');readln(nHimpB);
clrscr;
writeln('Inputkan Anggota Himpunan A');
writeln('===========================');
writeln;
writeln('Anggota Sebelumnya:');
writeln;
write('Himpunan A = {');
for i:=1 to nHimpTempA do
begin
if(i=nHimpTempA) then
write(' ',himpTempA[i])
else
write(' ',himpTempA[i],',');
end;
write('}');
writeln;
write('Himpunan B = {');
for i:=1 to nHimpTempB do
begin
if(i=nHimpB) then
write(' ',himpTempB[i])
else
write(' ',himpTempB[i],',');
end;
write('}');
writeln;
writeln;
writeln;
for i:=1 to nHimpA do
begin
write('Anggota ke-',i,' : ');readln(himpA[i]);
end;
clrscr;
writeln('Inputkan Anggota Himpunan B');
writeln('===========================');
writeln;
writeln('Anggota Sebelumnya:');
writeln;
write('Himpunan A = {');
for i:=1 to nHimpTempA do
begin
if(i=nHimpTempA) then
write(' ',himpTempA[i])
else
write(' ',himpTempA[i],',');
end;
write('}');
writeln;
write('Himpunan B = {');
for i:=1 to nHimpTempB do
begin
if(i=nHimpB) then
write(' ',himpTempB[i])
else
write(' ',himpTempB[i],',');
end;
write('}');
writeln;
writeln;
writeln;
for i:=1 to nHimpB do
begin
write('Anggota ke-',i,' : ');readln(himpB[i]);
end;
end;
begin
clrscr;
writeln('Menu Utama');
writeln('==========');
writeln;
writeln;
write('n(A): ');readln(nHimpA);
write('n(B): ');readln(nHimpB);
clrscr;
writeln('Inputkan Anggota Himpunan A');
writeln('===========================');
writeln;
writeln;
for i:=1 to nHimpA do
begin
write('Anggota ke-',i,' : ');readln(himpA[i]);
end;
clrscr;
writeln('Inputkan Anggota Himpunan B');
writeln('===========================');
writeln;
writeln;
for i:=1 to nHimpB do
begin
write('Anggota ke-',i,' : ');readln(himpB[i]);
end;
repeat
clrscr;
writeln('Menu Operasi');
writeln('============');
tulisHimp;
writeln;
writeln;
writeln('1: Operasi Gabungan (Union)');
writeln('2: Operasi Irisan (Intersection)');
writeln('3: Operasi Selisih (Difference)');
writeln('4: Operasi Komplemen (Complement)');
writeln('5: Operasi Selisih Simetri (Symmetric Difference)');
writeln('6: Operasi Inklusi-Eksklusi');
writeln('7: Cek Subset');
writeln('8: Cek keanggotaan');
writeln;
writeln('10: Ubah Himpunan');
writeln;
writeln('0: Exit');
writeln;
writeln;
write('Masukkan pilihan Anda: ');readln(pil);
clrscr;
case pil of
1: gabungan;
2: irisan;
3: selisih;
4: komplemen;
5: selSimetri;
6: inEksklusi;
7: subset;
8: cekAnggota;
10: ubahHimp;
end;
readln;
until (pil=0);
clrscr;
end.
Tidak ada komentar:
Posting Komentar