Pascal/Turbo Pascal - Corrimiento de Matriz

 
Vista:

Corrimiento de Matriz

Publicado por John (1 intervención) el 02/07/2021 02:55:16
Necesitaria ayuda para poder resolver este ejercicio
lo e intentado pero no llego a anda

Se tiene una matriz MatNum de MAXFIL x MAXCOL enteros. Esta matriz está inicializada,
sin ceros, y sin ningún orden. Se pide que resuelva el siguiente problema:
- Por cada columna, se eliminen las secuencias de números donde un mismo número se repita
más de una vez de manera consecutiva. La secuencia debe ser reemplazada por sólo uno de los
números que se repiten, y el resto de las celdas se debe completar con ceros. Los ceros deben
quedar SIEMPRE al final de cada columna.
- Ordenar descendentemente la matriz por columnas de acuerdo a la cantidad de ceros que
tenga cada una. A igual cantidad de ceros, es lo mismo en que posición quedan
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
sin imagen de perfil
Val: 36
Ha aumentado su posición en 4 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

Corrimiento de Matriz

Publicado por Armando José (43 intervenciones) el 07/07/2021 03:20:27
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
(*  ¿esto es lo que quierez con matriz ? *)
 
program tez;
uses crt;
const
    maxi = 10 ;
type
  arre = array[1..maxi] of integer;
var
   A , B : arre ;
   x, i : integer ;
 
function cuenta(nu :integer; ss:arre):integer;
var
    y, con : integer;
begin
   con := 0;
   for y :=1 to maxi do
  begin
      if ((nu<>0) and  (ss[y] = nu))then
      begin
          inc(con);
      end;
   end;
   cuenta := con;
end;
 
 
function posiprimero(nu :integer;  ss:arre):integer;
var
    y, con : integer;
begin
    con := 0;
    for y :=1 to maxi do
    begin
        if ((nu<>0) and  (ss[y] = nu)) then
        begin
           inc(con);
       end;
       if (con = 1) then
       begin
           posiprimero := y;
           break ;
       end;
   end;
end;
 
function posisegundo(nu :integer; ss:arre):integer;
var
    y, con : integer;
begin
    con := 0;
    for y :=1 to maxi do
    begin
         if ((nu<>0) and (ss[y] = nu)) then
         begin
             inc(con);
         end;
         if (con = 2) then
         begin
             posisegundo := y;
             break ;
         end;
    end;
end;
 
procedure burbuja(var vect : arre ; n:integer );
var
    temp, i , j : Integer ;
begin
     temp := 0 ;
     for i := 1 to n-1 do
        for j := i+1 to n do
             if (vect[i] < vect[j]) then
             begin
                  temp := vect[i] ;
                 vect[i] := vect[j] ;
                 vect[j] := temp ;
             end;
end;
 
begin
    clrscr;
    A[1] := 10;
    A[2] := 61;
    A[3] := 1;
    A[4] := 1;
    A[5] := 4;
    A[6] := 51;
    A[7] := 1;
    A[8] := 1;
    A[9] := 1;
    A[10] := 9;
 
    writeln(' arreglo orginal');
 
for i := 1 to maxi do
begin
    write(A[i]:3);
end;
 
writeln;
writeln(' arreglo dejando solo uno ');
 
for i := 1 to maxi do
begin
    case cuenta(A[i],A) of
          0 : continue ;
          1 :B[i] := A[i];
          else
          begin
              B[i] := A[posiprimero(A[i],A)];
             for x := posisegundo(A[i],A) to maxi do
             begin
                  if B[x] = A[x] then
                  begin
                      A[i] := 0;
                      b[i] :=0;
                 end;
            end;
         end;
   end;
end;
 
for i := 1 to maxi do
begin
   writeln(' ' ,i, ' ',B[i]:2);
end;
writeln(' arreglo ordenado');
burbuja(b , maxi );
writeln;
 
for i := 1 to maxi do
 begin
     writeln(' ' ,i, ' ',B[i]:2);
 end;
  readln;
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