Program Pascal: Operasi Himpunan

Kebetulan sebelumnya penulis dapat tugas dari kampus untuk membuat program yang berfungsi untuk menjalankan operasi-operasi untuk himpunan-himpunan matematika. Operasi-operasi tersebut adalah sebagi berikut:

1. Operasi Gabungan (Union)
2. Operasi Irisan (Intersection)
3. Operasi Selisih (Difference)
4. Operasi Komplemen (Complement)
5. Operasi Selisih Simetri (Symmetric Difference)
6. Operasi Inklusi-Eksklusi
7. Pemeriksaan Subset
8. Cek Keanggotaan Suatu Himpunan

Anda dapat mengunduh source code serta file executable dari program tersebut dari link berikut:
http://www.mediafire.com/?7u2do342yidxv7o



Berikut merupakan source code lengkap dari program tersebut:


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.


Mohon maaf jika masih terdapat kesalahan (bug) pada program tersebut, berhubung penulis masih awam pada dunia pemrograman. Jika ada kritik dan saran silahkan tulis pada kolom komentar.
Semoga Berguna :)