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

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

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


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;


Sha ©   (17.07.17 21:14[20]

Чтобы уменьшить вероятность коллизий имеет смысл подобрать коэффицициенты хеш-функции,
например, такие коэффициенты удовлетворительно работают даже для x,y=0..31


function MyHashFunc(const Tag): integer;
const
 c1= 1041204193;
 c2= integer(int64(c1) * -1866451833);
 c3= integer(int64(c2) * -1866451833);
 c4= integer(int64(c3) * -1866451833);
var
 t: TJoin absolute Tag;
begin;
 Result:=c1*t.x1 + c2*t.y1 + c3*t.x2 + c4*t.y2;
 end;

function MyHashIndirect(const Tag): integer;
const
 c1= 1041204193;
 c2= integer(int64(c1) * -1866451833);
 c3= integer(int64(c2) * -1866451833);
 c4= integer(int64(c3) * -1866451833);
var
 t: TJoinIndirect absolute Tag;
begin;
 Result:=c1*Points[t.i1].x + c2*Points[t.i1].y + c3*Points[t.i2].x + c4*Points[t.i2].y;
 end;


Sha ©   (20.07.17 00:27[21]

обновил на сайте заметку о словарях,
добавил в примеры эту задачу


dmk ©   (20.07.17 10:46[22]

Нда. Только скорость не увеличивается.
Переделал для сравнения 64 битных переменых. Раза в 2 быстрее стало.
Но все равно на 1 миллионе тормозит жутко. Тут Хэш не поможет.

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

     //Повторный поиск соединений
     for i := (k + 1) to (FNumJoins - 2) do
     begin
       //Индексы точек
       Q1 := FJoins[i].P;

       //Помечаем одинаковые соединения на удаление
       if (Q0 = Q1) or (Q0 = Swap(Q1)) then FJoins[i].P := DQ.P;
     end;//for i
   end;//for k


Sha ©   (20.07.17 11:21[23]

> dmk ©
> Но все равно на 1 миллионе тормозит жутко. Тут Хэш не поможет.

Согласен, тебе не поможет пример на сайте,
который обрабатывает 2 миллиона линий
(из которых 1 миллион дубликатов) за 0.3 сек


dmk ©   (20.07.17 13:46[24]

Так у вас нет цикла вложенного в цикл.
Я не могу пристроить ваш код в свой. Не понимаю.
Мне каждое соединение надо проверить с каждым.
Как это сделать в одном цикле?


dmk ©   (20.07.17 13:56[25]

Если есть массив скажем из (65535*2) элементов, то получается (4294836225 * 2) разновариантных сравнения. Вы за один цикл сравниваете каждый элемент с каждым?


Sha ©   (20.07.17 14:04[26]

Сравнение каждого с каждым выполняется автоматически
при добавлении элемента в хеш-таблицу.

Функция OD.Add(Coord, @ColoredLines[i]) возвращает:
1. результат>=0, если удалось добавить (т.е. это не дубликат)
2. результат<0, если не удалось добавить (т.е. это дубликат)


dmk ©   (20.07.17 14:45[27]

Под 64 бита не работает :(


Sha ©   (20.07.17 15:45[28]

не хочет, наверно


ak   (31.07.17 17:16[29]

Если известно максимальное значения индексов и оно не слишком большое, тогда можно завести двумерный массив типа Boolean, например, он будет называться JoinExists. Заполняем его False.
Далее пробегаться по массиву исходных точек.
 Если JoinExists[Min(FJoins[i].P0, FJoins[i].P1), Max(FJoins[i].P0, FJoins[i].P1)] = True, значит такая точка уже была добавлена, пропускаем ее
 иначе добавляем точку в итоговый массив и заносим в JoinExists[Min(FJoins[i].P0, FJoins[i].P1), Max(FJoins[i].P0, FJoins[i].P1)] True


Sha ©   (31.07.17 20:26[30]

Там в статье похожее решение есть среди примеров.
Оно используется в качестве проверочного для решения с хеш-таблицей.


ak   (01.08.17 00:16[31]

Да, битовая карта. Сначала не дочитал статью до конца.


шел мимо   (01.08.17 23:46[32]

>>Можно ли оптимизировать?
Можно, но лучше сразу всё переписать


Sha ©   (02.08.17 19:46[33]

> шел мимо   (01.08.17 23:46) [32]
> Можно, но лучше сразу всё переписать

рецепт настолько универсален, что абсолютно бесполезен


шел мимо   (03.08.17 00:29[34]

>>что абсолютно бесполезен
)) не, абсолютно бесполезен код реализующий алгоритм "влоб", при этом еще вместе с ворочением точками делающий SendMessage и ProcessMessages напрямую


manaka ©   (03.08.17 11:06[35]

имхо, надо не перебирать готовый набор точек, а не давать вводить повторы при формировании набора.


Inovet ©   (03.08.17 11:40[36]

> [35] manaka ©   (03.08.17 11:06)
> а не давать вводить повторы при формировании набора

Где-то выше говорилось про 3D MAX.

> [6] dmk ©   (16.07.17 15:15)
> >не добавлять одинаковые
> Это если редактор есть. В 3ds max нет удаления смежных граней.


manaka ©   (03.08.17 13:06[37]


> dmk ©   (17.07.17 11:42) [16]
> Т.е. по сути тормозит этот кусок кода:


если я правильно поняла алгоритм:

предположим у тебя есть пять линий: 1 2 3 4 5 (предположим, что 1 совпадает с 3 и 5)
ты берешь 1, проверяешь на совпадение со всеми линиями и помечаешь 3 и 5 на удаление.
потом берется 2, проверяется, чисто
потом зачем-то берется 3 (удаленная) и проверяется и совпадает с 5 (тоже удаленной)

попробуй по другому:
берешь 1, проверяешь, пока не найдешь совпадение, помечаешь 1 на удаление и сразу переходишь к 2.

должно работать ма-а-аленько побыстрей


manaka ©   (03.08.17 13:17[38]

и зачем:

в первом цикле удалять
во втором копировать в новый массив с проверкой значений?

есть массив а1[m]
создаем массив а2[m]

k=0
в цикле по первому массиву
 если запись удалена, inc(k)
 если нет, копируем ее из а1 в а2
конец цикла
cоздаем массив a3(m-k)
копируем в него первые m-k записей a2
(не помню, можно ли просто обрезать длину a2)

тоже должно немного ускорить работу


dmk ©   (05.08.17 15:44[39]

Помечать надо потому, что проверка идет до конца цикла.
Все элементы должны быть сравнены друг с другом.

Добавил проверку на помеченные элементы - стало немного быстрее
из-за пропуска лишних циклов.


function TGLObject.RemoveEqualJoins: integer;
var
 Temp: array of TJoin;
 i, k, P, prevP: integer;
 Q0, Q1: QWord;
 DQ: TJoin;
 i0, i1: integer;

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

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

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

   //Метка для удаления
   DQ.P0 := -1;
   DQ.P1 := -1;

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

     //Повторный поиск соединений
     for i := (k + 1) to (FNumJoins - 2) do
     begin
       if (FJoins[k].P0 = -1) then Continue else Q1 := FJoins[i].P; //Индексы точек

       //Помечаем одинаковые соединения на удаление
       if (Q0 = Q1) or (Q0 = Swap(Q1)) then
       begin
         FJoins[i].P := DQ.P;
       end;
     end; //for i
   end; //for k

   k := 0;

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

     //Добавляем в новый список не помеченные на удаление
     if (Q0 <> DQ.P) then
     begin
       Temp[k].P := Q0;
       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;


dmk ©   (05.08.17 15:45[40]

А вариант который предложил Sha такой же тормозной, только тормозит при добавлении.
Не выходит пока каменный цветок. 100 тысяч элементов терпимо. 2 миллиона - можно на час погулять сходить.


dmk ©   (05.08.17 15:53[41]

Если кому интересно - могу исходники дать полные. Только без распространения.
Такая проблема обсуждалась между NVIdia и ATI. Решили оставить как есть - рисовать дубликаты. Где то на форумах читал.


Sha ©   (05.08.17 16:32[42]

> dmk ©   (05.08.17 15:45) [40]
> А вариант который предложил Sha такой же тормозной, только тормозит при добавлении.


Просто не умеешь готовить.

Может, стоит задуматься о смене профессии?


dmk ©   (05.08.17 18:51[43]

>Может, стоит задуматься о смене профессии?
Это вы не правильно задачу поняли. Я вам удушиться не предлагаю. Заметьте!
Давайте вежливо. Жизнь и так тяжелая штука :)


dmk ©   (05.08.17 18:59[44]

Я попробовал ваш метод. Проверка при добавлении. На 2-х млн точек очень долго ждать.
Точка добавляется так:

Массив[Индекс] := Индекс точки;
Нет ли такого индекса или индекса наоборот в массиве?
И так 2 факториал. Чего не так то?


Sha ©   (05.08.17 19:10[45]

Все не так. Ты не разобрался в решении.

Жизнь такая штука. Никто не обязан разбираться в твоем коде. А тебе постоянно придется разбираться в чужом.  

1. Скомпилируй и запусти мой код без изменений.
2. Убедись, что он отрабатывает за доли секунды
(ну, или сообщи о возникшей проблеме).
3. Адаптируй мой код под свои нужды.


Sha ©   (05.08.17 19:35[46]

И еще.

Когда будешь проводить замеры на моем примере, имей в виду,
что при малом размере квадрата и большом числе отрезков
вероятность сгенерировать уникальный отрезок
может оказаться равна 0 или близка к 0. А в реале она почти 1.

Поэтому, чтобы результат не уходил далеко от реальности необходимо
одновременно с увеличением числа отрезков увеличивать размер квадрата.


dmk ©   (05.08.17 21:37[47]

>Никто не обязан разбираться в твоем коде.
Я спросил, вы отозвались. Теперь вот сруливаете. Не вопрос.
Давайте вопрос этот закроем и разбежимся по кельям. Так же проще :)
Тем более я сделал переиндексацию индексов по порядку.
Делается почти мгновенно и ни одного повторного варианта по индексам.
Совпадения только по координатам точек. Теперь нужна  новая сортировка с 6-ю сравнениями.


Sha ©   (05.08.17 21:58[48]

>>Никто не обязан разбираться в твоем коде.

> dmk ©   (05.08.17 21:37) [47]
> Я спросил, вы отозвались. Теперь вот сруливаете. Не вопрос.

да нет, мне не слабо и весь код за тебя написать, но есть вопрос )


Sha ©   (05.08.17 22:14[49]

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

Попытался направить, но вижу, что зря.

Мы обсуждаем всякую фигню, типа кто срулил
или типа какой костыль подойдет лучше,
вместо выбора правильного алгоритма.

Продолжай ковырять. Извини, что помешал.


dmk ©   (06.08.17 00:07[50]

Вы первый недовольство проявили. Продолжу. Ибо надо. Спасибо за участие.


Inovet ©   (06.08.17 04:33[51]

> [50] dmk ©   (06.08.17 00:07)
> Вы первый недовольство проявили

Это ты про тормозной алгоритм Sha сказал, на что он ответил, что ты не умеешь готовить и подсказал рецепт. Так что кто тут чем недоволен?


dmk ©   (06.08.17 11:36[52]

Inovet ©   (06.08.17 04:33) [51]
А ты рефери что ли?


dmk ©   (06.08.17 11:39[53]

Это мне предложили профессию сменить. Я тут ни на кого не наезжал.
Всегда вежлив и тактичен.


Inovet ©   (06.08.17 12:55[54]

> [52] dmk ©   (06.08.17 11:36)
> А ты рефери что ли?

Это взгляд со стороны.


dmk ©   (06.08.17 13:12[55]

Ошибочный взгляд. Мы не ругаемся :) Мы бурно обсуждаем.
И вообще я к Sha очень положительно отношусь. И вообще к форумному народу в целом.
Так что не нагнетайте.


Игорь Шевченко ©   (06.08.17 19:52[56]

А я его еще больше Ку!


ВладОшин ©   (06.08.17 20:47[57]


> dmk ©   (17.07.17 11:28) [13]
> >а как заполняется TJoin ?
> Они уже заполнены. Читаются из файла.


Как?

Стандартных функций delphi аля LoadIntoTJoinsFromFile3dMax? насколько знаю, нет


ВладОшин ©   (06.08.17 23:56[58]

что получается..
не Sha, конечно (ну, тот крут! скачал-потестил примеры.. Круто!), но вроде, не очень долго тоже, а главное понятно )

 TJ = packed record
   P0, P1: Integer;
   X: integer; //  для xor
   d: Boolean; // дубль или нет
 end;

var
A: array[1..1000000] of TJ;

procedure qSort(l, r: integer); //сортировка
var
 i,j: integer;
 q: integer;
 O: TJ;
begin
 i := l;
 j := r;
 q := A[(l+r) div 2].X;
 repeat
   while (A[i].X < q) do inc(i);
   while (q < A[j].X) do dec(j);
   if (i <= j) then
   begin
     O := A[i];   // exch  [i] [j]
     A[i] := A[j];
     A[j] := O;
     inc(i); dec(j);
   end;
 until (i > j);
 if (l < j) then qSort(l,j);
 if (i < r) then qSort(i,r);
end;

procedure TForm1.btn1Click(Sender: TObject);
var
 i, j, N, M : integer;
begin
 N := 1000000; //линий
 M := 100;        // значений
 Randomize;
 for i := 1 to N do //инит
 begin
   A[i].P0 := Random(M);
   A[i].P1 := Random(M);
   A[i].X := A[i].P0 xor A[i].P1;
   A[i].d := False;  //пока все не дубль
 end;

 lb1.Caption := IntToStr(GetTickCount);
 QSort(1,N);

 i := 1;
 repeat
   j := i + 1;
   while A[i].X = A[j].X do
   begin
     A[j].d := ((A[j].P0 = A[i].P0) and (A[j].P1 = A[i].P1)) or ((A[j].P1 = A[i].P0) and (A[j].P0 = A[i].P1));
     inc(j);
   end;
   i := j;
 until i >= N;

 lb2.Caption := IntToStr(GetTickCount);

~ 0.25 сек

в массиве (A[i].d = True) у дублей, т.е. котрых можно выкинуть/не рисовать


manaka ©   (07.08.17 08:59[59]


> dmk ©   (05.08.17 15:44) [39]
> Помечать надо потому, что проверка идет до конца цикла.
> Все элементы должны быть сравнены друг с другом.
>


Они все равно будут сравнены.
смотри как будет быстро для массива a1[m]:

n=1;
for i=1 to m-1 do begin
 k=0;
 for j= i+1 to m do begin
   if a[j]=a[i] do begin
     k=1;
     break;
   end;
 end;
 if k=0 do begin
   a2[n]=a1[i]; // добавляется только уникальный элемент
   inc(n);
 end;
end;

Первые n элементов a2 - новый массив соединений


manaka ©   (07.08.17 09:22[60]


> Первые n элементов a2 - новый массив соединений


первые n-1 элементов


версия для печати

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

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







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


Наверх

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