[flips]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

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]

Код:

1 2 3 4 5 6 7

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]

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

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

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

Код:

1 2 3 4 5 6 7 8 9 10 11

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]

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

Код:

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

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. Исходный массив я уже передаю по ссылке.
Вот код всех моих подпрограмм:
Создание массива

Код:

1 2 3 4 5 6

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

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

Код:

1 2 3 4 5 6 7

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;

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

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

Код:

1 2 3 4 5 6 7 8 9

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;

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

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;

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

Код:

1 2 3 4 5 6 7 8 9 10 11

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]

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

Код:

1	setLength(B,0);

Код:

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

[roamer]

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

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

[Bargest]

Код:

1 2 3 4 5 6 7 8 9 10 11

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;

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

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;

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

Код:

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

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-циклы: у них количество итераций определяется сразу, и от изменения границ внутри цикла ниче не меняется.