Удалить из массива наиболее длинную последовательность его нулевых элементов. Pascal

[Skankhunt02]

Доброго времени суток, прошу помощи по следующей задаче:
Дан одномерный числовой массив. Удалить из массива наиболее длинную последовательность его нулевых элементов. Если удаление элементов невозможно, выдать об этом сообщение.
Удаление элементов из массива оформить в виде подпрограммы.
Я пробовал разными способами и очень долго пытался достичь правильной работы программы. И сейчас решил обратиться за помощью.
___________________________________ _________________________
вот кусок программы который должен подсчитать количество нулей в максимальной длины их последовательности. никак не могу исправить...

const n=10;
var
a:array[1..n] of integer;
k,x,z,c,i,b,p:integer;
begin
  for i:=1 to n do
  readln(a[i]);
  for i:=1 to n do
  write(a[i],' ');
  p:=1;
    for i:= 1 to n do begin {повтор для всех чисел}
    b:=1;                     {обнуляем для повторного подсчета нулей}
      if a[i]=0 then begin    
      c:=i;
      
      for k:= c to n-1 do  {от i-ного элемента по конец}
       if (a[k]=0) and (a[k+1]=0) then  b:=b+1;  {считаем последовательность нулей}
       
       end;
       if (p<b) then p:=b;
       
       end;
       
       
    writeln(p);
    end.

если у вас имеется возможность составить программу полностью, буду очень признателен!!!

[Plague]

const n=20;
var k,mk,mi,i:integer;
    a:array[1..n] of integer; 
begin
  for i:=1 to n do
    begin
      a[i]:=random(2);
      write(a[i],' ');
    end;
  writeln;
  
  k:=0;
  mk:=0;
  mi:=-1;
  for i:=1 to n do
    if a[i]=0 then k:=k+1 else 
      begin
        if k>mk then 
          begin
            mk:=k;
            mi:=i-k;
          end;
        k:=0;
      end;
  if k=n then
    begin
      mk:=n;
      mi:=1;
    end;
  writeln('Наиболее длинная подпоследовательность нулевых элементов');
  writeln('состоит из ',mk,' нулей');
  writeln('начинается c ',mi,' элемента');
end.

[Serge_Bliznykov]

Plague, есть баг в алгоритме - не обрабатываете нули в конце...
проверить можно, например, так:

  for i:=1 to n do
    begin
      a[i]:=random(2); if i>14 then a[i] := 0;
      write(a[i],' ');
    end;

исправить легко - так:

  k:=0;
  mk:=0;
  mi:=-1;
  for i:=1 to n do begin
    if a[i]=0 then k:=k+1;
    if (a[i]<>0) or (i=n) then
      begin
        if k>mk then
          begin
            mk:=k;
            mi:=i-k;
          end;
        k:=0;
      end;
  end;
  writeln('Наиболее длинная подпоследовательность нулевых элементов');
  writeln('состоит из ',mk,' нулей');
  writeln('начинается c ',mi,' элемента');

-------

Сообщение от Skankhunt02

Удалить из массива наиболее длинную последовательность его нулевых элементов.

если таких последовательностей несколько, то что делать?

Сообщение от Skankhunt02

Если удаление элементов невозможно, выдать об этом сообщение.

простите, а в каком случае это невозможно? если в массиве нет нулей совсем?
или если массив полностью состоит из нулей?

[Aleksandr H.]

Как реализуется удаление из массива (для классики(ТП7.0))?

N := N - mk

[Skankhunt02]

Сообщение от Serge_Bliznykov

Plague, есть баг в алгоритме - не обрабатываете нули в конце...
проверить можно, например, так:

  for i:=1 to n do
    begin
      a[i]:=random(2); if i>14 then a[i] := 0;
      write(a[i],' ');
    end;

исправить легко - так:

  k:=0;
  mk:=0;
  mi:=-1;
  for i:=1 to n do begin
    if a[i]=0 then k:=k+1;
    if (a[i]<>0) or (i=n) then
      begin
        if k>mk then
          begin
            mk:=k;
            mi:=i-k;
          end;
        k:=0;
      end;
  end;
  writeln('Наиболее длинная подпоследовательность нулевых элементов');
  writeln('состоит из ',mk,' нулей');
  writeln('начинается c ',mi,' элемента');

-------


если таких последовательностей несколько, то что делать?


простите, а в каком случае это невозможно? если в массиве нет нулей совсем?
или если массив полностью состоит из нулей?

Сообщение от Serge_Bliznykov

Plague,
если таких последовательностей несколько, то что делать?


простите, а в каком случае это невозможно? если в массиве нет нулей совсем?
или если массив полностью состоит из нулей?

Об этих случаях я совсем не подумал... наверное придется удалять последнюю по порядку последовательность. Этот вопрос не обговаривался, даже не знаю как лучше сделать.
А условие "Если удаление элементов невозможно, выдать об этом сообщение" при отсутствии нулей совсем, т.к. преподователь просит заполнение через random, соответсвенно все нули там не окажутся..

[Serge_Bliznykov]

Сообщение от Skankhunt02

т.к. преподователь просит заполнение через random, соответсвенно все нули там не окажутся..

ну, это не факт. и вероятность такого события тем больше, чем меньше размер массива n

вот поставьте в пример n=2.
Можете гарантировать, что все (оба) элемента массива будут не нулевые?

а если массив будет заполнять не random, а пользователь?
Он то уж вполне может все нули вбить.

Впрочем, это ваше дело - учитывать эту ситуацию или нет.

Сообщение от Skankhunt02

А условие "Если удаление элементов невозможно, выдать об этом сообщение" при отсутствии нулей совсем

это легко. если if mi < 0 then WriteLn('Нулей в массиве нет');

Сообщение от Skankhunt02

наверное придется удалять последнюю по порядку последовательность.

для поиска последней подпослдовательности код нужно исправить на:

      if k>=mk then
          begin
            mk:=k;
            mi:=i-k;
          end;

Сообщение от Aleksandr H.

Как реализуется удаление из массива (для классики(ТП7.0))?

угу. если не брать во внимание обычные статические массивы (а не указатели и выделяемую память), тогда нужно
1) переписать элементы, стоящие после удаляемых на место удаляемых.
2) уменьшить переменную N, в которой хранится размер массива.

p.s.
разумеется, n должна быть не константой.

ну, начало программы в классическом TP может выглядеть примерно так:

const MaxN=200;
var k,mk,mi,i, n:integer;
    a:array[1..MaxN] of integer; 
....
begin
    repeat
       WriteLn('Введите размер массива (от 1 до ',MaxN,'): ');
       ReadLn(n);
    until (n>0) and (n<=MaxN);
    for i:=1 to n do
    begin
      a[i]:=random(2);
    .............

[Skankhunt02]

Сообщение от Serge_Bliznykov

угу. если не брать во внимание обычные статические массивы (а не указатели и выделяемую память), тогда нужно
1) переписать элементы, стоящие после удаляемых на место удаляемых.
2) уменьшить переменную N, в которой хранится размер массива.

p.s.разумеется, n должна быть не константой.

Я сейчас попробовал сделать эту процедуру удаления последовательности, но делаю процедуры во второй раз, и не совсем понимаю как всё устроено...
не могли бы вы помочь написать эту процедуру конкретно для моей задачи ? Чтобы сразу как бы вся программа работала, удалила последовательность эту и вывела новый массив на экран...
заранее большое спасибо!!! и так уже многое объяснили

_____________
Избегайте лишнего цитирования. Не надо оставлять цитату, которая не нужна Вам при ответе!
Модератор

[Serge_Bliznykov]

Сообщение от Skankhunt02

Я сейчас попробовал сделать эту процедуру удаления последовательности, но делаю процедуры во второй раз, и не совсем понимаю как всё устроено...

покажите, как попробовали

[Skankhunt02]

Сообщение от Serge_Bliznykov

покажите, как попробовали

procedure udalen(i:integer; mi:integer;b:integer;a:real; с:integer; p:real; k:real; var SS:real);
begin
for i:=1 to mi do
b[a]:=p[a];
for a:=c to n do
b[a]:=p[a];
end;
я понимаю,что это бред конечно, но в моей голове пока только так)))
b[a] - нулевой массив

[Serge_Bliznykov]

ладно. держи готовый код за старания

const MaxN=200;
type TMyArray = array[1..MaxN] of integer;


procedure DeleteZero(indexBegin, countDeleted :integer; var Arr:TMyArray; var N : integer);
var i : integer;
begin
  if (indexBegin + countDeleted - 1)=N
    then {удалить надо хвост - просто изменяем размер и выходим}
      N := N - countDeleted
    else begin
      for i:=indexBegin+countDeleted to N do
        Arr[i-countDeleted] := Arr[i];
      N := N - countDeleted
    end;
end;


var k,mk,mi,i, n:integer;
    a:TMyArray;
begin
    repeat
       WriteLn('Введите размер массива (от 1 до ',MaxN,'): ');
       ReadLn(n);
    until (n>0) and (n<=MaxN);
  for i:=1 to n do
    begin
      a[i]:=random(2);
        if a[i]=1 then A[i] := i; // это чтобы вместо единиц были порядковые числа
      write(a[i],' ');
    end;
    WriteLn;
    
    
  k:=0;
  mk:=0;
  mi:=-1;
  for i:=1 to n do begin
    if a[i]=0 then k:=k+1;
    if (a[i]<>0) or (i=n) then
      begin
        if k>=mk then
          begin
            mk:=k;
            mi:=i-k;
            if (a[i]=0) and (i=n) then mi:=mi+1; {учесть и последний элемент}
          end;
        k:=0;
      end;
  end;

  if mk=0 then WriteLn('В массиве нет нулевых элементов')
  else
    if mk=n then writeLn('В массиве все нулевые, после удаления будет пустой массив!')
    else begin
      writeln('Наиболее длинная подпоследовательность нулевых элементов');
      writeln('состоит из ',mk,' нулей');
      writeln('начинается c ',mi,' элемента');
      writeln;
      
      DeleteZero(mi, mk, A, n);
      Write('Полученный массив: ');
      for i:=1 to n do
          write(a[i],' ');
    end;
end.