Сжать массив

[Vladimir-888]

Подскажите плиз, как сжать двумерный массив, удалив из него все элементы, модуль которых находится в интервале [a,b], а все освободившиеся в конце элементы заполнить нулями.

[p51x]

Пройти по массиву и удалить из него все элементы, для которых выполняется условие.

[Serge_Bliznykov]

p51x, коллега, Вы невнимательно прочитали тему и не обратили внимание на фразу "освободившиеся в конце элементы "...

Vladimir-888, по сути p51x прав.
Заводим индекс, куда писать, пишем только числа, которые не попадают в заданный интервал.
примерно так:

k:=0;
for i:=1 to MaxElement do
  if (Abs(Mass[i])<a) or (Abs(Mass[i])>b) then 
       {число не попало в интервал, нужно его сохранить в массив}
    begin
       inc(k);
       if k<>i then 
         {пишем, если только надо "сдвигать"
          если элемент и так на своём месте, писать его не 
           надо }
         Mass[k] := Mass[i];
    end;
  {всё. Теперь в K число оставленных элементов!}
  
  {занулим оставшиеся}
  for i:=K+1 to MaxElement do
     Mass[i] := 0;

[Stilet]

Когда-то я преподователей удивил вот таким финтом:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;
var a:array[1..5,1..5] of integer;
e,i,j:integer;
begin
 e:=0;
 for i:=1 to 5 do begin
  for j:=1 to 5 do begin
   a[i,j]:=random(10);write(a[i,j]:5);
    if (a[i,j] in [0]) then begin
     dec(e);
    end else
     a[e div 5+1,e mod 5+1]:=a[i,j];
    inc(e);
  end;writeln;
 end;writeln;
 {$o-}
 {Зачищаем остаток}
 for i:=e to 25 do
  a[i div 5+1,i mod 5+1]:=0;
  { TODO -oUser -cConsole Main : Insert code here }
 for i:=1 to 5 do begin
  for j:=1 to 5 do begin
   write(a[i,j]:5);
  end;writeln;
 end;writeln;
 readln;
end.

А че прикольно, шринковка так сказать на лету.

[Serge_Bliznykov]

А че прикольно, шринковка так сказать на лету.

Супер! Спасибо за код! Мне понравилось!

[Stilet]

Пользуйся на здоровье, хоть его конечно и оптимизировать неплохо бы, но я уж не стал заморачиваться.

[Vladimir-888]

Сообщение от
Заводим индекс, куда писать, пишем только числа, которые не попадают в заданный интервал.
примерно так:
[CODE

k:=0;
for i:=1 to MaxElement do
if (Abs(Mass[i])<a) or (Abs(Mass[i])>b) then
{число не попало в интервал, нужно его сохранить в массив}
begin
inc(k);
if k<>i then
{пишем, если только надо "сдвигать"
если элемент и так на своём месте, писать его не
надо }
Mass[k] := Mass[i];
end;
{всё. Теперь в K число оставленных элементов!}

{занулим оставшиеся}
for i:=K+1 to MaxElement do
Mass[i] := 0;

[/CODE]

это понятно, но для одномерного массива, а я никак не могу применить на двумерном, помогите

[Vladimir-888]

Vladimir-888, по сути p51x прав.
Заводим индекс, куда писать, пишем только числа, которые не попадают в заданный интервал.
примерно так:

k:=0;
for i:=1 to MaxElement do
  if (Abs(Mass[i])<a) or (Abs(Mass[i])>b) then 
       {число не попало в интервал, нужно его сохранить в массив}
    begin
       inc(k);
       if k<>i then 
         {пишем, если только надо "сдвигать"
          если элемент и так на своём месте, писать его не 
           надо }
         Mass[k] := Mass[i];
    end;
  {всё. Теперь в K число оставленных элементов!}
  
  {занулим оставшиеся}
  for i:=K+1 to MaxElement do
     Mass[i] := 0;

это понятно, но этот код для одномерного массива, а я никак не могу применить к двумерному, помогите

[romlo]

оберни всё в for b:=1 to maxInColumn do
begin
{тут этот код}
end;
mass[i] замени на mass[b,i];
mass[k] замени на mass[b,k];

[Serge_Bliznykov]

но этот код для одномерного массива, а я никак не могу применить к двумерному, помогите

хм, а чем Вам код Stilet из поста #4 не подходит?