Data hosted with ♥ by Pastebin.com - Download Raw - See Original
  1. UNIT uConjunto;
  2.  
  3. INTERFACE
  4. USES uElem;
  5.     TYPE
  6.         TConjunto = ^TNodo;
  7.  
  8.         TNodo = RECORD
  9.             info:TElem;
  10.             sig:TConjunto;
  11.         END;
  12.  
  13.     PROCEDURE CrearConjuntoVacio (VAR conj:TConjunto);
  14.  
  15.     PROCEDURE Poner (VAR conj:TConjunto; elem:TElem);
  16.  
  17.     PROCEDURE Eliminar (VAR conj:TConjunto);
  18.  
  19.     PROCEDURE Quitar (VAR conj:TConjunto; elem:TElem);
  20.  
  21.     FUNCTION Pertenece (conj:TConjunto; elem:TElem):boolean;
  22.  
  23.     PROCEDURE Union (conj1,conj2:TConjunto; VAR conjUnido:TConjunto);
  24.  
  25.     FUNCTION EsSubconjunto (conj1,conj2:TConjunto):boolean;
  26.  
  27.     PROCEDURE Interseccion (conj1,conj2:TConjunto; VAR conjInter:TConjunto);
  28.  
  29.     PROCEDURE Diferencia (conj1,conj2:TConjunto; VAR conjDifer:TConjunto);
  30.  
  31.     FUNCTION EsConjuntoVacio (conj:TConjunto):boolean;
  32.  
  33. IMPLEMENTATION
  34.  
  35.     PROCEDURE CrearConjuntoVacio (VAR conj:TConjunto);
  36.         BEGIN
  37.             conj := NIL;
  38.         END;{CrearListaVacia}
  39.  
  40.     PROCEDURE Poner (VAR conj:TConjunto; elem:TElem);
  41.         VAR
  42.             aux:TConjunto;
  43.         BEGIN
  44.             IF NOT(Pertenece(conj,elem)) THEN
  45.                 BEGIN
  46.                     new(aux);
  47.                     Asignar(aux^.info,elem);
  48.                     aux^.sig := conj;
  49.                     conj := aux;
  50.  
  51.                 END;{IF}
  52.         END;{Poner}
  53.  
  54.     PROCEDURE Eliminar (VAR conj:TConjunto);
  55.         VAR
  56.             aux:TConjunto;
  57.         BEGIN
  58.             IF NOT(EsConjuntoVacio(conj)) THEN
  59.                 BEGIN
  60.                     aux := conj;
  61.                     conj := conj^.sig;
  62.                     dispose(aux);
  63.  
  64.                 END;{IF}
  65.         END;{Eliminar}
  66.  
  67.     PROCEDURE Quitar (VAR conj:TConjunto; elem:TElem);
  68.         VAR
  69.             ant,act:TConjunto;
  70.         BEGIN
  71.             ant := NIL;
  72.             act := conj;
  73.  
  74.             WHILE NOT(EsConjuntoVacio(act)) AND NOT(Iguales(act^.info , elem)) DO
  75.                 BEGIN
  76.                     ant := act;
  77.                     act := act^.sig;
  78.                 END;{WHILE}
  79.  
  80.             IF act<>NIL THEN
  81.                 IF ant = NIL THEN
  82.                     Eliminar(conj)
  83.                 ELSE
  84.                     IF (act<>NIL) AND (ant<>NIL) THEN
  85.                         BEGIN
  86.                             ant^.sig := act^.sig;
  87.                             dispose(act);
  88.                         END;{IF}
  89.         END;{Quitar}
  90.  
  91.     FUNCTION Pertenece (conj:TConjunto; elem:TElem):boolean;
  92.         VAR
  93.             check:boolean;
  94.         BEGIN
  95.             check := FALSE;
  96.  
  97.             IF NOT(EsConjuntoVacio(conj)) THEN
  98.                 BEGIN
  99.  
  100.                     WHILE NOT(EsConjuntoVacio(conj)) AND (check=FALSE) DO
  101.                         BEGIN
  102.                             check := Iguales(conj^.info , elem);
  103.                             conj := conj^.sig;
  104.                         END;{WHILE}
  105.                 END;{IF}
  106.  
  107.             Pertenece := check;
  108.         END;{Pertenece}
  109.  
  110.  
  111.     PROCEDURE Union (conj1,conj2:TConjunto; VAR conjUnido:TConjunto);
  112.         VAR
  113.             puntAuxi,aux:TConjunto;
  114.         BEGIN
  115.             CrearConjuntoVacio(conjUnido);
  116.             puntAuxi := conj1;
  117.             WHILE NOT(EsConjuntoVacio(conj1)) DO
  118.                 BEGIN
  119.                     new(aux);
  120.                     Asignar(aux^.info , conj1^.info);
  121.                     aux^.sig := NIL;
  122.  
  123.                     IF EsConjuntoVacio(conjUnido) THEN
  124.                         BEGIN
  125.                             conjUnido := aux;
  126.                             puntAuxi := aux;
  127.                         END{IF}
  128.                     ELSE
  129.                         BEGIN
  130.                             puntAuxi^.sig := aux;
  131.                             puntAuxi := aux;
  132.                         END;{ELSE}
  133.  
  134.                     conj1 := conj1^.sig;
  135.                 END;{WHILE}
  136.  
  137.             puntAuxi^.sig := conj2;
  138.  
  139.             WHILE NOT(EsConjuntoVacio(conj2)) DO
  140.                 BEGIN
  141.                     IF NOT Pertenece(conjUnido , conj2^.info) THEN
  142.                         new(aux);
  143.                         Asignar(aux^.info , conj2^.info);
  144.                         aux^.sig := NIL;
  145.  
  146.                         IF EsConjuntoVacio(conjUnido) THEN
  147.                             BEGIN
  148.                                 conjUnido := aux;
  149.                                 puntAuxi := aux;
  150.                             END{IF}
  151.                         ELSE
  152.                             BEGIN
  153.                                 puntAuxi^.sig := aux;
  154.                                 puntAuxi := aux;
  155.                             END;{ELSE}
  156.  
  157.                     conj2 := conj2^.sig;
  158.                 END;{WHILE}
  159.  
  160.         END;{Union}
  161.  
  162.     FUNCTION EsSubconjunto (conj1,conj2:TConjunto):boolean;
  163.         VAR
  164.             check:boolean;
  165.         BEGIN
  166.             check := TRUE;
  167.             WHILE NOT(EsConjuntoVacio(conj1)) AND (check = TRUE) DO
  168.                 BEGIN
  169.                     check := Pertenece(conj2 , conj1^.info);
  170.                     conj1 := conj1^.sig;
  171.                 END;{WHILE}
  172.  
  173.             EsSubconjunto := check;
  174.         END;{EsSubconjunto}
  175.  
  176.     PROCEDURE Interseccion (conj1,conj2:TConjunto; VAR conjInter:TConjunto);
  177.         BEGIN
  178.             CrearConjuntoVacio(conjInter);
  179.  
  180.             WHILE NOT(EsConjuntoVacio(conj1)) DO
  181.                 BEGIN
  182.                     IF Pertenece(conj2 , conj1^.info) THEN
  183.                         Poner(conjInter,conj1^.info);
  184.  
  185.                     conj1 := conj1^.sig;
  186.                 END;{WHILE}
  187.         END;{Interseccion}
  188.  
  189.     PROCEDURE Diferencia (conj1,conj2:TConjunto; VAR conjDifer:TConjunto);
  190.         BEGIN
  191.             CrearConjuntoVacio(conjDifer);
  192.  
  193.             WHILE NOT(EsConjuntoVacio(conj1)) DO {Yo creo que esto está mal, que se necesita un puntero auxiliar apuntando a conj1 para hacer el primer while ya que si no se pierde "el mango de la sartén" de conj1 dentro del subprograma y luego, al hacer si conj2^.info pertenece en conj1, no se hace correctamente}
  194.                 BEGIN
  195.                     IF NOT( Pertenece(conj2 , conj1^.info) )  THEN
  196.                         Poner(conjDifer,conj1^.info);
  197.  
  198.                     conj1 := conj1^.sig;
  199.                 END;{WHILE}
  200.  
  201.             WHILE NOT(EsConjuntoVacio(conj2)) DO
  202.                 BEGIN
  203.                     IF NOT( Pertenece(conj1 , conj2^.info) )  THEN
  204.                         Poner(conjDifer,conj2^.info);
  205.  
  206.                     conj2 := conj2^.sig;
  207.                 END;{WHILE}
  208.         END;{Diferencia}
  209.  
  210.     FUNCTION EsConjuntoVacio (conj:TConjunto):boolean;
  211.         BEGIN
  212.             EsConjuntoVacio := (conj = NIL);
  213.         END;{EsConjuntoVacio}
  214.  
  215.  
  216. END.