Suppression élément de liste simplement chaînée non circulaire sans tampon

**tekthoninks** · 02/05/2009, 21h49

Bonjour tous,

Je galère dans la liste simplement chainée non circulaire sans tampon, je veux supprimer un élèment, je tourne depuis plusieurs sur la procedure et je n'arrive plus à avancer, j'ai terminé les autres fonctions et procedures et je bloque réellement sur la suppression d'element.

La fonction se situe dans l'Unité UListe.pas

function SupprimerDeListe (E : Elem; var L : Liste): Boolean;
(* Supprime E dans L, ne fait rien si E n'est pas dans L *)

Je vous donne les unités et le programme principal pour voir :

Code UElemListe.pas :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Unit UElemListe;
 
interface
{$MODE DELPHI}
type
  Elem = char;
 
procedure copy(A , B : Elem); // Copie authentique de A vers B
function equals(A , B : Elem) : Boolean; // Test d'égalité authentique de A et B
function ToString(A : Elem ) : String; // Ecriture en string de A
function Compare(A , B : Elem) : Cardinal; // Comparaison authentique de A et B
 
implementation
 
(**********************************************************************
---------------------- PROCEDURE COPY ---------------------------------
**********************************************************************)
procedure copy(A , B : Elem);
begin
  A := upcase(B)
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
--------------------- FUNCTION EQUALS ---------------------------------
**********************************************************************)
function equals(A , B : Elem) : Boolean;
begin
  result := A = B;
end;
(**********************************************************************
***********************************************************************)
 
(**********************************************************************
-------------------- FUNCTION TOSTRING --------------------------------
**********************************************************************)
function ToString(A : Elem ) : String;
begin
  result := A;
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
------------------------- FUNCTION COMPARE ----------------------------
**********************************************************************)
function Compare(A , B : Elem) : Cardinal;
(* PRE
{-1  <}
{0   =}
{1   >}
    *)
begin
  result := (Ord (UpCase(A)) - ord (UpCase(B))) ;
end;
(**********************************************************************
**********************************************************************)
 
 
end. // Fin Unité UELemListe

Code Uliste.pas :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
Unit UListe;
 
interface
{$MODE DELPHI}
 
uses  
  UElemListe in '.',
  SysUtils;
 
type
  Liste = ^Cellule;
  Cellule = Record
    Info : Elem;
    Svt : Liste;
    end;
  {/Drocer}
 
procedure NouvelleListe (var L : Liste);
(* Créer une nouvelle liste *)
function ListeVide (L : Liste) : Boolean;
(* Renvoie 'Vrai' si L est vide, 'Faux' si non vide *)
function DansListe (E : Elem; L : Liste ) : Boolean;
(* Renvoie 'Vrai' si E est dans L, 'Faux' sinon *)
function InsererListe (var E : Elem; var L : Liste ) : Boolean;
(* Insère E en début de L si E n'y existe pas, sinon ne fait rien *)
procedure InsererModifierListe (E : Elem; var L : Liste);
(* Insère E en début de L si E n'existe pas ou remplace E déjà existant par E *)
procedure AfficherListe (L : Liste); 
(* Affiche le contenu de L à l'écran *)
procedure ClonerListe (var Dest : Liste; Source : Liste);
(* Dest devient une liste clône de Source *)
function SupprimerDeListe (E : Elem; var L : Liste): Boolean;
(* Supprime E dans L, ne fait rien si E n'est pas dans L *)
procedure Standalone; 
(* Affiche le menu *)
 
 
implementation
 
(**********************************************************************
------------------------ PROCEDURE NOUVELLELISTE ----------------------
**********************************************************************)
procedure NouvelleListe (var L : Liste);
(* Créer une nouvelle liste *)
begin
  L := nil;
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
------------------- FONCTION LISTEVIDE --------------------------------
**********************************************************************)
function ListeVide (L : Liste) : Boolean;
(* Renvoie 'Vrai' si L est vide, 'Faux' si non vide *)
begin
  Result := L = nil;
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
---------------- FONCTION DANSLISTE -----------------------------------
**********************************************************************)
function DansListe (E : Elem; L : Liste ) : Boolean;
(* Renvoie 'Vrai' si E est dans L, 'Faux' sinon *)
var
  Courant : Liste;
begin
  result := false;
  Courant := L ; 
  while (not result) and (Courant <> nil) do
    begin
      Result := UElemListe.Equals(Courant^.Info, E);
      Courant := Courant^.svt;
    end;
  {/Elihw}
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
------------------- FONCTION INSERERLISTE -----------------------------
***********************************************************************)
function InsererListe (var E : Elem; var L : Liste ) : Boolean;
(* Insère E en début de L si E n'y existe pas, sinon ne fait rien *)
var
  courant : Liste;
begin
  result := false;
  courant := L;
  while ((courant <> nil) and DansListe(E,courant)) do
    begin
      result := UElemListe.Equals(courant^.info,E);
      courant := courant^.svt;
    end;
  {/Elihw}
  if not result then
    begin
      new(Courant);
      Courant^.info := E;
      Courant^.svt := L; 
      L := Courant; 
      result := true;
    end
  {/fi}
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
-------------------- PROCEDURE INSERERMODIFIERLISTE -------------------
**********************************************************************)
procedure InsererModifierListe (E : Elem; var L : Liste);
(* Insère E en début de L si E n'existe pas ou remplace E déjà existant par E *)
var 
  Courant : Liste;
  k : Cardinal = 0;
  r : Cardinal;
  trouve : boolean = false;
begin
  courant := L;
  while (courant <> nil) and DansListe(E,Courant) do
    begin
      trouve := UElemListe.Equals(Courant^.info, E) ;
      if not trouve then
        inc(k);
      {/fi}
      Courant := courant^.svt;
    end;
  {/Elihw}
  (* Courant = nil, E = Courant^.info, E non trouvé *)
  if trouve then
    begin
      writeln('trouve element YYYYY');
      readln();
      new(Courant);
      Courant := L;
      for r := k downto 1 do
        begin
          Courant := Courant^.svt;
        end;
      {/Rof}
      Courant^.info := upcase(E);
    end
  else
    begin
      InsererListe(E,L);
    end
  {/Fi}
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
-------------------------- PROCEDURE AFFICHERLISTE --------------------
**********************************************************************)
procedure AfficherListe (L : Liste); 
(* Affiche le contenu de L à l'écran *)
begin
  if L = nil then
    writeln('Liste Vide')
  else
    begin
      while L <> nil do
        begin
          write(' [',L^.info,']');
          L := L^.svt;
        end;
      {/Elihw}
    end;
  {/Fi}
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
----------------- PROCEDURE CLONERLISTE -------------------------------
**********************************************************************)
procedure ClonerListe (var Dest : Liste; Source : Liste);
(* Dest devient une liste clône de Source *)
var
  cour : Liste;
begin
  if Source = nil then
    Dest := nil 
  else
    begin
      Cour := Source;
      Dest := Cour;
      while Cour <> nil do
        begin          
          Dest^.info := Source^.info; 
          Cour := Cour^.svt;
        end;
      {/Elihw}
    end;
  {/Fi}
end;
(**********************************************************************
**********************************************************************)
 
(**********************************************************************
--------------------- FUNCTION SUPPRIMERDELISTE -----------------------
**********************************************************************)
function SupprimerDeListe (E : Elem; var L : Liste): Boolean;
(* Supprime E dans L, ne fait rien si E n'est pas dans L *)
var
  cour : Liste;
  Prec : Liste;
  TEMP : Liste;
  k : cardinal = 0;
  r : Cardinal;
begin
  result := false;
  if L = nil then 
    writeln('Liste Vide')
  else
    begin
      Cour := L;
      while (Cour <> nil) and (not result)do
        begin
          result := UElemListe.Equals(E,Cour^.info);
          Cour := Cour^.svt;
          inc(k);
        end;
      {/Elihw}
    end;
  {/Fi}
  if result then
    begin
      Prec := L;
      Temp := L;
      for r := 0 to k-1 do
        begin
          Prec := Prec^.svt;
        end;
      {/Rof}
      new (Cour);
      Cour := L;
      for r := 0 to k  do 
        begin
          Cour := Cour^.svt; 
        end;
      {/Rof}
      Temp := Prec^.svt;
      Prec^.svt := Cour;
      cour := Temp^.svt;
      L := Prec;
    end
end;
(**********************************************************************
**********************************************************************)
 
 
 
(**********************************************************************
--------------------- PROCEDURE STANDALONE ----------------------------
**********************************************************************)
procedure standalone;
(* Procedure affichant ce que propose le programme *)
begin
  writeln('[  1] Creer une nouvelle liste');
  writeln('[  2] Renseigner si Liste est vide');
  writeln('[  3] Renseigner si Element est dans Liste');
  writeln('[  4] Inserer Element en debut de Liste s''il n''existe pas');
  writeln('[  5] Ecrase ancien Element existant sinon creer Element en debut Liste ');
  writeln('[  6] Afficher Liste');
  writeln('[  7] Cloner Liste A vers Liste B (copie profonde)');
  writeln('[  8] Supprimer Element dans Liste s''il existe sinon ne fait rien');
  writeln('[  9] Afficher ce menu contextuel');
  writeln('Donner votre choix s''il-vous-plait');
  writeln();
end;
(**********************************************************************
**********************************************************************)
 
 
end. // Fin de l'Unité UListe

Code ProgramListe.pas :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
program ProgramListe;
{$MODE DELPHI}
 
uses  
  UElemListe in '.',
  UListe in '.';
 
var
  LST : Liste;
  TEMP : Liste;
  k : Cardinal;
  caractere : char;
begin
  writeln('Affichage du programme');
  Standalone();
  readln(k);
 
  repeat
    begin
      case k of 
        1:  begin
            writeln();
            writeln('CREATION NOUVELLE LISTE':40);
            writeln('Creation de nouvelle Liste');
            NouvelleListe(LST);
            writeln('Liste creee avec succes');
            AfficherListe(LST);
            writeln();
            writeln('Numero d''operation ? [ 9] = MENU  : ');
            readln(k);
          end;
        {/1}
 
        2:  begin
            writeln();
            writeln('LISTE VIDE ? : ':40);
            writeln('Liste Vide ? : ',ListeVide(LST));
            AfficherListe(LST);
            writeln();
            writeln('Numero d''operation ? [ 9] = MENU  : ');
            readln(k);
          end;
        {/2}
 
        3:  begin
            writeln();
            writeln('ELEMENT DANS LISTE ? : ':40);
            writeln('Introduisez un caractere ASCII s''il vous plait');
            readln(caractere);
            writeln('Element dans Liste ? : ',DansListe(caractere,LST));
            AfficherListe(LST);
            writeln();
            writeln('Numero d''operation ? [ 9] = MENU  : ');
            readln(k);
          end;
        {/3}
 
        4:  begin
            writeln();
            writeln('INSERTION SI CARACTERE NON EXISTANT : ':40);
            writeln('Introduisez un caractere ASCII s''il vous plait');
            readln(caractere);
            writeln('Inserer ',caractere,' dans Liste s''il n''existe pas ? : ',InsererListe(caractere,LST));
            AfficherListe(LST);
            writeln();
            writeln('Numero d''operation ? [ 9] = MENU  : ');
            readln(k);  
          end;
        {/4}
 
        5:  begin
            writeln();
            writeln('INSERTION DE CARACTERE EN ECRASANT ':40);
            writeln('Introduisez un caractere ASCII s''il vous plait');
            readln(caractere);
            InsererModifierListe(caractere, LST);
            writeln(caractere,' a ete insere ');
            AfficherListe(LST);
            writeln();
            writeln('Numero d''operation ? [ 9] = MENU  : ');
            readln(k);
          end;
        {/5}
 
        6:  begin
            writeln();
            writeln('AFFICHAGE DE LA LISTE : ':40);
            AfficherListe(LST);
            writeln();
            writeln('Numero d''operation ? [ 10] = MENU  : ');
            readln(k);
          end;
        {/6}
 
        7:  begin
            writeln();
            writeln('COPIE PROFONDE DE LISTE : ':40);
            ClonerListe(TEMP, LST);
            writeln();
            writeln('Copie effectuee avec succes');
            writeln('Liste source :');
            afficherListe(LST);
            writeln();
            writeln('Liste Destination');
            afficherListe(TEMP);
            writeln();
            writeln('Numero d''operation ? [ 9] = MENU  : ');
            readln(k);
          end;
        {/7}
 
        8:  begin
            writeln();
            writeln('SUPRESSION DE CARACTERE : ':40);
            writeln('Voici la liste');
            afficherListe(LST);
            writeln();
            writeln('Introduisez un carcatere ASCII s''il vous plait':40);
            readln(caractere);
            writeln(caractere,' supprime ? : ',SupprimerDeListe(caractere,LST));
            afficherListe(LST);
            writeln();
            writeln('Numero d''operation ? [ 9] = MENU  : ');
            readln(k);
          end;
        {/8}
 
        9:  begin
            writeln();
            standalone();
            readln(k);
          end;
        {/9}
    end;
    {/Esac}
  end;
    until
      k = 10;
  {/Teaper}
  (* Operation 10 *)
  writeln();
  writeln('Traitement termine, bye bye ');
 
end.// Fin du programme principal

Si quelqu'un peut juste me donner une marche à suivre, merci pour suppression dans Liste simplement chainee non circulaire sans tampon

Merci mes camarades de galère

**M.Dlb** · 03/05/2009, 01h33

Pourquoi redéfinis-tu un pointeur Cour ? Si j'en crois ton code, Prec pointe sur la cellule précédente à supprimer. Tu veux donc supprimer prec^.svt et affecter prec^.svt^.svt à prec^.svt (ca revient à ça en gros... attention à l'ordre dans lequel on le fait

). Pour libérer la mémoire, tu peux utiliser l'instruction dispose (c'est même conseillé, car beaucoup plus propre !).

**tekthoninks** · 03/05/2009, 20h20

Merci WormFul,

Je vais utiliser ce bout de code trouvé sur la toile pour ma fonction supprimerelementliste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
procedure LsupprimerIter (x: Element; var a :Liste);
    var b, c: Liste;
    begin
    if a <> nil then
        if a^.contenu = x then
            begin
            c := a;
            a := a^.suivant;
            dispose(c);
            end
        else
            begin
            b := a; 
            c := a^.suivant;
            while c <> nil do
                if c^.contenu <> x then
                    begin
                    b := c; 
                    c := c^.suivant;
                    end
                else
                    begin
                    b^.suivant := c^.suivant;
                    dispose(c);
                    c := nil;
                    end;
            end;
    end;

Suppression élément de liste simplement chaînée non circulaire sans tampon

Langage Pascal

Discussions similaires

Partager

Partager