Pascal/Turbo Pascal - Ordenamiento con Punteros

 
Vista:
sin imagen de perfil

Ordenamiento con Punteros

Publicado por Antonio (12 intervenciones) el 07/06/2012 02:32:22
Hola. Tengo este problema de punteros y no se bien como resolverlo.

Insertar elementos enteros en forma ordenada (Ascendente). La lista debe ser doblemente enlazada y sin carro nulo. Los elementos deben visualizarse en forma Ascendente y Descendente.
Debe dar la opción de borrar por el final de la lista


Bien. Yo declaré la lista asi:

1
2
3
4
5
6
7
8
type
    tElem: Integer;
    tLista: ^tNodo
    tNodo = Record
                  Contenido: tElem;
                  Anterior: tLista;
                  Siguiente: tLista;
            end;


Y el procedimiento borrar asi:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Procedure Borrar (var Lista: tLista);
var
   ListaAux: tLista;
begin
     ListaAux := Lista;
     if Lista = nil then
        Writeln ('no hay elementos');
     if Lista^.Siguiente = nil then
        Lista:= nil
     else
     begin
          While Lista^.Siguiente <> nil do
          begin
               Lista:= Lista^.Siguiente;
               ListaAux:= nil
          end;
     end;
end;


Que supongo que están bien.

Pero mi problema es al ordenar los vectores. ¿Debería insertarlos como vienen y después ordenarlos o ir ordenando a medida que ingresa cada uno?

Esto es lo que intente hacer para el procedimiento Insertar:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Procedure Agregar (Var Lista: tLista; Elem: tElem);
var
   ListaAux: tLista;
begin
     if Lista= nil then       {Pregunta si la Lista está vacía}
     begin
          Lista^.Contenido:= Elem;
          Lista^.Siguiente:= Nil;
          Lista^.Anterior:= Nil
     end;
     If Lista^.Siguiente:= Nil then {Pregunta si hay un solo elemento}
     begin
          ListaAux:= Lista;
          New (Lista);
          Lista^.Contenido:= Elem;
          If ListaAux^.Contenido < Lista^.Contenido then {Si lo que ingresamos ahora es mayor que lo que teníamos antes}
             Lista^.Anterior:= ListaAux {Lo pone adelante}
          else
              Lista^.Siguiente:= ListaAux {Lo pone atras}
     end;


De mas está decir que ese código no funciona pero espero que con eso se entienda la idea de lo que trato de hacer.

Necesitaría 3 procedimientos mas que son Insertar (Ascendente), Visualizar Ascendente y Visualizar Descendente.

Gracias.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Ordenamiento con Punteros

Publicado por ramon (2158 intervenciones) el 07/06/2012 21:41:22
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
{Esto te sirve}
 
 program punterodoble;
  uses
     crt;
  type
    datopunt = ^datos;
    datos = record
            dato : string;
            alant, atrs : datopunt;
          end;
    var
       prim, ulti, sigi, actu : datopunt;
 
   procedure entradaregistros;
   begin
      clrscr;
      gotoxy(10,2);write('Entrada De Datos');
      gotoxy(10,4);write('Dato = ');
      if prim = nil then
      begin
          new(actu);
          gotoxy(17,4);readln(actu^.dato);
          actu^.alant := nil;
          actu^.atrs := nil;
          prim := actu;
          ulti := actu;
        end
     else
         begin
           sigi := ulti;
           new(actu);
           gotoxy(17,4);readln(actu^.dato);
           sigi^.alant := actu;
           actu^.alant := nil;
           actu^.atrs := sigi;
           ulti := actu;
        end;
      end;
 
    procedure verdatosalanteatras;
    var
       tec : char;
       x, y : integer;
       verda : datopunt;
    begin
       x := 2;
       y := 3;
       gotoxy(20,1);write('Pantalla de Datos Use [',chr(24),chr(25),']');
       verda := prim;
       gotoxy(x,y);write(verda^.dato);
       repeat
        tec := readkey;
        if tec in[#72,#80] then
        begin
        if tec = #80 then  {ver adewlante}
        begin
           verda := verda^.alant;
           y := y + 1;
           if y > 22 then
           y := 22;
           if verda = nil then
           begin
           verda := ulti;
           y := y - 1;
           end;
          end;
        if tec = #72 then  {ver atras}
        begin
            verda := verda^.atrs;
            y := y - 1;
            if y < 3 then
            y := 3;
            if verda = nil then
            begin
            verda := prim;
            if y > 3 then
            y := y + 1;
            end;
          end;
          gotoxy(x,y);clreol;
          gotoxy(x,y);write(verda^.dato);
       end;
       until tec = #13;
    end;
 
   procedure anulaundato;
   var
     dat : string;
     pul : char;
     sige, tpor : datopunt;
   begin
      gotoxy(10,2);write('Anulacion De Un Dato');
      gotoxy(10,4);write('Entre Dato : ');
      gotoxy(23,4);readln(dat);
      gotoxy(10,7);write('El Dato A Borrar Es ',dat,' Correcto [S/N]');
      repeat
      pul := readkey;
      until pul in['s','S','n','N'];
      if pul in['s','S'] then
      begin
         clrscr;
         gotoxy(10,2);write('Borrando Dato');
         tpor := prim;
         repeat
            if tpor^.dato <> dat then
            tpor := tpor^.alant;
         until (tpor^.dato = dat) or (tpor = nil);
         if tpor <> nil then
         begin
         if tpor = prim then
         begin
             sige := tpor;
             tpor := tpor^.alant;
             prim := tpor;
             prim^.atrs := nil;
             dispose(sige);
         end;
         if tpor^.alant = nil then
         begin
            sige := tpor;
            tpor := tpor^.atrs;
            ulti := tpor;
            ulti^.alant := nil;
            actu := ulti;
            dispose(sige);
         end;
         if (tpor <> prim) and (tpor^.alant <> nil) then
         begin
         tpor^.alant^.atrs := tpor^.atrs;
         tpor^.atrs^.alant := tpor^.alant;
         dispose(tpor);
         end;
       end;
     end;
   end;
 
   procedure buscarundato;
   var
     dat : string;
     verda : datopunt;
   begin
     writeln;
     write('   Entre dato A Buscar : ');
     readln(dat);
     verda := prim;
     repeat
     verda := verda^.alant;
     until (verda = nil) or (verda^.dato = dat);
     if verda <> nil then
     writeln(' El Dato Vuscado Es = ',verda^.dato)
   else
     writeln(' El Dato Pedido No Aperecio ');
     readkey;
   end;
 
   procedure ordenardatos;
   var
     aux, sige, retro : datopunt;
     dat : string;
     fin1, fin : boolean;
    begin
        sige := prim;
        aux := ulti;
        fin := false;
        fin1 := false;
        retro := sige^.alant;
      repeat
        if sige^.alant = nil then
        fin := true;
         repeat
         if retro^.alant = nil then
         fin1 := true;
         if retro^.dato < sige^.dato then
         begin
            dat := sige^.dato;
            sige^.dato := retro^.dato;
            retro^.dato := dat;
         end;
         retro := retro^.alant;
         until fin1 = true;
         sige := sige^.alant;
         fin1 := false;
         retro := sige^.alant;
      until fin = true;
      actu := aux;
      actu^.dato := sige^.dato;
      sige := prim;
      actu := ulti;
    end;
 
 procedure menu;
    var
       tecla : char;
       salir : boolean;
    begin
       salir := false;
     repeat
       clrscr;
       gotoxy(10,2);write('***** menu Principal *****');
       gotoxy(10,4);write('  1 = Entra Datos');
       gotoxy(10,5);write('  2 = Ver Datos');
       gotoxy(10,6);write('  3 = Anular un Dato');
       gotoxy(10,7);write('  4 = Buscar un Dato');
       gotoxy(10,8);write('  5 = Ordenar Datos');
       gotoxy(10,10);write('  7 = Salir');
       gotoxy(10,13);write(' <<< Elija Opcion Del [1..7] >>>');
       tecla := readkey;
       if tecla in[#49..#55] then
       begin
       case tecla of
    #49 : begin clrscr; entradaregistros; end;
    #50 : begin clrscr; verdatosalanteatras; end;
    #51 : begin clrscr; anulaundato; end;
    #52 : begin clrscr; buscarundato; end;
    #53 : begin clrscr; ordenardatos; end;
    #55 : salir := true;
      end;
     end;
     until salir = true;
    end;
 
 
    begin
      prim := nil;
      ulti := nil;
      menu;
      if actu <> nil then
      dispose(actu);
    end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar