Implementación de Conjuntos en Pascal

El lenguaje Pascal cuenta con el tipo de datos SET que permite manejar información aplicando los conceptos básicos de la Teoría de Conjuntos. La definición de una estructura de este tipo tiene la forma siguiente:

TYPE nombre = SET OF tipo_base;

Donde tipo_base puede ser cualquier tipo ordinal, incluyendo los enumerados y los subrangos, pero con la limitación de un máximo de 255 elementos. Algunos ejemplos de conjuntos serían los siguientes:

TYPE  
     Dias = (Lunes, Martes, Miercoles, Jueves, Viernes, Sabado, Domingo);
     Puntos = 1..20;

     Conjunto1 = SET OF Dias;
     Conjunto2 = SET OF Puntos;
     Conjunto3 = SET OF BYTE;  

VAR
     A : Conjunto1;
     B : Conjunto2;
     C : Conjunto3;

Para representar un conjunto por extensión en Pascal se utilizan los símbolos [ y ], por ejemplo:

A := [Lunes, Jueves, Sabado];
B := [5, 9, 12, 16, 18];
C := [0..9, 15, 25, 44, 80..99];

Como podrán ver, pueden usarse subrangos en la enumeración de los elementos de un conjunto, tal como se permite en las matemáticas. Para representar el conjunto vacío se escriben los corchetes sin elementos, como en el siguiente ejemplo:

A := [ ];

Las funciones básicas de conjunto se ejecutan mediantes los siguientes operadores:

Unión :              +
Intersección :   *
Diferencia :       -
Subconjunto :   <=        
Pertenencia :   IN

Como muestra, presentamos un programa en Pascal donde se aplican algunas de estas funciones.

PROGRAM Conjuntos;
     USES CRT;
     
     TYPE Conjunto = SET OF Byte;
     
     VAR   A, B, C, D : Conjunto;
                N : ARRAY[1..100] OF BYTE;
                k, y : INTEGER;

(* Escribe los elementos de un conjunto *)
PROCEDURE EscribirConjunto(S : Conjunto);
     VAR  k : BYTE;
Begin
    IF NOT (S = []) THEN
    begin
        Write('{ ');
        For k := 0 TO 255 DO
            IF k IN S THEN Write(k, ', ');
        Writeln(CHR(8), CHR(8),  ' }');
    end
    ELSE
    Writeln('{ }');
    Writeln; Writeln;
End;

(* Incluye elementos en el conjunto A *)
PROCEDURE IncluirElementos;
     VAR x, y : BYTE;
Begin
    REPEAT
         ClrScr;
         gotoXY(10, 10); Write('Escriba un número (0 - 255) : ');
         Readln(x);
         A := A + [x];
         gotoXY(10, 12); Write('Desea continuar (1 = Si, 2 = No) ? ');
         Readln(y);
    UNTIL (y = 2);
End;

(* Incluir en el conjunto B los números potencia de 2 *)
PROCEDURE CrearConjunto;
     VAR k : INTEGER;
Begin
    k := 2;
    WHILE (k <= 255) DO
    begin
        B := B + [k];
        k := k * 2;
    end;
End;

(* Rellenar un arreglo de números aleatorios sin repeticiones *)
PROCEDURE RellenarArreglo;
     VAR i, j, k, x, t : BYTE;
              S : Conjunto;
Begin
    S := []; (* Inicialmente el conjunto está vacío *)
    Randomize;
    FOR k := 1 TO 100 DO
    begin
        REPEAT
             x := Random(256);       (* El tipo BYTE acepta 256 valores. *)
        UNTIL NOT (x IN S);      (* Evita que hayan elementos repetidos. *)
        N[k] := x;
        S := S + [x];                        (* Incorporamos x al conjunto *)
    end;

(* Ordenamos el arreglo ascendentemente *)
FOR i := 1 TO 99 DO
     FOR j :=  i + 1 TO 100 DO
          IF N[i] > N[j] THEN
          begin
              t := N[i];
              N[i] := N[j];
              N[j] := t;
          end;
End;

PROCEDURE EscribirAyB;
Begin
    ClrScr;
    Write('A = '); EscribirConjunto(A);
    Write('B = '); EscribirConjunto(B);
    ReadKey;
End;

PROCEDURE OperacionesBasicas;
Begin
    ClrScr;
    A := [2, 4, 6, 8, 10, 12, 14, 16, 18, 20];
    B := [3, 6, 9, 12, 15, 18, 21, 24, 27, 30];
    gotoXY(4, 10); Write('A = '); EscribirConjunto(A);
    gotoXY(4, 12); Write('B = '); EscribirConjunto(B);

    (* Unión de los conjuntos A y B *)
    C := A + B;
    gotoXY(4, 14); Write('A U B = '); EscribirConjunto(C);
    
    (* Intersección de los conjuntos A y B *)
    C := A * B;
    gotoXY(4, 16); Write('A ', CHR(239), ' B = '); EscribirConjunto(C);

    (* Diferencia entre los conjuntos A y B *)
    C := A - B;
    gotoXY(4, 18); Write('A - B = '); EscribirConjunto(C);
    ReadKey;
End;

PROCEDURE OtrasOperaciones;
Begin
    ClrScr;
    (* A es el conjunto de los pares *)
    A := [];
    k := 2;
    WHILE (k <= 255) DO
    begin
        A := A + [k];
        k := k + 2;
    end;
    
    (* C es el complemento de A *)
    C := [];
    FOR k := 0 TO 255 DO
         IF NOT (k IN A) THEN
            C := C + [k];
    
    (* D es el conjunto de los múltiplos de 4 *)
    D := [];
    k := 4;
    WHILE (k <= 255) DO
    begin
        D := D + [k];
        k := k + 4;
    end;
    Write('A = '); EscribirConjunto(A);
    Write('B = '); EscribirConjunto(B);
    Write('C = '); EscribirConjunto(C);
    Write('D = '); EscribirConjunto(D);

    (* D es subconjunto de A *)
    IF D <= A THEN         Writeln('D es subconjunto de A')
    ELSE
       Writeln('D no es subconjunto de A');
    ReadKey;
End;

PROCEDURE Arreglos;
Begin
    ClrScr;
    (* Un arreglo de 100 elemetos sin repeticiones *)
    RellenarArreglo;
    Writeln('Arreglo N: ');
    For k := 1 TO 100 DO
        Write(N[k]:4);
    ReadKey;
End;

PROCEDURE VaciarConjuntos;
Begin
    A := [];
    B := [];
    C := [];
    D := [];
End;

BEGIN
     REPEAT
          ClrScr;
           gotoXY(10, 4); Write('1. Incluir Elementos en A');
           gotoXY(10, 6); Write('2. Crear Conjunto B');
           gotoXY(10, 8); Write('3. Escribir A y B');
           gotoXY(10, 10); Write('4. Operaciones Básicas');
           gotoXY(10, 12); Write('5. Otras Operaciones');
           gotoXY(10, 14); Write('6. Arreglos');
           gotoXY(10, 16); Write('7. Vaciar Conjuntos');
           gotoXY(10, 18); Write('0. Salir');
           gotoXY(10, 20); Write('Su Selección --> ');
          Readln(y);
          CASE y OF
               1 : IncluirElementos;
               2 : CrearConjunto;
               3 : EscribirAyB;
               4 : OperacionesBasicas;
               5 : OtrasOperaciones;
               6 : Arreglos;
               7 : VaciarConjuntos;
               0 : Exit;
          End;
     UNTIL y = 0;
END.