Двойное уплотнение одномерного массива

[PavelDD]

Задание: надо удалить только третий повторяющийся элемент:
[1;2;2;3;3;3;4;5;5;5;5] --> [1;2;2;3;3;4;5;5;x;x;x], где х-мусор.
Обращаюсь с просьбой помочь.
Не получается перенести одинаковые элементы, превращенные в мусор, в конец массива.

uses crt;
const m=6;
var
    arr: array[0..1000] of integer;
    i, j, k, l: integer;
begin
    randomize;
    for i := 1 to m do begin
        arr[i] := random(4)+4;
        write (arr[i]:4);
    end;
    {сортировка}
    writeln; writeln;
    for i := 1 to m-1 do
        for j := 1 to m-i do
            if arr[j] > arr[j+1] then begin
                k := arr[j];
                arr[j] := arr[j+1];
                arr[j+1] := k;
            end;
    writeln;
    write('Отсортированный массив: ');
    writeln;
    for i := 1 to m do
        write (arr[i]:4);
   {уплотнение, которое удаляет только 3 повторяющийся элемент}
    writeln;
    writeln('После уплотнения:  ');
    for i:= 1 to m-1 do
     for j:= 1 to m-i do begin
       if (arr[j]=arr[j+2]) and (arr[j+2]=arr[m]) then
          arr[m]:=0;
       if arr[j]=arr[j+2]  then begin
          arr[j+2]:=0;
          j:=j+2;
       end;

     end;


    //здесь надо вставить перемещение



   for i:=1 to m do
     write(arr[i]:4);
   readln;
end.

[BDA]

Вроде работает

const
  m = 6;

var
  arr: array [1 .. m] of integer;
  i, j, k: integer;

begin
  { заполнение }
  randomize;
  for i := 1 to m do
  begin
    arr[i] := random(4) + 4;
    write(arr[i]:4);
  end;
  writeln;
  { сортировка }
  for i := 1 to m - 1 do
    for j := i + 1 to m do
      if arr[i] > arr[j] then
      begin
        k := arr[j];
        arr[j] := arr[i];
        arr[i] := k;
      end;
  writeln('Отсортированный массив: ');
  for i := 1 to m do
    write(arr[i]:4);
  writeln;
  { уплотнение, которое удаляет только 3 повторяющийся элемент }
  writeln('После уплотнения:  ');
  j := 1;
  k := 1;
  for i := 2 to m do
  begin
    if arr[i - 1] <> arr[i] then
      k := 1
    else
      inc(k);
    inc(j, ord(k < 3));
    arr[j] := arr[i];
  end;
  inc(j);
  for j := j to m do
    arr[j] := 0;
  for i := 1 to m do
    write(arr[i]:4);
  readln;
end.

Изменил сортировку (написал ту, которую лучше знаю).

Судя по Вашему примеру, нужно сделать так, чтобы каждый элемент встречается не более 2 раз.

[PavelDD]

inc(j, ord(k < 3));
Выдает ошибку: "функция ORD с параметрами указанных типов не найдена"

[BDA]

Тогда вместо этой строки напишите if k < 3 then inc(j);.

[PavelDD]

Все работает. Большое спасибо.

[BDA]

Пожалуйста. А по тому вопросу нужно думать - не могу ничего посоветовать так сразу.
Если Вам еще требуется ответ на него, то зря удалили

[PavelDD]

Вопрос открыт.
" Уплотнение, совмещенное с сортировкой. Это нужно модифицировать простые вставки." С чего начать?
Заранее благодарю.

[BDA]

Вроде работает

const
  m = 6;

var
  arr: array [1 .. m] of integer;
  i, j, z, k: integer;

begin
  { заполнение }
  randomize;
  for i := 1 to m do
  begin
    arr[i] := random(4) + 4;
    write(arr[i]:4);
  end;
  writeln;
  { сортировка и уплотнение }
  for i := 1 to m do
  begin
    k := arr[i];
    z := i - 1;
    while (z > 0) and (arr[z] > k) do
      dec(z);
    if (z > 1) and (arr[z] = k) and (arr[z - 1] = k) then
      arr[i] := 999
    else
    begin
      for j := i - 1 downto z do
        arr[j + 1] := arr[j];
      arr[z + 1] := k;
    end;
  end;
  for i := 1 to m do
    write(arr[i]:4);
  readln;
end.

[PavelDD]

Большое спасибо.Все работает.