PROGRAMME 9 : Parties d'un ensemble

Le programme

PROGRAM Parties;
  TYPE
    Pointeur = ^Typemaillon;
    Typemaillon = RECORD
      Val : INTEGER;
      Adr : Pointeur
    END;
    T = RECORD
      Tete : Pointeur;
      Nb : INTEGER
    END;
  VAR Liste1, Liste2 : ARRAY[1..10] OF T;
    Fs  : TEXT;
    N, N1, N2, I, J, K, Nb, Long, Compt : INTEGER;
    Q, L : Pointeur;
    V : ARRAY[1..10] OF INTEGER;
    Aig : BOOLEAN;

  PROCEDURE Allouer( VAR P : Pointeur );
    BEGIN NEW(P) END;

  PROCEDURE Affval( VAR P : Pointeur; Val :INTEGER );
    BEGIN P^.Val := Val END;

  PROCEDURE Affadr( VAR P : Pointeur; Q : Pointeur );
    BEGIN P^.Adr := Q END;

  FUNCTION Suivant( P : Pointeur ) : Pointeur;
    BEGIN Suivant := P^.Adr END;

  FUNCTION Valeur( P : Pointeur ) : INTEGER;
    BEGIN Valeur := P^.Val END;

  PROCEDURE Imprimer(L : Pointeur);
    BEGIN
      WRITE(Fs, '+ {');
      WHILE (L <> NIL) DO
        BEGIN
          WRITE(Fs, Valeur(L), ',' );
          L := Suivant(L)
        END;
      WRITELN(Fs, '}');
    END;

  { Recherche de la valeur Val dans la liste L}

  FUNCTION Recherche ( Val:INTEGER; L:Pointeur)  : BOOLEAN;
    VAR Trouv : BOOLEAN;
    BEGIN
      Trouv := FALSE;
      WHILE ( (L <> NIL) AND (NOT Trouv )) DO
IF Valeur(L) = Val
THEN Trouv := TRUE
        ELSE L := Suivant(L);
      Recherche :=  Trouv
    END;

  { Union des I-ième et J-ième listes contenues dans le tableau Liste1 ou Liste2 selon la valeur de Aig. L est la       liste résultante, Nb  son nombre d'éléments.
    Remarque : L contient tous les maillons de la I-ième liste.       }

  PROCEDURE Union ( Aig : BOOLEAN; I, J: INTEGER; VAR L: Pointeur; VAR Nb : INTEGER);
    VAR L1, L2, Q : Pointeur;
      Nb1 : INTEGER;
    BEGIN
      IF Aig
      THEN
        BEGIN
          L1 := Liste1[I].Tete;
          Nb1 :=Liste1[I].Nb;
          L2 := Liste1[J].Tete
        END
      ELSE
        BEGIN
  L1 := Liste2[I].Tete;
    Nb1 :=Liste2[I].Nb;
  L2 := Liste2[J].Tete
        END;
      L := L1;
      Nb := Nb1;
      WHILE ( L2 <> NIL) DO
        BEGIN
          IF NOT Recherche(Valeur(L2), L1)
  THEN { Ajout au d‚but de L1}
            BEGIN
              Nb := Nb + 1;
              Allouer(Q);
      Affval(Q, Valeur(L2));
      Affadr(Q, L);
              L := Q
            END;
  L2 := Suivant(L2)
        END
  END;

   { Teste l'égalité‚ entre 2 Listes }

  FUNCTION Egal (L1:Pointeur; Nb1:INTEGER; L2:Pointeur; Nb2:INTEGER) :  BOOLEAN;
    VAR Trouv : BOOLEAN;
    BEGIN
      IF Nb1 = Nb2
      THEN
        BEGIN
        Trouv := FALSE;
          WHILE ( (L2 <> NIL) AND (NOT Trouv )) DO
    IF NOT Recherche( Valeur(L2), L1)
    THEN Trouv := TRUE
    ELSE  L2 := Suivant(L2);
  Egal := NOT Trouv
        END
      ELSE  Egal := FALSE
    END;

  { Recherche de la liste L dans le tableau Liste1 ou Liste2 selon la valeur de Aig. }

  FUNCTION Exist ( Aig : BOOLEAN; L:Pointeur ) : BOOLEAN;
    VAR   I : INTEGER;
      Trouv : BOOLEAN;
    BEGIN
      I := 1;
      Trouv := FALSE;
      IF Aig
      THEN
        WHILE ( (I <= N2) AND (NOT Trouv )) DO
          IF Egal(Liste2[I].Tete, Liste2[I].Nb, L, Nb)
          Then trouv := TRUE
          ELSE    I := I + 1
      ELSE
        WHILE ( (I <= N1) AND (NOT Trouv )) DO
          IF Egal(Liste1[I].Tete, Liste1[I].Nb, L, Nb)
  Then trouv := TRUE
  ELSE    I := I + 1;
        Exist := Trouv
    END;

  BEGIN
    N := 5;
    { Initialisation de V}
    FOR I:=1 TO 10 DO V[I] := I;
    ASSIGN(Fs, 'R_partie.Pas');
    REWRITE(Fs);
    WRITELN(Fs, '      Ensemble de toutes les parties ');
    WRITELN(Fs);
    WRITELN(Fs, '{ }');
    WRITELN(Fs,' Ensembles d''un ‚élément');
    FOR I:=1 TO N DO
      BEGIN
        Allouer(Q);
affval(Q, V[I] );
affadr(Q, NIL);
liste1[I].Tete := Q;
liste1[I].Nb := 1;
        Imprimer(Q)
      END;

    N1 := N;
    N2 := 0;
    Aig := TRUE;
    Long := 2;
    Compt := 1 + N;
    WHILE ( N <> 1 ) DO
      BEGIN
        WRITELN(Fs,' Ensembles de ',Long, '   ‚=éléments');
for I:=1 TO N DO
          FOR J:=I+1 TO N DO
            BEGIN
              Union(Aig, I, J, L, Nb);
              IF NOT Exist(Aig, L) AND(Long = Nb)
              THEN
                IF Aig
                THEN
                  BEGIN
                    N2 := N2 + 1;
                    Liste2[N2].Tete := L;
                    Liste2[N2].Nb := Nb;
                  END
                ELSE
                  BEGIN
                    N1 := N1 + 1;
            Liste1[N1].Tete := L;
    Liste1[N1].Nb := Nb;
  END
            END;
          IF Aig
          THEN
            BEGIN
              N1 := 0; N:= N2;
              FOR K:= 1 TO N DO Imprimer( Liste2[K].Tete)
            END
          ELSE
            BEGIN
              N2 := 0; N:= N1;
              FOR K:= 1 TO N DO Imprimer( Liste1[K].Tete)
            END;
          Aig := NOT Aig;
          Long := Long + 1;
          Compt := Compt + N;
      END;
    WRITELN(Fs,'Nombre de parties : ', Compt);
    CLOSE(Fs);
  END.

Les résultats  ( Contenu du fichier R_parties.Pas )

Ensemble de toutes les parties
{ }
Ensembles d'un élément
+ {1,}
+ {2,}
+ {3,}
+ {4,}
+ {5,}
Ensembles de 2 éléments
+ {2,1,}
+ {3,1,}
+ {4,1,}
+ {5,1,}
+ {3,2,}
+ {4,2,}
+ {5,2,}
+ {4,3,}
+ {5,3,}
+ {5,4,}
Ensembles de 3 éléments
+ {3,2,1,}
+ {4,2,1,}
+ {5,2,1,}
+ {4,3,1,}
+ {5,3,1,}
+ {5,4,1,}
+ {4,3,2,}
+ {5,3,2,}
+ {5,4,2,}
+ {5,4,3,}
Ensembles de 4  éléments
+ {4,3,2,1,}
+ {5,3,2,1,}
+ {5,4,2,1,}
+ {5,4,3,1,}
+ {5,4,3,2,}
Ensembles de 5 éléments
+ {5,4,3,2,1,}
Nombre de parties : 32