Мастера 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

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


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;


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

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

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







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


Наверх

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