[flips]

Как записать условие для удаления повотряющихся и как удалить повторяющиеся все элементы.
Вот мой код для этой подпрограммы, что нужно исправить/дописать?

Код:

procedure DelEvenElement(var a:TArray100;var cnt:integer);
 var i,j:integer;
begin
{i:=1;
 while i<=cnt do
  begin}
  for i:=cnt downto 1 do
   if a[i]=a[i+1] then
    begin
     for j:=i to cnt do
      a[j]:=a[j+1];
      cnt:=cnt-1;
    {end
   else
    i:=i+1;}
    end;
end;

[lmikle]

Код:

for i := High(a) downto Low(a)+1 do
  for j := i - 1 downto Low(a) do
    if a[i] = a[j] then 
      begin
        a[i] := 0;  // Ну или как ты там собираешься удалять.
        break;
      end;

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

[flips]

Ладно, а как реализовать удаление?

[flips]

Ну люди помогите, пожалуйста, очень нужно

[Страдалецъ]

Для начала скажи что это за тип TArray100 ?

[flips]

Тип массива назван для удобства.
А тип объявил так:
type
TArray100=array[1..100]of integer;

[lmikle]

Это статический массив. Ты все-равно не можешь физически удалить в нем элемент. Ты можешь только пометить его как удаленный. Либо переделывай на динамический, либо надо изобретать механизм, указывающий, что элемент удален.

[flips]

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

[Страдалецъ]

Есть логическое и физическое удаление. В случае с физическим удалением размер массива меняется в зависимости от количества элементов, а вот в случае логического удаления размер массива будет неизменным, но количество элементов может менятся.
Удаление элементов из статического массива можно реализовать таким образом:

Код:

Type
TArray100=array[1..100]of integer;
Var
 Arr: TArray100;
 ArrSize: Integer; // Переменная отвчающая за количество элементов в массиве.
begin
 ArrSize := 100;
 for i := 1 to ArrSize do Arr[i] := Random(100); //Заполним массив 
 ArrSize := 99;
 for i := 50 to ArrSize do Arr[i] := Arr[i+1];  //Удаляем 50-й элемент из массива 
end;

Т.е. физически массив как был 100 элементов, так и остался. Удаление элемента, это фактически сдвиг всех последующих после удаляемого элемента к началу. Для получения крайней границы массива мы используем переменную ArrSize

[flips]

Тогда у меня правильно реализовано удаление, код подпрограммы в первом посту.
Я массив сортирую для удобного удаления, но задача моя удалить все повторяющиеся элементы, а у меня удаляет все, кроме последнего повторяющегося элемента. Например 5 1 2 4 8 9 5 4 5 5 4, то удаляет все 4 и 5 кроме последних После моей процедуры получится такой новый массив 1 2 4 5 8 9, а мне нужно получить такой массив 1 2 8 9. То есть удалить все 4 и 5.
Может с условием что-то не так?

Извините пожалуйста, если вас заставил делать ту же работу, которую проделал я.

[lmikle]

делай копированием - не ошибешься.

Код:

var
  A, B : Array Of Integer;
  I, J : Integer;
  F: Boolean;
begin
  // Инициализируем исходный массив
  SetLength(A, 100);
  For I := Low(A) To High(A) Do A[i] := Random(50);
  
  // Удаление методом копирования
  // просто создаем новый массив
  setLength(B,0);
  For I := Low(A) To High(A) Do
  Begin
    F := True;
    For J := Low(B) To High(B) Do
      If A[i] = B[j] Then
         Begin
           F := False;
           Break;
         End;
   If F Then
     Begin
        setLength(B,Length(B)+1);
        B[High(B)] := A[i];
     End;
  End;
end;

в конце работы программы получишь массив B, в котором нет повторяющихся элементов.

[flips]

1. Выдает ошибку о несовместимости типов.
2. Исходный массив я уже передаю по ссылке.
Вот код всех моих подпрограмм:
Создание массива

Код:

procedure createRandomArray(var a:TArray100;cnt,modul:integer);
 var i:integer;
begin
 randomize;
 for i:=1 to cnt do a[i]:=random(modul);
end;

Вывод массива в строку

Код:

function ArrayToStr(const a:TArray100;cnt:integer):string;
 var i:integer;
begin
 result:='';
 for i:=1 to cnt do
  result:=result+intToStr(a[i])+' ';
end;

Получение массива из строки

Код:

procedure getArrayFromStr(var a:TArray100;var cnt:integer; const s:string);
 var wep:integer; w:string[20];s1:string;
begin
 s1:=s;
 cnt:=0;
 while length(Trim(s1))>0 do
  begin
   s1:=Trim(s1);
   wep:=Pos(' ',s1);
   if wep=0 then
    wep:=length(s1)
   else
    wep:=wep-1;
   w:=copy(s1,1,wep);
   delete(s1,1,wep);
   cnt:=cnt+1;
   a[cnt]:=strtoint(w);
  end;
end;

Вывод массива в Memo

Код:

procedure showArrayInMemo(const a:TArray100;cnt:integer;Memo1:TMemo);
 var i:integer;
begin
 Memo1.Clear;
 for i:=1 to cnt do
 begin
  Memo1.Lines.Add(inttostr(a[i]));
 end;
end;

Сортировка массива

Код:

procedure SortArray(var a:TArray100;cnt:integer);
 var last,x,i:integer;ok:boolean;
begin
 last:=cnt;
 repeat
  ok:=true;
  for i:=1 to last-1 do
   if a[i]>a[i+1] then
    begin
     x:=a[i];
     a[i]:=a[i+1];
     a[i+1]:=x;
     ok:=false;
    end;
  until ok;
end;

Ну и наконец удаление элементов массива

Код:

procedure DelEvenElement(var a:TArray100;var cnt:integer);
 var i,j:integer;
begin
 for i:=cnt downto 1 do
  if a[i]=a[i+1] then
   begin
    for j:=i to cnt do
       a[j]:=a[j+1];
     cnt:=cnt-1;
   end;
end;

[flips]

Ну выложил я коды своих процедур, как мне изменить свою процедуру удаления элементов из массива?
В написаной программе выдает ошибку о несовместимости типов в этих строках

Код:

setLength(B,0);

Код:

 setLength(B,Length(B)+1);

[roamer]

Если использование именно массива:
TArray100=array[1..100]of integer;
это не жесткое условие задачи.
То, как вариант, можно использовать TStrings...

--------------- Sorry, не заметил, что вариант уже предлагался.
Надо удалить это сообщение.

[Bargest]

Код:

procedure DelEvenElement(var a:TArray100;var cnt:integer);
 var i,j:integer;
begin
 for i:=cnt downto 1 do
  if a[i]=a[i+1] then
   begin
    for j:=i to cnt do
       a[j]:=a[j+1];
     cnt:=cnt-1;
   end;
end;

Это значит: "просмотреть все элементы с последнего до первого, и если два подряд повторяются - удалить.
А надо: "просмотреть все элементы с последнего до первого, и если в промежутке между первым и текущим есть еще один текущий - удалить текущий".
Думаю примерно так:

Код:

procedure DelEvenElement(var a:TArray100;var cnt:integer);
 var i,j,k:integer;
begin
  i:=cnt;
  while i>=1 do
  begin
   for k:=1 to i-1 do
     if a[i]=a[k] then
        begin
         for j:=i to cnt do
               a[j]:=a[j+1];
         cnt:=cnt-1;
         break;
        end;
   dec(i);
  end;
end;

Или если надо удалить ВСЕ вхождения элемента - то как-то так:

Код:

procedure DelEvenElement1(var a:TArray100;var cnt:integer);
 var i,j,k:integer;
  fl:boolean;
begin
  i:=cnt;
  while i>=1 do
    begin
      fl:=false;
      k:=1;
      while k<= i-1 do
      begin
       if a[i]=a[k] then
       begin
        fl:=true;
        for j:=k to cnt do
         a[j]:=a[j+1];
        cnt:=cnt-1;
        dec(i);
       end;
       inc(k);
      end;
      if fl then
      begin
      for j:=i to cnt do
       a[j]:=a[j+1];
      cnt:=cnt-1;
      end;
    dec(i);
    end;
 end;

Оба кода протестил - вроде пашет.
З.Ы. при удалении элементов лучше не юзать FOR-циклы: у них количество итераций определяется сразу, и от изменения границ внутри цикла ниче не меняется.