Самый эффективный способ удалить элементы в массиве

[ZW]

закинь сюда описание типа.

Control = record
speed:integer;
end;

DS1 = record
path:array of integer;
flagp:byte;
temp:array of integer;
etemp:array of Control;
end;
xarray = array of DS1;//это для процедуры удаления
DS2 = record
x:array of DS1;
flagx:byte;
Y:integer;
end;
DS3 = record
D:array of DS2;
flags:byte;
end;

var

DS:DS2;

надо выкидывать элементы из DS.d[i].x[j]
на поля flag* можно не обращать внимания, они не понадобились, скоро выкину

[debi12345]

закинь сюда описание типа.

Control = record
speed:integer;
end;


надо выкидывать элементы из DS.d[i].x[j]
на поля flag* можно не обращать внимания, они не понадобились, скоро выкину

Перестаньте стучаться в закрытую дверь - используйте связанные списки, типа :

rec1 = record
value: integer;
.. ( your data structures )
prev: ^rec1;
nex: ^rec1;
end;

Тогда удаление будет заключаться в освобождении памяти и корректировке "prev" & "next" соседних елементов - всего 3 команды.

Вообще, есть куча типов, реализующих этот принцип - начиная с TList, они спасут от возни с динамической памятью.
Лично я рекомендую контейнерные типы и методы из библиотеки MSEgui - там есть все, что душе угодно.

[ZW]

Перестаньте стучаться в закрытую дверь - используйте связанные списки, типа :

rec1 = record
value: integer;
.. ( your data structures )
prev: ^rec1;
nex: ^rec1;
end;

Тогда удаление будет заключаться в освобождении памяти и корректировке "prev" & "next" соседних елементов - всего 3 команды.

Вообще, есть куча типов, реализующих этот принцип - начиная с TList, они спасут от возни с динамической памятью.
Лично я рекомендую контейнерные типы и методы из библиотеки MSEgui - там есть все, что душе угодно.

Мне бы пример посмотерть...

[debi12345]

Вот что сам Мартин (автор MSEgui ) пишет :

==============
To delete an item of a dynamic array of any type do:
"
function dynarrayelesize(const typinfo: pdynarraytypeinfo): integer;
var
ti: pdynarraytypeinfo;
begin
ti:= typinfo;
{$ifdef FPC}
inc(pchar(ti),ord(ti^.namelen));
result:= ti^.elesize;
{$else}
inc(pchar(ti),length(ti^.name));
result:= ti^.elsize;
{$endif}
end;

type
integerarty = array of integer;
yourrecty = record
a: integer;
b: string;
c: integerarty;
end;
yourrecarty = array of yourrecty;

procedure deleteitem(var value: yourrecarty; const aindex: integer);
var
int1: integer;
begin
if (aindex < 0) or (aindex > high(value)) then begin
tlist.Error(SListIndexError, aindex);
end;
if high(value) = 0 then begin
value:= nil;
end
else begin
finalize(value[aindex]);
int1:= dynarrayelesize(pdynarraytypeinfo(typeinfo(yourrecarty)));
move((pchar(value)+int1*(aindex+1))^,(pchar(value)+int1*aindex)^,
int1*(high(value)-aindex));
fillchar(value[high(value)],sizeof(value[0]),0);
//prevent finalize
setlength(value,high(value));
end;
end;
"

Optimized version for one dimensional arrays:
"
procedure deleteitem(var value: yourrecarty; const aindex: integer);
//value = one dimensional array of type
const
dynarrayrecsize = sizeof(tdynarrayindex) + sizeof(ptrint);
var
int1: integer;
po1: ppointer;
begin
if (aindex < 0) or (aindex > high(value)) then begin
tlist.Error(SListIndexError, aindex);
end;
if high(value) = 0 then begin
value:= nil;
end
else begin
finalize(value[aindex]);
int1:= dynarrayelesize(pdynarraytypeinfo(typeinfo(yourrecarty)));
move((pchar(value)+int1*(aindex+1))^,(pchar(value)+int1*aindex)^,
int1*(high(value)-aindex));
po1:= pointer(value) - dynarrayrecsize;
reallocmem(po1,high(value)*int1+dynarrayrecsize);
pointer(value):= pointer(po1) + dynarrayrecsize;
dec(pdynarrayindex(pointer(value)-sizeof(tdynarrayindex))^);
end;
end;

"
Warning: not very well tested!

Martin
==================
Simplified version without dynarrayelesize:

"
type
integerarty = array of integer;
yourrecty = record
a: integer;
b: string;
c: integerarty;
end;
yourrecarty = array of yourrecty;

procedure deleteitem(var value: yourrecarty; const aindex: integer);
begin
if (aindex < 0) or (aindex > high(value)) then begin
tlist.Error(SListIndexError, aindex);
end;
if high(value) = 0 then begin
value:= nil;
end
else begin
finalize(value[aindex]);
move((pchar(value)+sizeof(value[0])*(aindex+1))^,
(pchar(value)+sizeof(value[0])*aindex)^,
sizeof(value[0])*(high(value)-aindex));
fillchar(value[high(value)],sizeof(value[0]),0);
setlength(value,high(value));
end;
end;
"

Martin
===============

[debi12345]

Продолжение :

> Do your versions consider possible memory fragmentation ?
> There're also special cases of dynarrays containing another arrays &
> dynamic objects in turn. Plain usage of "move" there turned incorrect
> because of fragmented ( uncontiniuos ) memory areas allocated to such
> complex types. For that, the people have been advised to use linked lists
> instead of dynarrays.

The used Procedure Finalize() frees strings and dynamic arrays in a record.
Classes must be freed by hand. The disadvantage of linked lists is that
there is no access by index (remember recno slowness in TBufDataset!).
The used move does not fragment memory, it shifts the items above the index
one down. Record fields of type dynamic array are always stored as a
pointer to the actual data, memory is fragmented anyway. The advantage is
that the memory size of the base array and therefore the size of the moved
memory area is small.

Martin

[jwv]

надо выкидывать элементы из DS.d[i].x[j]

т.е. надо удалить элемент DS.d[i].x[j]?

Код: Выделить всё

procedure TForm1.Button1Click(Sender: TObject);
type
  Control = record
    speed: integer;
  end;

  DS1 = record
    path:array of integer;
    flagp:byte;
    temp:array of integer;
    etemp:array of Control;
  end;

  xarray = array of DS1;
  DS2 = record
    x: xarray;
    flagx:byte;
    Y:integer;
  end;

  DS3 = record
    D: array of DS2;
    flags: byte;
  end;

procedure DeleteItem(var arr: xarray; const index: integer);
var s, d: Pointer;
    iCount: integer;
begin
  if (index < low(arr)) or (index > high(arr)) then
    raise ERangeError.Create('индекс за пределами масива!');

  with arr[index] do begin //уменьшаем количество ссылок на масивы path, temp, etemp
    path := nil;
    temp := nil;
    etemp := nil;
  end;

  if index < high(arr) then begin //если не последний элемент, то перемещаем данные
    iCount := SizeOf(DS1);
    s := Pointer(Integer(arr) + (index + 1) * iCount); //откуда
    d := Pointer(Integer(arr) + index * iCount); //куда

    move(s^, d^, iCount * (high(arr)-index));
   
    fillchar(arr[high(arr)],sizeof(DS1),0); //prevent finalize

  end;

  SetLength(arr, high(arr));
end;

var DS: DS3;
begin
  SetLength(DS.D, 1);
  SetLength(DS.D[0].x, 3);
  DS.D[0].x[0].flagp := 1;
  DS.D[0].x[1].flagp := 2;
  DS.D[0].x[2].flagp := 3;

  DeleteItem(DS.D[0].x, 1); //удаляем второй эл. масива
  DeleteItem(DS.D[0].x, 1); //удаляем последний эл. масива
  DeleteItem(DS.D[0].x, 0); //удаляем единственный эл. масива
end;


[jwv]

Вот что сам Мартин (автор MSEgui ) пишет :

==============
To delete an item of a dynamic array of any type do:
...

procedure deleteitem(var value: yourrecarty; const aindex: integer);
...
fillchar(value[high(value)],sizeof(value[0]),0); //prevent finalize
setlength(value,high(value));
...
===============

точно
перед setLength в предыдущем посте надо добавить
fillchar(arr[high(arr)],sizeof(DS1),0); //prevent finalize

[Mirage]

А зря. Есть в FPC такой баг-перестраховка на Var-аргументах :

--------------
proc ( var arg: array of integer; ..)
begin
..
setlength(arg, value)
..
end;
-------------

будет ругаться, зато :

----------------
type

integerarty = array of integer;

var
..

proc ( var arg: integerarty; ..)
begin
..
setlength(arg, value)
..
end;
-------------

работает на "ура"


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

Ничего удивительного. Ведь

Код: Выделить всё

proc ( var arg: array of integer; ..)

и

Код: Выделить всё

type
  integerarty = array of integer;
proc ( var arg: integerarty; ..)

разные вещи.
Первое - Open Array Parameters. Может принимать в ккачестве параметров не только динамические массивы, но и обычные. Поэтому SetLength и не работает. Без модификатора var вообще передается через стек.

Второе же - ожидается передача именно дин. массива.

Не знаю как в FPC, а в Delphi этот "баг" прописан в документации и является фичей.

По теме: самый быстрый способ удалить из массива элемент это заместить его последним эл-том массива (предварительно можно финализировать), а сам массив, сократить на единицу.

Порядок эл-тов при этом конечно не сохраняется, но это далеко не всегда реально нужно. А все эти Move'ы с дин. массивами чреваты. Все-таки дин. массивы это refcounted объекты и не стоит с ними так.

[Cheb]

А чем вас не устраивает банальная перестановка элемента с хвоста на место освобождаемого? Или порядок важен?

[ZW]

Вот что сам Мартин (автор MSEgui ) пишет :


Martin
==================
Simplified version without dynarrayelesize:

"
type
integerarty = array of integer;
yourrecty = record
a: integer;
b: string;
c: integerarty;
end;
yourrecarty = array of yourrecty;

procedure deleteitem(var value: yourrecarty; const aindex: integer);
begin
if (aindex < 0) or (aindex > high(value)) then begin
tlist.Error(SListIndexError, aindex);
end;
if high(value) = 0 then begin
value:= nil;
end
else begin
finalize(value[aindex]);
move((pchar(value)+sizeof(value[0])*(aindex+1))^,
(pchar(value)+sizeof(value[0])*aindex)^,
sizeof(value[0])*(high(value)-aindex));
fillchar(value[high(value)],sizeof(value[0]),0);
setlength(value,high(value));
end;
end;
"

Martin
===============

Опа... а вот это работает...
Правда есть два плохих момента:
1. почему то маты на SListIndexError
и самое плохое
2. я пока не понимаю как это работает:((((
Большое спасибо за подсказку...

[ZW]

Совсем идиотский вопрос: как сделать полную копию динамического массива(или записи) в другую переменную, а не отзеркалировать адрес, по которому хранятся данные?

[ZW]

А чем вас не устраивает банальная перестановка элемента с хвоста на место освобождаемого? Или порядок важен?

Желательно сохранить порядок.

[jwv]

Совсем идиотский вопрос: как сделать полную копию динамического массива(или записи) в другую переменную, а не отзеркалировать адрес, по которому хранятся данные?

если тип элемента масива простой (т.е. не дин. масив или длинная строка) например integer то можно с помощью move

Код: Выделить всё

type
  TMyType = record
    a, b: integer;
    s: ShortString;
  end;
  TArrayOfMyType = array of TMyType;

function CloneArrayOfMyType(const Arr: TArrayOfMyType): TArrayOfMyType;
begin
  SetLength(Result, length(Arr));
  move(Pointer(Arr)^, Pointer(Result)^, SizeOf(TMyType) * length(Arr));
end;


если в TMyType встречаеться дин.масив или длинная строка то тогда наверное поэлементного копирования не избежать
потому что после move "реальное" количество ссылок на них увеличивается, а "внутренний" счетчик ссылок нет, а когда "внутренний" счетчик до 0 дойдет, память занимаемая дин.масивом или длинной строкой вернётся в пул свободной памяти.

[Mirage]

Эффективное всеучитывающее копироваание дин. массива осуществляет функция Copy. RTFM наконец.

[ZW]

если тип элемента масива простой (т.е. не дин. масив или длинная строка) например integer то можно с помощью move

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

если в TMyType встречаеться дин.масив или длинная строка то тогда наверное поэлементного копирования не избежать
потому что после move "реальное" количество ссылок на них увеличивается, а "внутренний" счетчик ссылок нет, а когда "внутренний" счетчик до 0 дойдет, память занимаемая дин.масивом или длинной строкой вернётся в пул свободной памяти.

Если только пересчитать размер масивов и использовать эти значения для расчета для Move. Имеет смысл если массивы прямоугольные