Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »
Страницы: 1 2 3 4

Можно ли оптимизировать?


dmk ©   (15.07.17 10:19

Есть такая процедура, которая удаляет одинаковые наборы индексов точек.
Т.е. точки набор точек 3,4 = 4,3; 128, 7 = 7, 128 и т.д. Этот код удаляет дубликаты точек. Возможно ли ее оптимизировать?

function TZObject.RemoveEqualJoins: integer;
var
 Temp: array of TJoin;
 i, k, P, prevP: integer;
 N0, N1: integer;
 S0, S1: integer;

begin
 //Пока еще ничего не удалили
 Result := 0;

 if (FNumJoins > 1) then
 begin
   //Временный массив
   SetLength(Temp, FNumJoins);

   //Предыдущий прогресс
   prevP := -MAXINT;

   //Поиск одинаковых соединений
   for k := 0 to (FNumJoins - 1) do
   begin
     //Индексы точек
     S0 := FJoins[k].P0;
     S1 := FJoins[k].P1;

     //....................................

     //Цикл поиска соединений
     for i := (k + 1) to (FNumJoins - 2) do
     begin
       //Индексы точек
       N0 := FJoins[i].P0;
       N1 := FJoins[i].P1;

       //Помечаем одинаковые соединения на удаление
       if ((S0 = N0) and (S1 = N1)) or ((S0 = N1) and (S1 = N0)) then
       begin
         FJoins[i].P0 := -1;
         FJoins[i].P1 := -1;
       end;
     end;//for i

     //....................................

     //Сообщение о прогрессе
     P := Round(k / FNumJoins * 100);
     if (P <> prevP) and ((P mod 5) = 0) then
     begin
       SendMessage(GV_PROGRESSWND, WM_NEWPROGRESS, P, crBlue);
       prevP := P;
       Application.ProcessMessages;
     end;
   end;//for k

   k := 0;

   //Выбрасываем помеченные соединения
   for i := 0 to (FNumJoins - 1) do
   begin
     //Индексы точек
     S0 := FJoins[i].P0;
     S1 := FJoins[i].P1;

     //Добавляем в новый список не помеченные на удаление
     if (S0 <> -1) and (S1 <> - 1) then
     begin
       Temp[k].P0 := S0;
       Temp[k].P1 := S1;
       Inc(k);
     end;
   end;

   //Новый размер массива
   SetLength(FJoins, k);

   //Переписываем назад
   for i := 0 to (k - 1) do FJoins[i] := Temp[i];

   //Результат - кол-во удаленных точек
   Result := (FNumJoins - k);

   //Новое кол-во соединений
   FNumJoins := k;

   //Массив больше не нужен
   SetLength(Temp, 0);
 end;//if (FNumJoins <> 0)
end;


Игорь Шевченко ©   (15.07.17 10:23[1]

можно, берешь профилировщик, ищешь, где время тратится, и вперед.


Inovet ©   (15.07.17 20:33[2]

> [0] dmk ©   (15.07.17 10:19)
> 3,4 = 4,3

Это одинаковые или симметричные относительно y=x?


dmk ©   (16.07.17 01:23[3]

Это одинаковые с точки зрения индексов. Под индексами хранятся точки.
Если провести линию из точки 3 в точку 4 будет равносильно
если провести линию из точки 4 в точку 3. Это 3D-эшечка.
Когда 3D-модель создается, то там есть ребра. У этих ребер куча смежных линий.
Если дубликаты удалить, то модель рисуется раза в 2 быстрее.
Эта процедура находит одинаковые индексы. Хотелось бы побыстрее.
На 2-х миллионах полигонов тормоза жуткие. Она 2 миллиона элемнтов проверяет 2 миллиона раз. Вот и думаю, а как еще? Надо же каждый элемент сравнить с каждым.


ВладОшин ©   (16.07.17 09:41[4]

TJoin=?


> как еще?

не добавлять одинаковые
при добавлении считать одинаковость и не добавлять. Это должно быть быстрее, чем пересчитывать потом

TJoin - модифицировать, добавив доп.поле - индекс, = Ф(х,у) добавляемой точки, добавлять чтобы массив был отсортированным по этому полю
тогда при следующем добавлении не надо перебирать все на предмет дубля,
а только близкие по этому индексу


Sha ©   (16.07.17 10:58[5]

посмотри TShaIntegerBox отсюда http://guildalfa.ru/alsha/node/32


dmk ©   (16.07.17 15:15[6]

>не добавлять одинаковые
Это если редактор есть. В 3ds max нет удаления смежных граней.
Это чисто мое "изобретение".


dmk ©   (16.07.17 15:19[7]

//TJoin=?
type
 TJoin = packed record
 case integer of
   0: (P0, P1: integer); //Индексы точек
   1: (Points: array[0..1] of integer);
 end;


dmk ©   (16.07.17 15:25[8]

TJoin — просто соединение точек. Можно назвать линией или вектором.
3D-модели практически во всех современных редакторах описываются не прямыми координатами, а индексами в массиве координат. Поскольку у меня движок софтверный, то мне необходимо оптимизировать каждый шаг. Нашел такой способ - удаление смежных граней. Весьма эффективная оптимизация, а вот удалить их можно либо при записи в редакторе либо при загрузке в память (как у меня). Только весьма затратная операция по времени.


dmk ©   (16.07.17 15:31[9]

Это не удаляется просто так.
Если есть 2 прямоугольника с 2 одинаковыми точками,
то у них есть смежная грань. Эта грань на мой взгляд лишняя для отрисовки.
При кол-ве треугольников свыше 30000 например скорость начинает заметно падать.

type
 TTriFace = packed record
 case integer of
   0: (i0, i1, i2: integer); //индексы точек образующих треугольную поверхность
   1: (Points: array[0..2] of integer);
 end;

type
 TQuadFace = packed record
 case integer of
   0: (i0, i1, i2, i3: integer); //индексы точек образующих прямоугольную поверхность
   1: (Points: array[0..3] of integer);
 end;


Dimka Maslov ©   (16.07.17 19:51[10]

В теории графов это называется "матрица инцидентности". Позволяет сразу определить, какие рёбра графа инцидентны данной вершине и, соответственно, указать двоящиеся рёбра. Копать надо в ту сторону.


ВладОшин ©   (17.07.17 09:30[11]

понятно.

а как заполняется TJoin ?

к тому, что бы убедиться, что и ты понимаешь мою идею
т.е., т.к.  А xor B =  B xor A
может быть добавлять запись в массив FJoins следует упорядочив по значению  (P0 xor P1)
т.о. в FJoins все точки будут рядом, и не надо перебирать весь массив, а только пока
P0i xor P1i =P0j xor P1j


SergP ©   (17.07.17 10:53[12]

А почему бы не отсортировать массив (например с помощью быстрой сортировки) и потом не вычислить все что нужно удалить за один проход?

А если сортировать нельзя то можно создать массив индексов и его отсортировать.


dmk ©   (17.07.17 11:28[13]

>а как заполняется TJoin ?
Они уже заполнены. Читаются из файла.

Сначала идет массив точек:
# 3ds Max Wavefront OBJ Exporter v0.97b - (c)2007 guruware
# File Created: 04.06.2017 13:48:50

#
# object GeoSphere001
#

v  -0.3325 -0.1789 900.8138
v  805.3798 -0.1789 402.8562
v  248.6463 766.0991 402.8562
v  -652.1675 473.4069 402.8562
v  -652.1674 -473.7648 402.8562
v  248.6464 -766.4567 402.8562
v  651.5024 473.4070 -402.8562
v  -249.3113 766.0990 -402.8562
...
# 6252 vertices


Потом идет массив индексов образующих грань.
TJoin - это просто индексы из массива граней.
Т.е. первая грань описывается как набор из 3-х TJoin:
1. 1..13, 13..37, 37..1 - Треугольник
2. 13..14, 14..733, 733..13
и т.д. Просто связи точек, из которых получается модель.

g GeoSphere001
f 1 13 37
f 13 14 733
f 13 733 37
f 37 733 38
f 14 15 734
f 14 734 733
f 733 734 735
f 733 735 38
f 38 735 39
f 15 16 736
f 15 736 734
f 734 736 737
f 734 737 735
f 735 737 738
f 735 738 39
f 39 738 40
f 16 17 739
...
# 12500 faces


dmk ©   (17.07.17 11:30[14]

Так вот, обычно около половины граней (faces) имеет смежные линии.


dmk ©   (17.07.17 11:40[15]

Вот сетка внутри объекта. По ней видно структуру треугольников:
https://hostingkartinok.com/show-image.php?id=e476041bdcd4c422e783ddea40929510

Каждый треугольник - это 3 линии. Большинство из них смежные.
В данной картинке найдено 2484 лишних для отрисовки соединения.
Это хороший профит по времени. До 50 тыс. алгоритм удаляет терпимо,
а там где сотни тысяч или миллионы - уже очень долго ждать. Минуты.


dmk ©   (17.07.17 11:42[16]

Т.е. по сути тормозит этот кусок кода:
//Поиск одинаковых соединений
  for k := 0 to (FNumJoins - 1) do
  begin
    //Индексы точек
    S0 := FJoins[k].P0;
    S1 := FJoins[k].P1;

    //....................................

    //Цикл поиска соединений
    for i := (k + 1) to (FNumJoins - 2) do
    begin
      //Индексы точек
      N0 := FJoins[i].P0;
      N1 := FJoins[i].P1;

      //Помечаем одинаковые соединения на удаление
      if ((S0 = N0) and (S1 = N1)) or ((S0 = N1) and (S1 = N0)) then
      begin
        FJoins[i].P0 := -1;
        FJoins[i].P1 := -1;
      end;
    end;//for i

    end;
  end;//for k


Sha ©   (17.07.17 14:15[17]

Добавил в исходники статьи о словарях класс TShaTaggedObjectDictionary для работы с произвольными бинарными данными (текст пока старый).
см. http://guildalfa.ru/alsha/node/32

На E6850 обрабатывает 2*10^6 соединений, среди которых 10^6 дубликатов, примерно за 250 мсек.
Точки в каждом соединении хранятся упорядоченно.


unit Demo1F;

interface

uses
 ShaDictionaries, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Memo1: TMemo;
   procedure Button1Click(Sender: TObject);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

type
 PJoin= ^TJoin;
 TJoin= record
   x1, y1, x2, y2: integer;
   end;

var
 Join: array of TJoin;

function MyCompareFunc(const Tag; AObject: pointer): integer;
var
 t: TJoin absolute Tag;
 p: PJoin absolute AObject;
begin;
 Result:=(t.x1 xor p.x1) or (t.y1 xor p.y1)
      or (t.x2 xor p.x2) or (t.y2 xor p.y2);
 end;

function MyHashFunc(const Tag): integer;
var
 t: TJoin absolute Tag;
begin;
 Result:=t.x1 + 19*t.y1 + 29*t.x2 + 43*t.y2;
 end;

procedure TForm1.Button1Click(Sender: TObject);
const
 OriginalCount= 1000*1000;
 RandomMod= 125125;
var
 D: TShaTaggedObjectDictionary;
 i, z: integer;
 ticks: cardinal;
begin;
 Randomize;
 SetLength(Join, 2*OriginalCount);
 for i:=0 to OriginalCount-1 do with Join[i] do begin;
   x1:=Random(RandomMod);
   y1:=Random(RandomMod);
   x2:=Random(RandomMod);
   y2:=Random(RandomMod);
   if (x2<x1) or (x2=x1) and (y2<y1) then begin;
     z:=x1; x1:=x2; x2:=z;
     z:=y1; y1:=y2; y2:=z;
     end;
   Join[i+OriginalCount]:=Join[i];
   end;
 D:=TShaTaggedObjectDictionary.Create(0, false, MyCompareFunc, MyHashFunc);
 ticks:=GetTickCount;
 for i:=0 to Length(Join)-1 do D.Add(Join[i], @Join[i]);
 ticks:=GetTickCount-ticks;
 Memo1.Lines.Add(Format('%d  %d',[ticks, D.Count]));
 end;

end.


han_malign ©   (17.07.17 15:25[18]

простой вариант(проверок меньше на количество коллизий, но те же O(N*N))
unique:= 0;
for k:= 0 to (FNumJoins - 1) do begin
   sort:= ord(FJoins[k].P0 > FJoins[k].P1) and 1;
   S0:= FJoins[k].Points[sort];
   S1:= FJoins[k].Points[sort xor 1];
   match:= 0;
   while( match < unique )do begin
       sort:= ord(FJoins[i].P0 > FJoins[i].P1) and 1;
       N0:= FJoins[i].Points[sort];
       N1:= FJoins[i].Points[sort xor 1];
       if( (S0 = N0) and (S1 = N1) )then
           break;
       inc(match)
   end;
   if( match = unique )then begin
       FJoins[unique]:= FJoins[k];
       inc(unique);
   end;
end;
FNumJoins:= unique;

Правильней всё-таки отдельный сортированный индекс уникальных рёбер(пара точек нормализуется указанным выше способом) - O(N*logN)...
Как вариант( O(N) ) - хэш по меньшему индексу точки - соотвественно в корзине хэша список рёбер из этой точки.


Sha ©   (17.07.17 20:31[19]

При косвенном обращении к координатам точек скорость получается в полтора раза ниже (280 мсек):
type
 PJoinIndirect= ^TJoinIndirect;
 TJoinIndirect= record
   i1, i2: integer;
   end;

var
 Points: array of TPoint;
 JoinIndirect: array of TJoinIndirect;

function MyCompareIndirect(const Tag; AObject: pointer): integer;
var
 t: TJoinIndirect absolute Tag;
 o: PJoinIndirect absolute AObject;
begin;
 Result:=(Points[t.i1].x xor Points[o.i1].x) or (Points[t.i1].y xor Points[o.i1].y)
      or (Points[t.i2].x xor Points[o.i2].x) or (Points[t.i2].y xor Points[o.i2].y);
 end;

function MyHashIndirect(const Tag): integer;
var
 t: TJoinIndirect absolute Tag;
begin;
 Result:=Points[t.i1].x + 19*Points[t.i1].y + 29*Points[t.i2].x + 43*Points[t.i2].y;
 end;

procedure TForm1.Button2Click(Sender: TObject);
const
 OriginalCount= 1000*1000;
 RandomMod= 125125;
var
 D: TShaTaggedObjectDictionary;
 i, z: integer;
 ticks: cardinal;
begin;
 Randomize;
 SetLength(Points, 2*OriginalCount);
 for i:=0 to OriginalCount-1 do begin;
   Points[2*i].x:=Random(RandomMod);
   Points[2*i].y:=Random(RandomMod);
   Points[2*i+1].x:=Random(RandomMod);
   Points[2*i+1].y:=Random(RandomMod);
   if (Points[2*i+1].x<Points[2*i].x)
   or (Points[2*i+1].x=Points[2*i].x) and (Points[2*i+1].y<Points[2*i].y) then begin;
     z:=Points[2*i].x; Points[2*i].x:=Points[2*i+1].x; Points[2*i+1].x:=z;
     z:=Points[2*i].y; Points[2*i].y:=Points[2*i+1].y; Points[2*i+1].y:=z;
     end;
   end;
 SetLength(JoinIndirect, 2*OriginalCount);
 for i:=0 to OriginalCount-1 do with JoinIndirect[i] do begin;
   i1:=2*i;
   i2:=2*i+1;
   JoinIndirect[i+OriginalCount]:=JoinIndirect[i];
   end;
 D:=TShaTaggedObjectDictionary.Create(0, false, MyCompareIndirect, MyHashIndirect);
 ticks:=GetTickCount;
 for i:=0 to Length(JoinIndirect)-1 do D.Add(JoinIndirect[i], @JoinIndirect[i]);
 ticks:=GetTickCount-ticks;
 Memo1.Lines.Add(Format('%d  %d',[ticks, D.Count]));
 end;


Страницы: 1 2 3 4 версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо