Implémentation des machines Z en PASCAL

 

Vecteurs      Statique    Dynamique

Structures    Statique    Dynamique

Listes linéaires chaînées    Statique    Dynamique     

Listes bidirectionnelles     Statique    Dynamique       

Piles      Statique    Dynamique                   

Files d'attente    Statique    Dynamique

Arbres de recherche binaire    Statique    Dynamique

Arbres de recherche m-aire Statique    Dynamique

Fichiers       

 

Implémentation des vecteurs en PASCAL / Statique

 

  CONST Max =100;  Taille arbitraire

  TYPE

    Typeqq =  { type d'un élément du tableau } ;

    Typevect = ARRAY[1..Max] OF Typeqq;

 

      ELEMENT ( V, I )

 

  FUNCTION Element ( VAR V:Typevect; I: INTEGER ) : Typeqq;

    BEGIN

      Element :=  V[I];

    END;

 

      AFF_ELEMENT ( V, I, Val )

 

  PROCEDURE Aff_element ( VAR V :Typevect; I:INTEGER; Val : Typeqq );

    BEGIN

      V[I] := Val;

    END;

 

 

Exemple 

 

  VAR

    I : INTEGER;

    V : Typevect;

 

  BEGIN

    Aff_element(V, 1, 34);

    Aff_element(V, 2, 56);

    Aff_element(V, 3, 89);

    Aff_element(V, 4, 38);

    Aff_element(V, 5, 156);

 

    FOR I:=1 TO 5 DO

      WRITELN(Element( V, I)  );

 

    Aff_element(V,3, 99);

 

    FOR I:= 1 TO 5 DO

      WRITELN(Element( V, I) );

  END.

 

Implémentation des vecteurs en PASCAL /   Dynamique

 

  CONST Max =100;  Taille arbitraire

  TYPE

    Typeqq = { type d'un élément du tableau } ;

    Typevect = ARRAY[1..Max] OF Typeqq;

    Typevect_dyn = ^typevect;

 

      ALLOC_TAB ( T )

 

  PROCEDURE Alloc_tab ( var T : Typevect_dyn );

    BEGIN

       NEW(T)

    END;

 

      LIBER_TAB ( T  )

 

  PROCEDURE Liber_tab ( var T : Typevect_dyn );

    BEGIN

       DISPOSE(T)

    END;

 

      ELEMENT ( V, I )

     

  FUNCTION Element ( V:Typevect_dyn; I: INTEGER ) : Typeqq;

    BEGIN

      Element :=  V^[I];

    END;

 

      AFF_ELEMENT ( V, I, Val )

 

  PROCEDURE Aff_element ( VAR V :Typevect_dyn; I:INTEGER; Val : Typeqq );

    BEGIN

      V^[I] := Val;

    END;

 

Exemple 

 

  VAR

    I : INTEGER;

    V : Typevect_dyn;

 

  BEGIN

    Alloc_tab(V);

    Aff_element(V, 1, 34);

    Aff_element(V, 2, 56);

    Aff_element(V, 3, 89);

    Aff_element(V, 4, 38);

    Aff_element(V, 5, 156);

 

    FOR I:=1 TO 5 DO

      WRITELN(Element( V, I)  );

 

    Aff_element(V,3, 99);

 

    FOR I:= 1 TO 5 DO

      WRITELN(Element( V, I) );

   Liber_tab(V);

  END.

 

Implémentation des structures en PASCAL /  Statique

 

 

  TYPE

   Type1 =  type du champ1;

   Type2 =  type du champ2;

   ...

   Typen =  type du champn;

 

   Typestruct = record

      Champ1 : Type1;

      Champ2 : Type2;

      ....

      ....

      Champ2 : Typen;

    END;

 

  VAR S : Typestruct;

 

  STRUCT (S, I )

 

  Si le type du champ I est un scalaire, STRUCT se traduit par une fonction comme suit :

 

  FUNCTION STRUCTI ( S:Typestruct ) : TypeI;

    BEGIN

      StructI :=  S.champI;

    END;

 

Il y a donc autant de fonctions STRUCT que de champs scalaires dans la structure. Si le type du champ I est n'est pas scalaire, c'est à dire un vecteur à une dimension de scalaires, STRUCT se traduit par une procédure comme suit :

 

  PROCEDURE STRUCTI ( S:Typestruct; VAR Result : TypeI);

    BEGIN

      Result :=  S.champI;

    END;

 

  AFF_STRUCT (S, I, Exp)

 

  PROCEDURE AFF_STRUCTI ( VAR S :Typestruct; Val : TypeI );

    BEGIN

      S.champI := Val;

    END;

 

Il y a donc autant de fonctions Aff_struct que de champs scalaire dans la structure.

 

Exemple 

 

  Le Z-algorithme suivant :

 

  SOIENT

    S UNE STRUCTURE (ENTIER, VECTEUR(5) DE CHAINES);

    V1, V2 DES VECTEURS(5) DE CHAINES;

    I UN ENTIER ;

  DEBUT

    AFF_ELEMENT(V1[1],'1');

    AFF_ELEMENT(V1[2],'2');

    AFF_ELEMENT(V1[3],'3');

    AFF_ELEMENT(V1[4],'4');

    AFF_ELEMENT(V1[5],'5');

    AFF_STRUCT(S, 1, 5);

    AFF_STRUCT2(S, 2,  V1);

    ECRIRE('champ1 = ', STRUCT(S, 1) );

    ECRIRE('champ2 =');

    V2 = STRUCT(S, 2);

    POUR I := 1, 5  ECRIRE( V2[I])  FPOUR

  FIN

 

se traduit en PASCAL comme suit :

 

  TYPE

    Type1 = INTEGER;

    Type2 = ARRAY[1..5] OF STRING;

 

    Typestruct = RECORD

      Champ1 : Type1;

      Champ2 : Type2

    END;

 

  VAR  S : Typestruct;

 

  FUNCTION Struct1 ( S:Typestruct ) : Type1;

    BEGIN

      Struct1 :=  S.Champ1;

    END;

 

  PROCEDURE Struct2 ( S:Typestruct ; VAR Result : Type2);

    BEGIN

      Result :=  S.Champ2;

    END;

 

  PROCEDURE Aff_struct1 ( VAR S :Typestruct; VAL : Type1 );

    BEGIN

      S.Champ1 := VAL;

    END;

 

  PROCEDURE Aff_struct2 ( VAR S :Typestruct; VAL : Type2 );

    BEGIN

      S.Champ2 := VAL;

    END;

 

  VAR

    I : INTEGER;

    V1, V2 : Type2;

  BEGIN

    V1[1] := '1';    V1[2] :='2';    V1[3] := '3';

    V1[4] := '4';    V1[5] := '5';

    Aff_struct1(S, 5);

    Aff_struct2(S, V1);

    WRITELN('champ1 = ', Struct1(S) );

    WRITELN('champ2 =');

    Struct2(S, V2);

    FOR I := 1 TO 5 DO

    WRITELN(V2[I])

  END.

 

Implémentation des structures en PASCAL / Dynamique

 

  TYPE

   Type1 =  type du champ1;

   Type2 =  type du champ2;

   ...

   Typen =  type du champn;

 

   Typestruct = ^type_structure

   type_structure = record

      Champ1 : Type1;

      Champ2 : Type2;

      ....

      ....

      Champ2 : Typen;

    END;

 

  VAR S : Typestruct;

 

  PROCEDURE Alloc_struct( VAR S : Typestruct) ;

    BEGIN

      New(s);

    end;

 

  PROCEDURE Liber_struct( VAR S : Typestruct) ;

    BEGIN

      Dispose(S);

    end;

 

STRUCT (S, I )

 

Si le type du champ I est un scalaire, STRUCT se traduit par une fonction comme suit :

 

  FUNCTION STRUCTI ( S:Typestruct ) : TypeI;

    BEGIN

      StructI :=  S^.champI;

    END;

 

Il y a donc autant de fonctions STRUCT que de champs scalaires dans la structure.

 

Si le type du champ I est n'est pas scalaire, c'est à dire un vecteur à une dimension de scalaires, STRUCT se traduit par une procédure comme suit :

 

  PROCEDURE STRUCTI ( S:Typestruct; VAR Result : TypeI);

    BEGIN

      Result :=  S^.champI;

    END;

 

 

 

AFF_STRUCT (S, I )

 

  PROCEDURE AFF_STRUCTI ( VAR S :Typestruct; Val : TypeI );

    BEGIN

      S^.champI := Val;

    END;

 

Il y a donc autant de fonction Aff_structi que de champs scalaire dans la structure.

 

Exemple

 

  Le Z-algorithme suivant :

 

  SOIENT

    S UNE STRUCTURE (ENTIER, VECTEUR(5) DE CHAINES) DYNAMIQUE;

    V1, V2 DES VECTEURS(5) DE CHAINES;

    I UN ENTIER ;

  DEBUT

    AFF_ELEMENT(V1[1],'1');

    AFF_ELEMENT(V1[2],'2');

    AFF_ELEMENT(V1[3],'3');

    AFF_ELEMENT(V1[4],'4');

    AFF_ELEMENT(V1[5],'5');

    ALLOC_STRUCT(S);

    AFF_STRUCT(S, 1, 5);

    AFF_STRUCT(S, 2,  V1);

    ECRIRE('champ1 = ', STRUCT(S, 1) );

    ECRIRE('champ2 =');

    V2 = STRUCT(S, 2);

    POUR I := 1, 5  ECRIRE( V2[I])  FPOUR;

    LIBER_STRUCT(s);

  FIN

 

se traduit en PASCAL comme suit :

 

  TYPE

    Type1 = INTEGER;

    Type2 = ARRAY[1..5] OF STRING;

 

    Typestruct = ^type_structure;

    Type_structure = RECORD

      Champ1 : Type1;

      Champ2 : Type2

    END;

  VAR

     S : Typestruct;

 

  FUNCTION Struct1 ( S:Typestruct ) : Type1;

    BEGIN

      Struct1 :=  S^.Champ1;

    END;

 

  PROCEDURE Struct2 ( S:Typestruct ; VAR Result : Type2);

    BEGIN

      Result :=  S^.Champ2;

    END;

 

  PROCEDURE Alloc_struct( VAR S : Typestruct) ;

    BEGIN

      New(s);

    END;

 

  PROCEDURE Liber_struct( VAR S : Typestruct) ;

    BEGIN

      Dispose(s);

    END;

 

  PROCEDURE Aff_struct1 ( VAR S :Typestruct; VAL : Type1 );

    BEGIN

      S^.Champ1 := VAL;

    END;

 

  PROCEDURE Aff_struct2 ( VAR S :Typestruct; VAL : Type2 );

    BEGIN

      S^.Champ2 := VAL;

    END;

VAR

    I : INTEGER;

    V1, V2 : Type2;

 

  BEGIN

    V1[1] := '1';    V1[2] :='2';    V1[3] := '3';

    V1[4] := '4';    V1[5] := '5';

    Alloc_struct(s);

    Aff_struct1(S, 5);

    Aff_struct2(S, V1);

    WRITELN('champ1 = ', Struct1(S) );

    WRITELN('champ2 =');

    Struct2(S, V2);

    FOR I := 1 TO 5 DO

      WRITELN(V2[I]);

    Liber_struct(s);

  END.

 

Implémentation des listes linéaires chaînées en PASCAL / Dynamique

   

 

  TYPE

    Typeelem = INTEGER;  { type du champ 'Valeur'  }

    Pointeur = ^Maillon; { type du champ 'Adresse' }

    Maillon = RECORD

        Val : Typeelem;

        Suiv : Pointeur

    END;

 

  { Opérations du modèle }

 

  PROCEDURE Allouer ( VAR P : Pointeur ) ;

    BEGIN  NEW(P)  END;

 

  PROCEDURE Liberer ( P : Pointeur ) ;

    BEGIN  DISPOSE(P)  END;

 

  PROCEDURE Aff_val(P : Pointeur; Val : Typeelem );

    BEGIN P^.Val := Val  END;

 

  FUNCTION Valeur (P : Pointeur) : Typeelem;

    BEGIN   Valeur := P^.Val  END;

 

  FUNCTION Suivant( P : Pointeur) : Pointeur;

    BEGIN  Suivant := P^.Suiv END;

 

  PROCEDURE Aff_adr( P, Q : Pointeur ) ;

    BEGIN P^.Suiv := Q    END;

 

Implémentation des listes linéaires chaînées en PASCAL /   Statique

 

 

Plusieurs listes dans un même tableau. Le tableau est un ensemble de triplets Element, Suivant, Occupe). Le champ "Occupe" est nécessaire pour les opérations Allouer et Libérer. Une phase d'initialisation est obligatoire avant l'utilisation de ce tableau. Donc le tableau est global. Une liste est définie par l'indice de son premier élément

 

  CONST Max = 100; { Taille arbitraire pour le tableau }

 

  TYPE Typeqq = INTEGER;

  TYPE Typeliste = RECORD

    Element: Typeqq ;

    Suivant : INTEGER;

    Occupe : BOOLEAN

  END;

 

  { Le tableau }

  VAR

    Liste : ARRAY[1..Max ] OF Typeliste;

 

  { initialisation }

  PROCEDURE Init;

    VAR

      I : INTEGER;

    BEGIN

      FOR I:= 1 TO Max DO

        Liste[I].Occupe := FALSE;

    END;

 

  PROCEDURE Allouer ( VAR I: INTEGER  );

    VAR

      Trouv :BOOLEAN;

    BEGIN

      I:= 1;

      Trouv := FALSE;

      WHILE ( (I <= Max) AND  NOT Trouv ) DO

        IF Liste[I].Occupe

        THEN  I := I + 1

        ELSE  Trouv := TRUE;

 

      IF  NOT Trouv THEN I := -1;

    END;

 

  PROCEDURE Liberer ( I:INTEGER );

    BEGIN

      Liste[I].Occupe := FALSE ;

    END;

 

  FUNCTION Valeur ( I:INTEGER ) : Typeqq;

    BEGIN

      Valeur := Liste[I].Element;

    END;

 

  FUNCTION Suivant ( I:INTEGER ) : INTEGER;

    BEGIN

      Suivant :=  Liste[I].Suivant  ;

    END;

 

  PROCEDURE Aff_val ( I:INTEGER; Val :Typeqq );

    BEGIN

      Liste[I].Element := Val;

    END;

 

  PROCEDURE Aff_adr (I:INTEGER; J: INTEGER);

    BEGIN

      Liste[I].Suivant := J;

    END ;

 

Exemple 

 

  VAR

    E : INTEGER;

  BEGIN

    Init;

    Allouer (E);

    IF E <> -1

    THEN

      BEGIN

        Aff_val (E, 25);

        Aff_adr(E, -1);

      END

    ELSE

      WRITELN('Pas d''espace ');

  END.

 

 

Implémentation des listes bilatérales en PASCAL / Dynamique

 

  TYPE

    Typeelem = INTEGER;  % type du champ 'Valeur'  %

    Pointeur = ^Maillon; % type du champ 'Adresse' %

    Maillon = RECORD

        Val : Typeelem;

        Suiv : Pointeur;

        Prec : Pointeur

    END;

 

  { Opérations du modèle }

 

  PROCEDURE Allouer ( VAR P : Pointeur ) ;

    BEGIN  NEW(P)  END;

 

  PROCEDURE Liberer ( P : Pointeur ) ;

    BEGIN  DISPOSE(P)  END;

 

  PROCEDURE Aff_val(P : Pointeur; Val : Typeelem );

    BEGIN P^.Val := Val  END;

 

  FUNCTION Valeur (P : Pointeur) : Typeelem;

    BEGIN   Valeur := P^.Val  END;

 

  FUNCTION Suivant( P : Pointeur) : Pointeur;

    BEGIN  Suivant := P^.Suiv END;

 

  FUNCTION Precedent( P : Pointeur) : Pointeur;

    BEGIN  Precedent := P^.Prec END;

 

  PROCEDURE Aff_adrd( P, Q : Pointeur ) ;

    BEGIN P^.Suiv := Q    END;

 

  PROCEDURE Aff_adrg( P, Q : Pointeur ) ;

    BEGIN P^.Prec := Q    END;

 

Implémentation des listes bilatérales en PASCAL /  Statique

 

Plusieurs listes dans un même tableau. Le tableau est un ensemble de quadruplé (Element, Suivant, Precedent, Occupe). Le champ "Occupe" est nécessaire pour les opérations Allouer et Libérer.   Une phase d'initialisation est obligatoire avant l'utilisation de ce tableau. Donc le tableau est global. Une liste est définie par l'indice de son premier élément.

 

  CONST Max = 100; { Taille arbitraire du tableau }

 

  TYPE Typeqq = INTEGER;

  TYPE Typelistebi = RECORD

    Element: Typeqq ;

    Suivant : INTEGER;

    Precedent : INTEGER;

    Occupe : BOOLEAN

  END;

 

  { Le tableau }

  VAR

    Listebi : ARRAY[1..Max ] OF Typelistebi;

 

  { Initialisation }

  PROCEDURE Init;

    VAR

      I : INTEGER;

    BEGIN

      FOR I:= 1 TO Max DO

        Listebi[I].Occupe := FALSE;

    END;

 

  PROCEDURE Allouer ( VAR I: INTEGER  );

    VAR

      Trouv :BOOLEAN;

    BEGIN

      I:= 1;

      Trouv := FALSE;

      WHILE ( (I <= Max) AND  NOT Trouv ) DO

        IF Listebi[I].Occupe

        THEN  I := I + 1

        ELSE  Trouv := TRUE;

 

      IF  NOT Trouv THEN I := -1;

    END;

 

  PROCEDURE Liberer ( I:INTEGER );

    BEGIN

      Listebi[I].Occupe := FALSE ;

    END;

 

  FUNCTION Valeur ( I:INTEGER ) : Typeqq;

    BEGIN

      Valeur := Listebi[I].Element;

    END;

 

  FUNCTION Suivant ( I:INTEGER ) : INTEGER;

    BEGIN

      Suivant :=  Listebi[I].Suivant  ;

    END;

 

  FUNCTION Precedent ( I:INTEGER ) : INTEGER;

    BEGIN

      Precedent :=  Listebi[I].Precedent ;

    END;

 

PROCEDURE Aff_val ( I:INTEGER; Val :Typeqq );

    BEGIN

      Listebi[I].Element := Val;

    END;

 

  PROCEDURE Aff_adrd (I:INTEGER; J: INTEGER);

    BEGIN

      Listebi[I].Suivant := J;

    END;

  PROCEDURE Aff_adrg (I:INTEGER; J: INTEGER);

    BEGIN

      Listebi[I].Precedent := J;

    END;

 

Exemple

 

  VAR

    E : INTEGER;

  BEGIN

    Init;

    Allouer (E);

    IF E <> -1

    THEN

      BEGIN

        Aff_val (E, 25);

        Aff_adrg(E, -1);

        Aff_adrd(E, -1);

      END

    ELSE

      WRITELN('Pas d''espace ');

  END.

 

Implémentation des arbres de recherche binaire en PASCAL / Dynamique

 

  TYPE

    T = ^Noeud;

    Noeud = RECORD

      Element : INTEGER;

      Fg, Fd, Pere  : T ;

    END;

 

  FUNCTION Info(P : T) : INTEGER;

    BEGIN  Info := P^.Element   END;

 

  FUNCTION Fg( P : T) : T;

    BEGIN  Fg := P^.Fg  END;

 

  FUNCTION Fd( P : T) : T;

    BEGIN  Fd := P^.Fd  END;

  FUNCTION Pere( P : T) : T;

    BEGIN  Pere := P^.Pere  END;

 

  PROCEDURE Aff_info ( VAR P : T; Val : INTEGER);

    BEGIN   P^.Element := Val  END;

 

  PROCEDURE Aff_fg( VAR P : T; Q : T);

    BEGIN   P^.Fg :=  Q  END;

 

  PROCEDURE Aff_fd( VAR P : T; Q : T);

    BEGIN   P^.Fd :=  Q  END;

 

  PROCEDURE Aff_pere( VAR P : T; Q : T);

    BEGIN   P^.pere :=  Q  END;

 

  FUNCTION Creernoeud(  Val : INTEGER) : T;

    VAR

      P : T;

    BEGIN

      NEW ( P ) ;

      Creernoeud := P ;

      P^.Element := Val;

      P^.Fg := NIL;

      P^.Fd := NIL;

    END;

 

  PROCEDURE Liberernoeud( P : T);

    BEGIN

      DISPOSE ( P )

    END;

 

Implémentation des arbres de recherche binaire  en PASCAL /  Statique

 

Plusieurs arbres de recherche binaire dans un même tableau. Le tableau est un ensemble de 5-uplets (Info, Fg, Fd, Pere, Occupe). Le champ "Occupe" est nécessaire pour les opérations Creernoeud et Libérernoeud. Une phase d'initialisation est obligatoire avant l'utilisation de ce tableau. Donc le tableau est global. Un arbre de recherche binaire est défini par l'indice de son premier élément.

 

 

  CONST Max = 100; { Taille arbitraire du tableau }

  TYPE Typeqq = INTEGER;

 

  TYPE  Typearb = RECORD

    Info : Typeqq ;

    Fg, Fd, Pere : INTEGER;

    Occupe : BOOLEAN;

  END;

 

  { Le tableau }

  VAR

    Arb : ARRAY[1..Max ] OF Typearb;

 

  { Initialisation }

  PROCEDURE  Init;

    VAR

      I : INTEGER;

    BEGIN

      FOR I :=1 TO Max DO

        Arb[I].Occupe := FALSE;

    END;

 

  PROCEDURE Creernoeud ( VAR I : INTEGER );

    VAR

      Trouv : BOOLEAN;

    BEGIN

      I := 0;

      Trouv := FALSE;

      WHILE ( (I <= Max) AND NOT Trouv ) DO

        IF ( Arb[I].Occupe )

        THEN I := I + 1

        ELSE Trouv := TRUE;

 

      IF  NOT Trouv THEN I := -1;

    END;

 

  PROCEDURE Liberernoeud ( I: INTEGER );

    BEGIN

      Arb[I].Occupe := FALSE ;

    END;

 

  FUNCTION Info ( I:INTEGER ) : Typeqq;

    BEGIN

      Info :=  Arb[I].Info

    END;

 

  FUNCTION Fd (  I: INTEGER ) : INTEGER;

    BEGIN

      Fd := Arb[I].Fd

    END;

 

  FUNCTION Fg (  I: INTEGER ) : INTEGER;

    BEGIN

      Fg := Arb[I].Fg

    END;

 

  FUNCTION Pere (  I: INTEGER ) : INTEGER;

    BEGIN

Pere := Arb[I].Pere

    END;

 

  PROCEDURE Aff_info ( I:INTEGER; Val : Typeqq );

    BEGIN

      Arb[I].Info := Val;

    END;

 

  PROCEDURE  Aff_fd ( I:INTEGER; J : INTEGER);

    BEGIN

      Arb[I].Fd := J;

    END;

 

  PROCEDURE  Aff_fg ( I:INTEGER; J : INTEGER);

    BEGIN

      Arb[I].Fg := J;

    END;

 

  PROCEDURE  Aff_pere ( I:INTEGER; J : INTEGER);

    BEGIN

      Arb[I].Pere := J;

    END;

 

Exemple 

 

  VAR

    E : INTEGER;

  BEGIN

    Init;

    Creernoeud (E);

    IF ( E <> -1 )

    THEN

      BEGIN

        Aff_info (E, 25);

        Aff_fg(E, -1);

        Aff_fd(E, -1);

      END

    ELSE

      WRITELN('Pas d''espace');

  END.

 

 

Implémentation des arbres de recherche m-aire en PASCAL / Dynamique

 

  TYPE

    T = ^Noeud;

    Noeud = RECORD

      Infor : ARRAY[1..Max] of INTEGER;

      Fils : ARRAY[1..Max] of T;

      Degre : Byte ;

      Pere : T

    END;

 

  FUNCTION Infor(P : T; I: INTEGER) : INTEGER;

    BEGIN  Infor := P^.Infor[I]   END;

 

  FUNCTION Fils( P : T; I : INTEGER) : T;

    BEGIN  Fils := P^.Fils[I]  END;

 

  FUNCTION Pere( P : T) : T;

    BEGIN  Pere := P^.Pere  END;

 

  PROCEDURE Aff_infor ( VAR P : T; I:INTEGER; Val : INTEGER);

    BEGIN   P^.Infor[I] := Val  END;

 

  PROCEDURE Aff_fils( VAR P : T; I:INTEGER; Q : T);

    BEGIN   P^.Fils[I] :=  Q  END;

 

  PROCEDURE Aff_pere( VAR P : T; Q : T);

    BEGIN   P^.pere :=  Q  END;

 

  FUNCTION Creernoeud(  Val : INTEGER) : T;

    VAR

      P : T;

      I : BYTE;

    BEGIN

      NEW ( P ) ;

      Creernoeud := P ;

      For I:=1 TO Max Do P^.Fils[I] := NIL;

      P.degre := 0

    END;

 

  FUNCTION Degre ( P : T ) : BYTE;

    BEGIN

      Degre := P^.Degre

    END

 

  PROCEDURE Aff_Degre ( VAR P : T; N : BYTE);

    BEGIN

      P^.Degre := N

    END;

 

  PROCEDURE Liberernoeud( P : T);

    BEGIN    DISPOSE ( P )   END;

 

Implémentation des arbres de recherche m-aire en PASCAL / Statique

 

Plusieurs arbres de recherche m-aire dans un même tableau.Le tableau est un ensemble de quadruplé (Info, Fils, Degre, Occupe).Info est un tableau de (Ordre-1) valeurs.Fils est un tableau de (Ordre) indices. Le champ Degre contient le nombre courant de valeurs dans le noeud. Le champ "Occupe" est nécessaire pour les opéations Creernoeud et Libérernoeud.Une phase d'initialisation est obligatoire avant l'utilisation de ce tableau. Donc le tableau est global.Un arbre de recherche m-aire est défini par l'indice de son premier élément.

 

  CONST Max = 100; { Taille arbitraire du tableau }

  CONST Ordre = 8; { Ordre arbitraire }

  TYPE Typeqq= INTEGER;

  TYPE Typearm = RECORD

    Fils : ARRAY[1..Ordre] OF INTEGER;

    Info : ARRAY[1..Ordre-1] OF Typeqq;

    Degre : BYTE;

    Occupe : BOOLEAN;

  END;

 

  { Le tableau }

  VAR

    Arm : ARRAY [1.. Max ] OF Typearm;

 

  { Initialisation }

  PROCEDURE Init;

    VAR I : INTEGER;

    BEGIN

      FOR I:=1 TO Max DO

        Arm[I].Occupe := FALSE;

    END;

 

  PROCEDURE Creernoeud ( VAR P : INTEGER );

    VAR Trouv : BOOLEAN;

    BEGIN

      P := 1;

      Trouv := FALSE;

      WHILE ( (P <= Max) AND NOT Trouv ) DO

        IF  Arm[P].Occupe

        THEN P := P+ 1

        ELSE Trouv := TRUE;

 

      IF NOT Trouv THEN P := -1;

    END;

 

  PROCEDURE Liberernoeud ( P: INTEGER );

    BEGIN

      Arm[P].Occupe := FALSE ;

    END;

 

  FUNCTION  Infor ( P:INTEGER;I:INTEGER ) : Typeqq;

    BEGIN

      Infor :=  Arm[P].Info[I] ;

    END;

 

  FUNCTION Fils (  P, I : INTEGER ) : INTEGER;

    BEGIN

      Fils :=  Arm[P].Fils[I]  ;

    END;

 

  PROCEDURE Aff_infor ( P, I : INTEGER; Val :Typeqq );

    BEGIN

      Arm[P].Info[I] := Val;

    END;

 

  PROCEDURE Aff_fils (  P, I, J : INTEGER);

    BEGIN

      Arm[P].Fils[I] := J;

END;

 

  FUNCTION Degre ( P: INTEGER ) : BYTE;

    BEGIN

      Degre :=  Arm[P].Degre ;

    END;

  PROCEDURE Aff_degre ( P : INTEGER; I : BYTE );

    BEGIN

      Arm[P].Degre := I ;

    END;

 

 Exemple 

 

  VAR

    E : INTEGER;

  BEGIN

    Init;

    Creernoeud (E);

    IF ( E <> -1 )

    THEN

      BEGIN

        Aff_infor (E, 1, 25);

        Aff_fils(E, 2, -1);

      END

    ELSE

      WRITELN('Pas D''Espace ');

  END.

 

 

Implémentation des piles en PASCAL  /   Dynamique 

 

  TYPE

    Typeqq = INTEGER;

    Typepile = ^Maillon;

    Maillon = RECORD

      Valeur : Typeqq;

      Suivant : Typepile

    END;

 

  PROCEDURE Creerpile( VAR P : Typepile );

    BEGIN

      P := NIL;

    END;

 

  FUNCTION Pilevide ( P : Typepile ) : BOOLEAN;

    BEGIN

      Pilevide := ( P = NIL )

    END;

 

  PROCEDURE Empiler ( VAR P : Typepile; Val : Typeqq );

    VAR

      Q : Typepile;

    BEGIN

      NEW(Q);

      Q^.Valeur := Val;

      Q^.Suivant := P;

      P := Q;

    END;

 

  PROCEDURE Depiler ( VAR P : Typepile; VAR V :Typeqq );

    VAR Sauv : Typepile;

    BEGIN

     IF NOT Pilevide (P)

     THEN

       BEGIN

         V := P^.Valeur;

         Sauv := P;

         P := P^.Suivant;

         DISPOSE(Sauv);

       END

     ELSE WRITELN('Pile Vide');

    END;

Implémentation des piles en PASCAL / Statique

 

  TYPE

    Typepile = RECORD

      Som : INTEGER;

      Tab : ARRAY(.1..50.) OF T ;

    END;

 

  PROCEDURE Creerpile ( VAR P : Typepile);

    BEGIN P.Som := 0 END;

 

  FUNCTION Pilevide( P : Typepile) : BOOLEAN;

    BEGIN Pilevide := (P.Som = 0) END;

 

  PROCEDURE Empiler (VAR P : Typepile ; Val : T);

    BEGIN

      IF NOT Pilepleine(P)

      THEN

        BEGIN

          P.Som := P.Som + 1 ;

          P.Tab(.P.Som.) := Val ;

        END

      ELSE

        BEGIN

          WRITELN(' Pile saturée');

          HALT;

        END

    END;

 

  PROCEDURE Depiler (VAR P: Typepile; VAR Val  : T);

    BEGIN

      IF NOT Pilevide(P)

      THEN

        BEGIN

          Val := P.Tab(.P.Som.);

          P.Som := P.Som - 1

        END

      ELSE

        BEGIN

          WRITELN(' Pile saturée');

          HALT;

        END

    END;

 

Exemple 

 

  VAR

    Pile : Typepile;

    V : Typeqq;

  BEGIN

    Creerpile(Pile);

    Empiler (Pile, 25);

    Empiler (Pile, 35);

    Empiler (Pile, 45);

    Depiler (Pile, V );

    WRITELN(V);

END.

 

Implémentation des files d'attente en PASCAL /  Dynamique 

 

  TYPE

    Typelement=INTEGER;

    T1 = ^Elm ;

    Elm = RECORD

      Val : Typelement;

      Suiv : T1

    END;

 

    Filedattente = RECORD

      Tete, Queue : T1

    END;

 

  PROCEDURE Creerfile(VAR Fil : Filedattente);

    BEGIN   Fil.Tete := NIL  END;

  FUNCTION Filevide (Fil : Filedattente) : BOOLEAN;

    BEGIN  Filevide := Fil.Tete = NIL  END;

 

  PROCEDURE Enfiler (VAR Fil : Filedattente; Val : Typelement );

    VAR

      P : T1;

    BEGIN

      NEW(P);

      P^.Val := Val;

      P^.Suiv := NIL;

      IF NOT Filevide(Fil)

      THEN Fil.Queue^.Suiv := P

      ELSE Fil.Tete := P;

      Fil.Queue := P;

    END;

  PROCEDURE Defiler (VAR Fil : Filedattente ; VAR Val : Typelement );

    BEGIN

      IF NOT Filevide(Fil)

      THEN

        BEGIN

          Val := Fil.Tete^.Val;

          Fil.Tete := Fil.Tete^.Suiv;

        END

      ELSE WRITELN(' File Vide ');

    END;

 

Implémentation des files d'attente en PASCAL /  Statique

 

 

  CONST Max = 100;

  TYPE Typeqq= INTEGER;

  TYPE Typefile = RECORD

    Elements : ARRAY[1..Max] OF Typeqq;

    Tete, Queue : INTEGER

  END;

 

  PROCEDURE Creerfile ( VAR F :Typefile );

    BEGIN

      F.Tete := Max ;

      F.Queue := Max ;

    END;

 

  FUNCTION Filevide ( F : Typefile  ) : BOOLEAN;

    BEGIN

      Filevide := ( F.Tete = F.Queue );

    END;

 

  FUNCTION Filepleine ( F : Typefile  ) : BOOLEAN;

    BEGIN

      Filepleine := ( F.Tete = F.Queue MOD Max + 1 );

    END;

 

  PROCEDURE Enfiler ( VAR F : Typefile ; Val : Typeqq  );

    BEGIN

      IF  NOT Filepleine(F)

      THEN

        BEGIN

          F.Queue := F.Queue MOD Max  + 1;

          F.Elements[F.Queue] := Val;

        END

      ELSE

        WRITELN('File Pleine');

    END;

 

  PROCEDURE Defiler ( VAR F : Typefile ; VAR Val :Typeqq  );

    BEGIN

      IF NOT Filevide(F)

      THEN

        BEGIN

          F.Tete := F.Tete MOD Max + 1;

          Val := F.Elements[F.Tete];

        END

      ELSE

        WRITELN('File Vide');

    END;

 

Exemple 

 

  VAR F : Typefile;

  V : Typeqq ;

 

  BEGIN

    Creerfile (F);

    Enfiler(F, 5);

    Enfiler(F, 18);

    Enfiler(F, 22);

    Defiler(F, V);

    WRITELN(V);

  END.

 

Implémentation des fichiers en PASCAL 

 

   TYPE

     Type1 = Type du champ1 de la structure du bloc (ou article);

     Type2 = Type du champ2 de la structure du bloc (ou article);

     ...

     Typen = Type du champn de la structure du bloc (ou article);

 

     Typecaract1 = Type de la première caractéristique du fichier;

     Typecaract2 = Type de la deuxième caractéristique du fichier;

     ...

     Typecaractm = Type de la m-ième caractéristique du fichier;

 

     { Définition d'un bloc du fichier }

     Sorte = (Caract, Art );

     Typestruct = RECORD

       CASE Id : Sorte OF

         Caract : (

                   Champ1 : Type1;

                   Champ2 : Type2;

                   ...

                   Champn : Typen;

                  );

         Art :

                  (

                   Caract1 : Typecaract1;

                   Caract2 : Typecaract2;

                   ...

                   Caractm : Typecaractm;

                  )

       END;

     Typefile =   File OF Typestruct;

 

   VAR

     F  : Typefile;             { Fichier }

     Buf_caract : Typestruct;   { Buffer des caractéristiques }

 

    { Machine abstraite sur les fichiers }

 

   PROCEDURE Ouvrir (VAR Fl : Typefile ; Fp, Mode : STRING );

     BEGIN

       ASSIGN(Fl, Fp);

       IF Mode = 'A'

       THEN

         BEGIN

           RESET(Fl);

           READ(Fl, Buf_caract);

         END

       ELSE

         BEGIN

           REWRITE(Fl);

           Buf_caract.Id := Caract;

           WRITE(Fl, Buf_caract)

         END;

     END;

 

   PROCEDURE Fermer ( VAR Fl : Typefile);

     BEGIN

       Buf_caract.Id := Caract;

       SEEK(Fl, 0);

       WRITE(Fl, Buf_caract);

       CLOSE( Fl)

     END;

 

      ENTETE  (Fl, i )

 

   FUNCTION Entete1(  VAR Fl : Typefile): Typecaract1;

     BEGIN

       Entete1 := Buf_caract.Caract1;

     END;

 

Il y a donc autant de fonctions ENTETEi que de types scalaires définis dans la partie 'ENTETE'.

 

      AFF_ENTETE  ( Fl, i, Exp )

 

   PROCEDURE Aff_entete1 ( VAR Fl: Typefile; VAL : Typecaract1);

     BEGIN

       Buf_caract.Caract1 := VAL

     END;

 

Il y a donc autant de fonctions AFF_ENTETEi que de types scalaires définis dans la partie 'ENTETE'.

 

   PROCEDURE Ecrireseq ( VAR Fl: Typefile;  Buf : Typestruct );

     BEGIN

       Buf.Id := Art;

       WRITE(Fl, Buf)

     END;

 

   PROCEDURE Ecriredir ( VAR Fl: Typefile;  Buf : Typestruct;  N: INTEGER );

     BEGIN

       Buf.Id := Art;

       SEEK(Fl, N);

       WRITE(Fl, Buf)

     END;

 

   PROCEDURE Lireseq ( VAR Fl: Typefile; VAR Buf : Typestruct );

     BEGIN

       READ(Fl, Buf)

     END;

 

   PROCEDURE Liredir ( VAR Fl: Typefile; VAR Buf : Typestruct;  N: INTEGER );

     BEGIN

       SEEK(Fl, N);

       READ(Fl, Buf)

     END;

 

   FUNCTION Finfich ( VAR Fl : Typefile): BOOLEAN;

     BEGIN

       Finfich := EOF(Fl)

     END;

 

   FUNCTION Alloc_bloc ( VAR Fl : Typefile) : INTEGER;

     BEGIN

       Alloc_bloc := FILESIZE(Fl) ;

     END;

 

Exemple 

 

  Le Z-algorithme suivant :

 

  SOIENT

    F UN FICHIER DE ( ENTIER , VECTEUR ( 5 ) DE CHAINES )

    BUFFER B1 ENTETE ( ENTIER , ENTIER ) ;

     { fichier de blocs contenant le nombre d'articles et un tableau d'articles}

     { entete : nombre d'articles, nombre de blocs}

    Creer , Imprimer DES ACTIONS ;

  DEBUT

    APPEL Creer ;

    APPEL Imprimer ;

   FIN

 

  /*****       Chargement de n articles avec un chargement _ 100% ****/

  ACTION Creer ;

  SOIENT

    I , K , N , Nbblocs DES ENTIERS ;

  DEBUT

    OUVRIR ( F , 'f.pas' , 'N' ) ;

    I := 0 ;

    Nbblocs := 0 ;

    N := 500 ;

    AFF_ENTETE ( F , 1 , N ) ;

    TQ I < N :

       K := 0 ;

       TQ ( K < 5 ) ET ( I < N )

          K := K + 1 ;

          I := I + 1 ;

          AFF_ELEMENT ( STRUCT ( B1 , 2 ) [ K ] , ALEACHAINE )

       FTQ ;

       AFF_STRUCT ( B1 , 1 , K ) ;

       Nbblocs := Nbblocs + 1 ;

       ECRIRESEQ ( F , B1 ) ;

    FTQ ;

    AFF_ENTETE ( F , 2 , Nbblocs ) ;

    FERMER ( F ) ;

  FIN

 

  /*****       Impression des articles du fichier ****/

  ACTION Imprimer ;

  SOIENT

    I , K DES ENTIERS ;

  DEBUT

    I := 0 ;

    OUVRIR ( F , 'f.pas' , 'A' ) ;

    TQ NON FINFICH ( F )

       I := I + 1 ;

       ECRIRE ( 'B  L  O  C     n° ' , I ) ;

       LIRESEQ ( F , B1 ) ;

       POUR K := 1 , STRUCT ( B1 , 1 )

          ECRIRE ( ELEMENT ( STRUCT ( B1 , 2 ) [ K ] ) )

       FPOUR

    FTQ;

    FERMER(f);

  FIN

 

se traduit en PASCAL Comme suit :

 

   TYPE

     Type1 = INTEGER;

     Type2 = ARRAY[1..5] OF STRING;

     Typecaract1 = INTEGER;

     Typecaract2 = INTEGER;

     Sorte = (Caract, Art );

 

Typestruct = RECORD

       CASE Id : Sorte OF

         Caract : (

                   Champ1 : Type1;

                   Champ2 : Type2;

                  );

         Art :

                  (

                   Caract1 : Typecaract1;

                   Caract2 : Typecaract2

                  )

       END;

 

     Typefile =   File OF Typestruct;

 

   VAR

     F  : Typefile;

     { Fichier de blocs contenant le nombre d'articles et un tableau d'articles}

     B1 : Typestruct;

     Buf_caract : Typestruct;

 

     { Machine abstraite sur les vecteurs }

     FUNCTION Element ( VAR V:Type2; I: INTEGER ) : STRING;

       BEGIN

         Element :=  V[I];

       END;

 

     PROCEDURE Aff_element ( VAR V :Type2; I:INTEGER; VAL : STRING);

       BEGIN

         V[I] := VAL;

       END;

 

     { Machine abstaite sur les structures }

     FUNCTION Struct1(  S : Typestruct): Type1;

       BEGIN

         Struct1 := S.Champ1;

       END;

 

     PROCEDURE Struct2(S: Typestruct; VAR Result : Type2);

       BEGIN

         Result := S.Champ2;

       END;

 

     PROCEDURE Aff_struct1( VAR S : Typestruct; VAL : Type1);

       BEGIN

         S.Champ1 := VAL;

       END;

 

     PROCEDURE Aff_struct2( VAR S : Typestruct; VAL : Type2);

       BEGIN   S.Champ2 := VAL;        END;

 

     { Machine abstraite sur les fichiers }

     PROCEDURE Ouvrir (VAR Fl : Typefile ; Fp, Mode : STRING );

       BEGIN

         ASSIGN(Fl, Fp);

         IF Mode = 'A'

         THEN

           BEGIN

             RESET(Fl);

             READ(Fl, Buf_caract);

           END

         ELSE

            BEGIN

              REWRITE(Fl);

              Buf_caract.Id := Caract;

              WRITE(Fl, Buf_caract)

            END;

       END;

 

     PROCEDURE Fermer ( VAR Fl : Typefile);

       BEGIN

         Buf_caract.Id := Caract;

         SEEK(Fl, 0);

         WRITE(Fl, Buf_caract);

         CLOSE( Fl)

       END;

 

     FUNCTION Entete1(  VAR Fl : Typefile): Typecaract1;

       BEGIN

         Entete1 := Buf_caract.Caract1;

       END;

 

     FUNCTION Entete2(  VAR Fl : Typefile): Typecaract2;

       BEGIN

         Entete2 := Buf_caract.Caract2;

       END;

 

     PROCEDURE Aff_entete1 ( VAR Fl: Typefile; VAL : Typecaract1);

       BEGIN

         Buf_caract.Caract1 := VAL

       END;

 

     PROCEDURE Aff_entete2 ( VAR Fl: Typefile; VAL : Typecaract2);

       BEGIN

         Buf_caract.Caract2 := VAL

       END;

 

     PROCEDURE Ecrireseq ( VAR Fl: Typefile;  Buf : Typestruct );

       BEGIN

         Buf.Id := Art;

         WRITE(Fl, Buf)

       END;

 

     PROCEDURE Ecriredir ( VAR Fl: Typefile;  Buf : Typestruct;  N: INTEGER );

       BEGIN

         Buf.Id := Art;

         SEEK(Fl, N);

         WRITE(Fl, Buf)

       END;

 

     PROCEDURE Lireseq ( VAR Fl: Typefile; VAR Buf : Typestruct );

       BEGIN

         READ(Fl, Buf)

       END;

 

     PROCEDURE Liredir ( VAR Fl: Typefile; VAR Buf : Typestruct;  N: INTEGER );

       BEGIN

         SEEK(Fl, N);

         READ(Fl, Buf)

       END;

 

     FUNCTION Finfich ( VAR Fl : Typefile): BOOLEAN;

       BEGIN

         Finfich := EOF(Fl)

       END;

 

     FUNCTION Aleachaine : STRING;

       VAR

         K : BYTE;

         Chaine : STRING;

       BEGIN

         Chaine := '';

         FOR K:=1 TO 4 DO

           CASE Random(2) OF

             0 : Chaine := Chaine + CHR(97+Random(26) ) ;

             1 : Chaine := Chaine + CHR(65+Random(26) )

           END;

         Aleachaine := Chaine;

       END;

 

     FUNCTION Alloc_bloc ( VAR Fl : Typefile) : INTEGER;

       BEGIN

           Alloc_bloc := FILESIZE(Fl) ;

       END;

 

     /*****    Chargement de 50 blocs à raison de 60% ****/

     PROCEDURE Creer ;

       VAR

         I , K  : INTEGER ;

         V : Type2;

       BEGIN

         Ouvrir ( F , 'f.pas' , 'N' ) ;

         FOR I := 1 TO  10 DO

           BEGIN

             FOR  K := 1 TO 3 DO

               Aff_element ( V , K  , ALEACHAINE );

             Aff_struct2( B1, V);

             Aff_struct1 ( B1 , 3 ) ;

             Ecrireseq ( F , B1 ) ;

           END;

         Fermer ( F ) ;

       END;

 

     /*****    Impression des articles du fichier ****/

     PROCEDURE Imprimer ;

       VAR

         K  : INTEGER ;

         V : Type2;

       BEGIN

         Ouvrir ( F , 'f.pas' , 'A' ) ;

         WHILE NOT Finfich ( F ) DO

           BEGIN

             Lireseq ( F , B1 ) ;

             Struct2(B1, V);

             FOR  K := 1 TO  Struct1 ( B1 ) DO

               WRITELN ( Element ( V , K  ) );

             READLN;

           END;

       END;

 

   BEGIN

     Creer ;

     Imprimer ;

   END.