Pascal/Turbo Pascal - Problema Intercalación Pascal

   
Vista:

Problema Intercalación Pascal

Publicado por Juan (11 intervenciones) el 21/11/2013 18:51:44
Hola, les cuento el problema: Tengo un problema que no puedo resolver en Pascal con un ejercicio de Matrices,no puedo Generar un Vector (VFinal) intercalando dos vectores(V y Vec). Les muestro el problema y la solución mía:

Matriz de filas ordenadas(Ascendente):
5 10 15 20 25 30
N=4 -2 3 10 12 20 24
M=6 -7 5 13 15 27 35
8 10 15 20 35 40

Seleccione la Fila cuya primera columna tiene el máximo valor y la fila cuya última columna tiene el mínimo valor. Por último intercale ambas filas generando un Vector ordenado sin repeticiones y lo muestre. Si el máximo y mínimo coinciden en la misma fila no generar el arreglo e informar dicha situación.

Respuesta: Las filas seleccionadas serían la 4ta y la 2da y el vector generado:

VFinal= -2 3 8 10 12 15 20 24 35 40

Este es mi código:

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
Program Matriz;
Uses
Crt;
Type
TM=Array[1..4,1..6] of Real;
TV=Array[1..15] of Real;
 
 
Procedure Lectura(Var Mat:TM;Var N,M:Byte);
 Var
  i,j:Byte;
  Arch:Text;
 Begin
  Assign(Arch,'Datos1.txt'); Reset(Arch);
  Readln(Arch,N,M);
  For i:=1 to N do
   Begin
    For j:=1 to M do
    Read(Arch,Mat[i,j]);
    Readln(Arch);
   end;
 end;
 
 
Procedure Filas(Mat:TM;Var V,Vec:TV;N,M:Byte);
 Var
  i,j,FilaMin,FilaMax:Byte;
  Minimo,Maximo:Real;
 Begin
  j:=1;
  Maximo:=-999;
   For i:=1 to N do
   Begin
    If Mat[i,j] > Maximo then
     Begin
      Maximo:=Mat[i,j];
      FilaMax:=i;
     end;
   end;
    Write('Fila Columna m ximo valor: ');
    Writeln(FilaMax);
  For j:=1 to M do
   Begin
    V[i]:=Mat[FilaMax,j];
    Write(V[i]:3:0);
    Writeln;
   end;
    Write('M ximo Valor: ',Maximo:3:0);
    Writeln;
  Minimo:=999;
  j:= M;
  For i:=1 to N do
  Begin
   If Mat[i,j] < Minimo then
    Begin
     Minimo:= Mat[i,j];
     FilaMin:=i;
    end;
  end;
    Write('Fila Columna m¡nimo valor: ');
    Writeln(FilaMin);
  For j:=1 to M do
   Begin
    Vec[j]:=Mat[FilaMin,j];
    Write(Vec[j]:3:0);
    Writeln;
   end;
    Write('M¡nimo Valor: ',Minimo:3:0);
    Writeln;
 end;
Procedure intercalacion(V,Vec:TV;N,M:Byte;Var VFinal:TV; Var k:Integer);
 Var
  i,j,t:Integer;
 Begin
  i:=1; j:=1; k:=0;
  While (i<=N) and (j<=M) do
   Begin
    k:=k+1;
    If V[i] < Vec[j] then
     Begin
      VFinal[k]:=V[i];
      i:=i+1;
     end
    else
     If V[i] > Vec[j] then
      Begin
       VFinal[k]:= Vec[j];
       j:=j+1;
      end
     else
      Begin
       VFinal[k]:=V[i];
       i:=i+1;
       j:=j+1;
      end
    end;
    For t:=i to N do
     Begin
      k:=k+1;
      VFinal[k]:=V[i];
     end;
    For t:=j to M do
     Begin
      k:=k+1;
      VFinal[k]:=Vec[j];
     end;
  end;
 
 
Procedure Muestra(VFinal:TV;M:Byte);
 Var
  k:Byte;
 Begin
  For k:=1 to 12 do
  Write(VFinal[k]:3:0);
 end;
 
Var
 N,M,j:Byte;k:Integer; Mat:TM; V,Vec,VFinal:TV;
Begin
 Clrscr;
 Lectura(Mat,N,M);
 Filas(Mat,V,Vec,N,M);
 Intercalacion(V,Vec,N,M,VFinal,k);
 Muestra(VFinal,M);
 Readln;
end.

Me devuelve bien los máximos y mínimos, las filas con los números de la matriz, todo, pero tengo un problema con la intercalación que no la termino de comprender y me devuelve esto:

-2 0 0 0 3 10 12 20 24 40 0 0

Gracias por responder. Abrazo!
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 Intercalación Pascal

Publicado por ramon (2072 intervenciones) el 22/11/2013 13:49:41
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
{Mira espero esto te ayude}
 
 program matrizv;
  uses
     crt;
  const
     n = 4;
     m = 6;
  contenido : array[1..n,1..m] of real = (
  (15,20,5,25,10,30),
  (12,24,20,-2,10,3),
  (27,15,35,5,-7,3),
  (20,40,35,8,15,10));
 
 
  var
   TM : array[1..m,1..n] of real;
   TV : array[1..15] of real;
   k, d, nm, cm : integer;
   primax, primin : integer;
 
   procedure cargamatriz;
   begin
      for nm := 1 to n do
        for cm := 1 to m do
        tm[cm,nm] := contenido[nm,cm];
    end;
 
   procedure ordenamatriz;
   var
     ordn : real;
     tt : integer;
     begin
     for nm := 1 to n do
       for cm := 1 to m do
       begin
         for tt := m downto cm + 1 do
         begin
         if tm[cm,nm] > tm[tt,nm] then
         begin
            ordn := tm[cm,nm];
            tm[cm,nm] := tm[tt,nm];
            tm[tt,nm] := ordn;
         end;
        end;
       end;
     end;
 
  procedure presentamatriz;
  begin
     for k := 1 to n do
      begin
        for d := 1 to m do
        begin
        write('  ',tm[d,k]:0:0);
        end;
        writeln;
      end;
  end;
 
  function primeramax : integer;
  var
    s, g : integer;
    b1 : real;
    begin
       g := 0;
       b1 := 0.0;
       primeramax := 0;
       for s := 1 to n do
       begin
       if tm[1,s] > b1 then
       begin
       b1 := tm[1,s];
       g := s;
       end;
      end;
        primeramax := g;
    end;
 
  function ultimamin : integer;
  var
    s, g : integer;
    b1 : real;
    begin
       g := 0;
       b1 := 555770.0;
       ultimamin := 0;
       for s := 1 to n do
       begin
       if tm[m,s] < b1 then
       begin
       b1 := tm[m,s];
       g := s;
       end;
      end;
        ultimamin := g;
    end;
 
   procedure intercala(lin1, lin2 : integer);
   var
     pl1, pl2 : integer;
     tomado : real;
     o, p1, p2 : integer;
   begin
      pl1 := lin1;
      pl2 := lin2;
      if pl1 = pl2 then
      begin
          writeln('*** Maximo Y Minimo Coinciden En La Misma Fila ***');
          writeln;
      end
    else
      begin
      writeln('**** Vector Intercalado Y Ordenado ****');
      writeln;
      for p1 := 1 to m do
       for p2 := 1 to m do
       if tm[p1,pl1] = tm[p2,pl2] then
       tm[p2,pl2] := 0.0;
     p2 := 1;
     for p1 := 1 to m do
     begin
     tv[p2] := tm[p1,pl1];
     tv[p2 + 1] := tm[p1,pl2];
     p2 := p2 + 2;
     end;
     for p1 := 1 to p2 - 1 do
      for o := p2 - 1 downto p1 + 1 do
      if tv[p1] > tv[o] then
      begin
         tomado := tv[p1];
         tv[p1] := tv[o];
         tv[o] := tomado;
      end;
      for p1 := 1 to p2 - 1 do
      if tv[p1] <> 0.0 then
      write('  ',tv[p1]:0:0);
    end;
   end;
 
 
   begin
      clrscr;
      cargamatriz;
      writeln('*** Cargada ***');
      presentamatriz;
      ordenamatriz;
      writeln('*** Ordenada ***');
      presentamatriz;
      writeln;
      primax := primeramax;
      primin := ultimamin;
      writeln(' La Linea es = ',primax);
      writeln(' La Linea es = ',primin);
      writeln;
      intercala(primax,primin);
      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 Intercalación Pascal

Publicado por Juan (11 intervenciones) el 22/11/2013 18:02:13
Gracias ramon, ahora si, me sirvió mucho. Muchas gracias por la respuesta
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