Pascal/Turbo Pascal - Problema de Punteros.

 
Vista:
sin imagen de perfil

Problema de Punteros.

Publicado por Antonio (12 intervenciones) el 12/09/2012 02:16:18
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


Tengo todo hecho pero en el procedimiento de agregar datos me sale un error al tratar de introducir el segundo dato.
Tampoco me funciona el procedimiento de Borrar.

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
Uses crt;
type
    tElem= Integer;
    tLista= ^tNodo;
    tNodo = Record
                  dato: tElem;
                  atras, sig: tLista;
 
            end;
Var
   prim, ulti, actu, aux : tLista;
 
Procedure Agregar (var prim, ulti, actu, aux : tLista);
Begin
     clrscr;
     writeln ('ingrese un dato');
     if prim = nil then
     begin
          new(actu);
          read(actu^.dato);
          actu^.sig := nil;
          actu^.atras := nil;
          prim := actu;
          ulti := actu
     end
     else
     begin
          new (aux);
          read (aux^.dato);
          actu:= prim;
          while actu^.dato < aux^.dato do
          begin
                actu:=actu^.sig
          end;
          aux^.sig:=actu^.sig;
          aux^.atras:=actu;
          actu^.sig^.atras:=aux;
          actu^.sig:=aux
 
     end;
end;
 
Procedure VisualizarAscendente(var prim, actu: tLista);
Begin
     writeln('Elementos de la lista : ');
     actu:=prim;
     while actu<>nil do
     begin
          writeln(actu^.dato);
          actu:=actu^.sig
     end;
end;
 
Procedure VisualizarDescendente(var ulti, actu: tLista);
Begin
     writeln('Elementos de la lista : ');
     actu:=ulti;
     while actu<>nil do
     begin
          writeln(actu^.dato);
          actu:=actu^.atras
     end;
end;
 
Procedure Borrar (var ulti, actu: tLista);
begin
     if prim  = nil then      {pregunta si la lista está vacia}
          Write ('no hay datos');
          readln
     else
     begin
          actu:= ulti;                {se posiciona al final de la lista}
          actu:= actu^.atras;         {ahora se pasa al anteultimo carro}
          actu^.sig:= nil             {hace que el carro siguiente no apunte a nada}
     end;
end;
 
Procedure Menu;
    var
       salir : boolean;
       op : char;
begin
     salir := false;
repeat
      clrscr;
      writeln('  1 = Ingresa Datos');
      writeln('  2 = Ver Ascendente');
      writeln('  3 = Ver Descendente');
      writeln('  4 = Borrar al final');
      writeln('  5 = Salir');
      readln (op);
      case op of
            '1' : begin
                       clrscr;
                       Agregar (prim, ulti, actu, aux)
                  end;
            '2' : begin
                       clrscr;
                       VisualizarAscendente (prim, actu)
                  end;
            '3' : begin
                       clrscr;
                       VisualizarDescendente (ulti, actu)
                  end;
            '4' : begin
                       clrscr;
                       Borrar (ulti, actu)
                  end;
            '5' : salir := true;
      end;
until salir = true;
end;
 
Begin
     prim := nil;
     ulti := nil;
     menu;
end.


Si por ahí ven algún otro error háganme saber. 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

Problema de Punteros.

Publicado por ramon (2158 intervenciones) el 13/09/2012 22:00:54
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
{A ver si esto te ayuda, pero la inserción como tu la presentas es bastante mas liada que  eso
 puesto que debes de verificar si inserta en primer lugar en el ultimo o en medio.
 Yo te lo hago de forma de ordenación.
Si no sirve dímelo y te preparo la otra.}
 
program punteros;
 uses
   crt;
 type
    datosnu = integer;
    pnumero = ^numeros;
    numeros = record
          num : datosnu;
          sig, ant : pnumero;
        end;
 
  var
    primero, anterior, ultimo, actual : pnumero;
    dat : datosnu;
    tec : char;
 
 
   function entrada : datosnu;
   begin
       entrada := 0;
       clrscr;
       writeln('***** Entrada Datos *****');
       writeln;
       write('Entre Numero Entero : ');
       readln(dat);
       entrada := dat;
   end;
 
   procedure entraregistro;
   var
     busca, tempo : pnumero;
     tem : datosnu;
   begin
       if primero = nil then
       begin
           new(actual);
           actual^.num := entrada;
           actual^.sig := nil;
           actual^.ant := nil;
           primero := actual;
           ultimo := actual;
       end
     else
       begin
          anterior := ultimo;
          new(actual);
          actual^.num := entrada;
          anterior^.sig := actual;
          actual^.sig := nil;
          actual^.ant := anterior;
          ultimo := actual;
       end;
        busca := primero;
        repeat
           tempo := primero;
           while tempo <> nil do
           begin
           if busca^.num < tempo^.num then
           begin
               tem := busca^.num;
               busca^.num := tempo^.num;
               tempo^.num := tem;
           end;
              tempo := tempo^.sig;
          end;
             busca := busca^.sig;
        until busca = nil;
   end;
 
 
   procedure presenta_alante;
   var
     presen : pnumero;
   begin
      presen := primero;
      while presen <> nil do
      begin
         writeln(presen^.num);
         presen := presen^.sig;
      end;
      readkey;
   end;
 
   procedure presenta_atras;
   var
     presen : pnumero;
   begin
      presen := ultimo;
      while presen <> nil do
      begin
         writeln(presen^.num);
         presen := presen^.ant;
      end;
      readkey;
   end;
 
   procedure boraultimo;
   var
     borra : pnumero;
   begin
       borra := ultimo;
       borra^.ant^.sig := borra^.sig;
       borra^.sig^.ant := borra^.ant;
       ultimo := borra^.sig^.ant;
       dispose(borra);
       borra := primero;
       while borra <> nil do
       begin
       writeln(borra^.num);
       borra := borra^.sig;
       end;
       readkey;
   end;
 
   procedure menu;
   var
     tec : char;
     salir : boolean;
   begin
       salir := false;
    repeat
        clrscr;
        writeln('**** Menu Principal ****');
        writeln;
        writeln(' 1 = Entrada Datos');
        writeln(' 2 = Ver Datos Alante');
        writeln(' 3 = Ver Datos Atras');
        writeln(' 4 = Borramos Ultimo');
        writeln(' 5 = Salir');
        writeln;
        writeln('<<< Elija Opcion >>>');
        tec := readkey;
     case tec of
  '1' : entraregistro;
  '2' : presenta_alante;
  '3' : presenta_atras;
  '4' : boraultimo;
  '5' : salir := true;
    end;
    until salir = true;
   end;
 
   begin
       primero := nil;
       ultimo := nil;
       menu;
   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
sin imagen de perfil

Problema de Punteros.

Publicado por Antonio (12 intervenciones) el 16/09/2012 18:31:37
No se por qué la opción de borrar me tira un error en tu programa.
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

Problema de Punteros.

Publicado por ramon (2158 intervenciones) el 16/09/2012 21:41:48
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
{Prueba  esto }
 
procedure boraultimo;
   var
     atras, borra : pnumero;
   begin
       borra := ultimo;
       atras :=  ultimo^.ant;
       borra^.ant := atras;
       atras^.sig := nil;
       ultimo := atras;
       dispose(borra);
       borra := primero;
       while borra <> nil do
       begin
       writeln(borra^.num);
       borra := borra^.sig;
       end;
       readkey;
   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

Problema de Punteros.

Publicado por ramon (2158 intervenciones) el 17/09/2012 15:02:18
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
{Esta funcionando correctamente prueba es algo diferente del otro }
 
 program punteros;
 uses
   crt;
 type
    datosnu = integer;
    pnumero = ^numeros;
    numeros = record
          num : datosnu;
          sig, ant : pnumero;
        end;
 
  var
    primero, anterior, ultimo, actual : pnumero;
    dat : datosnu;
    tec : char;
    busca, tempo : pnumero;
 
   function entrada : datosnu;
   begin
       entrada := 0;
       clrscr;
       writeln('***** Entrada Datos *****');
       writeln;
       write('Entre Numero Entero : ');
       readln(dat);
       entrada := dat;
   end;
 
   procedure entraregistro;
   var
     tem : datosnu;
     sal : boolean;
   begin
       if primero = nil then
       begin
           new(actual);
           actual^.num := entrada;
           actual^.sig := nil;
           actual^.ant := nil;
           primero := actual;
           ultimo := actual;
       end
     else
       begin
           tem := entrada;
           busca := primero;
           sal := false;
           while (busca <> nil) and (sal <> true) do
           begin
              if busca^.num > tem then
              begin
                 sal := true;
              end;
              if sal = false then
              busca := busca^.sig;
           end;
           if sal = true then
           begin
             tempo := busca^.ant;
             anterior := actual;
             new(actual);
             actual^.num := tem;
             if busca^.ant = nil then
             begin
                actual^.sig := busca;
                actual^.ant := nil;
                busca^.ant := actual;
                primero := actual;
                actual := anterior;
               end
             else
                begin
                  actual^.sig := busca;
                  actual^.ant := tempo;
                  busca^.ant := actual;
                  tempo^.sig := actual;
                  actual := anterior;
                end;
              end
            else
               begin
                  anterior := ultimo;
                  new(actual);
                  actual^.num := tem;
                  anterior^.sig := actual;
                  actual^.sig := nil;
                  actual^.ant := anterior;
                  ultimo := actual;
              end;
         end;
    end;
 
   procedure presenta_alante;
   var
     presen : pnumero;
     tt : integer;
   begin
      presen := primero;
      tt := 0;
   repeat
         writeln(presen^.num);
         presen := presen^.sig;
         if keypressed then
         tt := 1;
   until (presen = nil) or (tt = 1);
      readkey;
   end;
 
   procedure presenta_atras;
   var
     presen : pnumero;
     tt : integer;
   begin
      presen := ultimo;
      tt := 0;
      repeat
         writeln(presen^.num);
         presen := presen^.ant;
         if keypressed then
         tt := 1;
      until (presen = nil) or (tt = 1);
      readkey;
   end;
 
   procedure boraultimo;
   var
     borra : pnumero;
   begin
       borra := ultimo;
       borra^.ant^.sig := borra^.sig;
       borra^.sig^.ant := borra^.ant;
       ultimo := borra^.sig^.ant;
       dispose(borra);
       borra := primero;
       while borra <> nil do
       begin
       writeln(borra^.num);
       borra := borra^.sig;
       end;
       readkey;
   end;
 
   procedure menu;
   var
     tec : char;
     salir : boolean;
   begin
       salir := false;
    repeat
        clrscr;
        writeln('**** Menu Principal ****');
        writeln;
        writeln(' 1 = Entrada Datos');
        writeln(' 2 = Ver Datos Alante');
        writeln(' 3 = Ver Datos Atras');
        writeln(' 4 = Borramos Ultimo');
        writeln(' 5 = Salir');
        writeln;
        writeln('<<< Elija Opcion >>>');
        tec := readkey;
     case tec of
  '1' : entraregistro;
  '2' : presenta_alante;
  '3' : presenta_atras;
  '4' : boraultimo;
  '5' : salir := true;
    end;
    until salir = true;
   end;
 
   begin
       primero := nil;
       ultimo := nil;
       menu;
   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
sin imagen de perfil

Problema de Punteros.

Publicado por Antonio (12 intervenciones) el 19/09/2012 00:54:48
Nop. Sigue sin borrar el último.
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

Problema de Punteros.

Publicado por ramon (2158 intervenciones) el 19/09/2012 20:30:59
{Funciona bien en turbo pascal 7 comprobado los otros también funcionan revisa algún error de
copia espero este sirva}

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
program punteros;
 uses
   crt;
 type
    datosnu = integer;
    pnumero = ^numeros;
    numeros = record
          num : datosnu;
          sig, ant : pnumero;
        end;
 
  var
    primero, anterior, ultimo, actual : pnumero;
    dat : datosnu;
    tec : char;
    busca, tempo : pnumero;
 
   function entrada : datosnu;
   begin
       entrada := 0;
       clrscr;
       writeln('***** Entrada Datos *****');
       writeln;
       write('Entre Numero Entero : ');
       readln(dat);
       entrada := dat;
   end;
 
   procedure entraregistro;
   var
     tem : datosnu;
     sal : boolean;
   begin
       if primero = nil then
       begin
           new(actual);
           actual^.num := entrada;
           actual^.sig := nil;
           actual^.ant := nil;
           primero := actual;
           ultimo := actual;
       end
     else
       begin
           tem := entrada;
           busca := primero;
           sal := false;
           while (busca <> nil) and (sal <> true) do
           begin
              if busca^.num > tem then
              begin
                 sal := true;
              end;
              if sal = false then
              busca := busca^.sig;
           end;
           if sal = true then
           begin
             tempo := busca^.ant;
             anterior := actual;
             new(actual);
             actual^.num := tem;
             if busca^.ant = nil then
             begin
                actual^.sig := busca;
                actual^.ant := nil;
                busca^.ant := actual;
                primero := actual;
                actual := anterior;
               end
             else
                begin
                  actual^.sig := busca;
                  actual^.ant := tempo;
                  busca^.ant := actual;
                  tempo^.sig := actual;
                  actual := anterior;
                end;
              end
            else
               begin
                  anterior := ultimo;
                  new(actual);
                  actual^.num := tem;
                  anterior^.sig := actual;
                  actual^.sig := nil;
                  actual^.ant := anterior;
                  ultimo := actual;
              end;
         end;
    end;
 
   procedure presenta_alante;
   var
     presen : pnumero;
     tt : integer;
   begin
      presen := primero;
      tt := 0;
   repeat
         writeln(presen^.num);
         presen := presen^.sig;
         if keypressed then
         tt := 1;
   until (presen = nil) or (tt = 1);
      readkey;
   end;
 
   procedure presenta_atras;
   var
     presen : pnumero;
     tt : integer;
   begin
      presen := ultimo;
      tt := 0;
      repeat
         writeln(presen^.num);
         presen := presen^.ant;
         if keypressed then
         tt := 1;
      until (presen = nil) or (tt = 1);
      readkey;
   end;
 
   procedure boraultimo;
   var
     borra : pnumero;
   begin
       borra := ultimo;
       borra^.ant^.sig := borra^.sig;
       borra^.sig^.ant := borra^.ant;
       ultimo := borra^.sig^.ant;
       dispose(borra);
       borra := primero;
       while borra <> nil do
       begin
       writeln(borra^.num);
       borra := borra^.sig;
       end;
       readkey;
   end;
 
   procedure menu;
   var
     tec : char;
     salir : boolean;
   begin
       salir := false;
    repeat
        clrscr;
        writeln('**** Menu Principal ****');
        writeln;
        writeln(' 1 = Entrada Datos');
        writeln(' 2 = Ver Datos Alante');
        writeln(' 3 = Ver Datos Atras');
        writeln(' 4 = Borramos Ultimo');
        writeln(' 5 = Salir');
        writeln;
        writeln('<<< Elija Opcion >>>');
        tec := readkey;
     case tec of
  '1' : entraregistro;
  '2' : presenta_alante;
  '3' : presenta_atras;
  '4' : boraultimo;
  '5' : salir := true;
    end;
    until salir = true;
   end;
 
   begin
       primero := nil;
       ultimo := nil;
       menu;
   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
sin imagen de perfil

Problema de Punteros.

Publicado por Antonio (12 intervenciones) el 01/10/2012 01:20:47
Funciona pero en el procedimiento BORRAR, ¿no sería mas facil que apuntara al carro anterior al último en vez de usar el dispose?
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

Problema de Punteros.

Publicado por ramon (2158 intervenciones) el 01/10/2012 18:23:06
Con dispose despejamos la memoria para mejor uso de ella no por otra causa y aseguramos
que no nos quedamos sin ella.
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
sin imagen de perfil

Problema de Punteros.

Publicado por Antonio (12 intervenciones) el 01/10/2012 01:29:11
Tambien: El procedimeinto de entrada debería hacer 3 preguntas No? Si es el primer dato, si hay un solo dato y si hay 2 datos o mas?
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

Problema de Punteros.

Publicado por ramon (2158 intervenciones) el 01/10/2012 18:31:22
El procedimiento de entrada no debe de realizar preguntas solo debe de insertar los datos
que le entren en el lugar adecuado tu tienes otros medios de ver el contenido entrado.
Así como borrar si lo quisieras.
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
sin imagen de perfil

Problema de Punteros.

Publicado por Antonio (12 intervenciones) el 01/10/2012 22:50:22
No entendí muy bien lo que hace el "busca" ni el "tec"
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

Problema de Punteros.

Publicado por ramon (2158 intervenciones) el 03/10/2012 18:25:17
Busca es un puntero o variable como la quieras nombrar de búsqueda de posición de
inserción del dato entrado del dato entrado fíjate que se posiciona en lo primero para
avanzar en la búsqueda para localizar donde se ara el enganche o inserción del
dato entrado

Tec es una entrada del teclado char para el menú su labor es recoger el valor de la tecla
pulsada y ejecutar según el valor el case.
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