Как оптимизировать определение границ произвольной фигуры ?

[zub]

Шестеренки оставим на потом, начнем с простого. просто тест точка на линии или нет. у меня на миллион линий ушло 0.016сек

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

program Project1;
uses
  sysutils;
const
  eps=1e-14;
type
  GDBvertex2DI=record
    x,y:integer;
  end;
function distance2line(var q:GDBvertex2DI;var p1,p2:GDBvertex2DI): double;
var t,w,p2x_p1x,p2y_p1y,qx_p1x,qy_p1y,qy_p2y,qx_p2x: double;
begin
  p2x_p1x:=p2.x-p1.x;
  p2y_p1y:=p2.y-p1.y;
  qx_p1x:=q.x-p1.x;
  qx_p2x:=q.x-p2.x;
  qy_p1y:=q.y-p1.y;
  qy_p2y:=q.y-p2.y;
  if((qx_p1x)*(p2x_p1x)+(qy_p1y)*(p2y_p1y))*((qx_p2x)*(p2x_p1x)+(qy_p2y)*(p2y_p1y))>-eps then
  begin
    t:= sqr(qx_p1x)+sqr(qy_p1y);
    w:= sqr(qx_p2x)+sqr(qy_p2y);
    if w<t then t:= w;
  end else
    t:= sqr((qx_p1x)*(p2y_p1y)-(qy_p1y)*(p2x_p1x))/(sqr(p2x_p1x)+sqr(p2y_p1y));
  result:= sqrt(t);
end;
var
  q,p1,p2:GDBvertex2DI;
  dist:double;
  myTime:TDateTime;
  ts:string;
  i:integer;
begin
  q.x:=100;q.y:=100;
  p1.x:=0;p1.y:=0;
  p2.x:=1000000;p2.y:=1000000;

  myTime:=now;
  //for i:=0 to 1000000 do //раскоментируй бкдет время потраченое на 1000000 линий.
  dist:=distance2line(q,p1,p2);
  str((now-myTime)*10e4:2:3,ts);
  if abs(dist)<eps then
    writeln('Point on line')
  else
    writeln('Point not on line');
  writeln(ts+'sec.');
  readln;
end.

Только пожалуйста именно для линии 0,0-1000000,1000000. Художники, вперед!

[vitaly_l]

Только пожалуйста именно для линии 0,0-1000000,1000000. Художники, вперед!

И ты надеешься, что столь сложная задача тебя спасёт? Наивный... Жди, сейчас сварганю.

[zub]

>>Жди, сейчас сварганю
нисколько не сомневаюсь

[vitaly_l]

нисколько не сомневаюсь

Ну вот как и обещал, код работает на порядок быстрее. В частности, при абсолютно равных условиях, код художников возвращает 0.003 и 0.001 секунды, а код программиста zub возвращает 0.021 и 0.024. Тобишь, как и говорилось изначально код художников, на порядок быстрее при 1000000 итераций .

Можете проверить, на форме только две кнопки, прилинкованные соответственно к : ButtonHudojnikiClick и ButtonProgramistZubClick.

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

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

const
  eps=1e-14;

type
  TLine=Array  [0..2] of byte;

  GDBvertex2DI=record
    x,y:integer;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    ButtonHudojniki: TButton;
    ButtonProgramistZub: TButton;
    procedure ButtonHudojnikiClick(Sender: TObject);
    procedure ButtonProgramistZubClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  bmp:TBitmap;

implementation

{$R *.lfm}

{ TForm1 }

function distance2line(var q:GDBvertex2DI;var p1,p2:GDBvertex2DI): double;
var t,w,p2x_p1x,p2y_p1y,qx_p1x,qy_p1y,qy_p2y,qx_p2x: double;
begin
  p2x_p1x:=p2.x-p1.x;
  p2y_p1y:=p2.y-p1.y;
  qx_p1x:=q.x-p1.x;
  qx_p2x:=q.x-p2.x;
  qy_p1y:=q.y-p1.y;
  qy_p2y:=q.y-p2.y;
  if((qx_p1x)*(p2x_p1x)+(qy_p1y)*(p2y_p1y))*((qx_p2x)*(p2x_p1x)+(qy_p2y)*(p2y_p1y))>-eps then
  begin
    t:= sqr(qx_p1x)+sqr(qy_p1y);
    w:= sqr(qx_p2x)+sqr(qy_p2y);
    if w<t then t:= w;
  end else
    t:= sqr((qx_p1x)*(p2y_p1y)-(qy_p1y)*(p2x_p1x))/(sqr(p2x_p1x)+sqr(p2y_p1y));
  result:= sqrt(t);
end;


procedure TForm1.ButtonHudojnikiClick(Sender: TObject);
var
  q:GDBvertex2DI;
  myTime:TDateTime;
  ts:string;
  i:integer;
  boTest:boolean;
  PLine:^TLine;
begin
  boTest := false;
  q.x:=100; q.y:=100;
  PLine := bmp.ScanLine[q.y];

  myTime:=now;

  for i:=0 to 1000000 do
      if PLine^[q.x]<>$f2 then boTest := true;

  str((now-myTime)*10e4:2:3,ts);

  if boTest
     then caption := 'Точка найдена за '+ts+' sec.'
     else caption := 'Точка не найдена за '+ts+' sec.';
end;

procedure TForm1.ButtonProgramistZubClick(Sender: TObject);
var
  q,p1,p2:GDBvertex2DI;
  dist:double;
  myTime:TDateTime;
  ts:string;
  i:integer;
begin
  q.x:=100;q.y:=100;
  p1.x:=0;p1.y:=0;
  p2.x:=9999;p2.y:=9999;

  myTime:=now;
  for i:=0 to 1000000 do
  dist:=distance2line(q,p1,p2);
  str((now-myTime)*10e4:2:3,ts);
  if abs(dist)<eps then
    caption := 'Точка найдена за '+ts+' sec.'
  else
    caption := 'Точка не найдена за '+ts+' sec.';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp:=TBitmap.Create;
  bmp.Canvas.Pen.Color   := clBlack;
  bmp.Canvas.Brush.Color := $f2;
  bmp.Width :=10000;
  bmp.Height:=10000;
  bmp.Canvas.FillRect(0,0,9999,9999);

  bmp.Canvas.MoveTo(0,0);
  bmp.Canvas.LineTo(9999,9999);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;

end.


[zub]

ну е маё.
1) я тебе дал код который ты взял и скомпилил. почему я должен чтото кудато привязывать? да еще и с такими названиями? ButtonHudojnikiClick - постыдился бы.
2) вижу линию 0,0-9999,9999 а вот линию 0,0-1000000,1000000 почемуто невижу((
3) а почему ты невключил время отрисовки во время замера? в твоем случае без отрисовки никак.

Устраняй 1 и 2 и пойдем дальше

[vitaly_l]

я тебе дал код который ты взял и скомпилил. почему я должен чтото кудато привязывать? да еще и с такими названиями? ButtonHudojnikiClick - постыдился бы.

код проекта зазипованный в приложении.

а вот линию 0,0-1000000,1000000 почемуто невижу((

Потому что, Tbitmap такие размеры не поддерживает при 32 Лазарусе.

а почему ты невключил время отрисовки во время замера? в твоем случае без отрисовки никак.

Во первых: нахрена там отрисовка, нужна? И кстати, ты тоже тогда включай в замер отрисовку. При честном тестировании, код должен быть поставлен в равные условия. Постольку поскольку, отрисовка в обоих случаях займёт одинаковое время, то ей можно пренебречь, а равно и другими идентичными равнозначными действиями.

Устраняй 1 и 2 и пойдем дальше

Да всё уже, тест пройден - некуда дальше ходить, разница на порядок, при равных условиях.

[Лекс Айрин]

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

Кстати, не факт, что это так. Ты картинку рисуешь полностью все точки, а zub, может позволить, допустим, не рисовать фон.

[vitaly_l]

Кстати, не факт, что это так. Ты картинку рисуешь полностью все точки, а zub, может позволить, допустим, не рисовать фон.

Если, zub - включит в код ещё и отрисовку картинки без фона, то его код станет медленнее на два порядка, а скорость кода художников - не изменится. Ответ, на столь странное и почти волшебное утверждение найдёте, на самой первой странице этого топика, в третьей сверху записи.


.

[Лекс Айрин]

vitaly_l, да ладно... с каких это пор лишние телодвижения ускоряют работу? Ладно бы оно сужало объем последующей работы...

Добавлено спустя 3 минуты 48 секунд:
Re: Как оптимизировать определение границ произвольной фигуры ?
И что в третьей сверху записи позволяет судить о том, что битмап обгоняет математику? Я вот абсолютно ничего не вижу.

[vitaly_l]

vitaly_l, да ладно... с каких это пор лишние телодвижения ускоряют работу? Ладно бы оно сужало объем последующей работы...

Добавлено спустя 3 минуты 48 секунд:
Re: Как оптимизировать определение границ произвольной фигуры ?
И что в третьей сверху записи позволяет судить о том, что битмап обгоняет математику? Я вот абсолютно ничего не вижу.

Скорость кода художников, будет на порядок быстрее, только при решении задачи, которую поставил топик стартер. При других условиях, код zub-а обгонит. Но конкретно в данной задаче, математика проиграет растровым изображениям по скорости теста на принадлежность пиксела.

.

[zub]

Рисовать что-то в условиях задачи небыло. Определяем принадлежность точки прямой. Если тебе нужна для этого отрисовка - будь добр включай ещё во время замера.
Также меня мало колышит что там поддерживает битмап. не можешь такого размера - просишь упростить задачу. Вне тупо врешь что ты делаешь быстрее

[pupsik]

Чёт я не понял:

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

  q.x:=100; q.y:=100;
  PLine := bmp.ScanLine[q.y];

вы "отсканили" одну строку (если не ошибаюсь: строка 100 с длинной 100),
а потом ганяете туды-сюды н раз

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

  for i:=0 to 1000000 do
      if PLine^[q.x]<>$f2 then boTest := true;

?
Неужели zub аналогично написал?

п.с.
ScanLine - по сути его нет в лазаре. Точнее: может вести себя неадекватно на разных системах. Вроде так в вики написано (может и ошибаюсь).

[Лекс Айрин]

vitaly_l, Это лишь декларация против декларации. При прочих равных условиях декларация zubа мне кажется ближе к реальному положению дел. У него как-то портфолио есть. Причем по нужной теме.

Да и попытка упростить код, при написании процедур, как-то не внушает доверия... очень похоже на намазывание спорных моментов.

[vitaly_l]

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

Я для вашего кода, тоже снизил условия до 9999 и, соответственно - поставил оба кода в совершенно равные условия. Мы здесь решаем задачу, топик стартера, а не проблемы амбиций личного эго. Но конкретно в задаче, поставленной топик стартером. Ваш код будет работать медленнее на порядок, что уже подтверждено тестом, который невозможно отрицать.

вы "отсканили" одну строку (если не ошибаюсь: строка 100 с длинной 100),
а потом ганяете туды-сюды н раз

Это правильный вопрос, вот только Вы тогда спросите и у zub-a, откуда он взял данные о линии? Почему ему можно скрыть эти вычисления? А? Ещё раз повторяю, для честного теста - условия должны быть равные! Если он будет каждый раз получать данные по линии, из какого-то массива, то и я тогда буду каждый раз получать адрес сканлайн линии. И согласитесь - скорость выполнения увеличится примерно на одинаковое кол-во времени, т.к. задачи равнозначные. Так что всё честно.

Рисовать что-то в условиях задачи небыло. Определяем принадлежность точки прямой. Если тебе нужна для этого отрисовка - будь добр включай ещё во время замера.

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

[pupsik]

vitaly_l - Ок...
Тогда, согласно "правил", поменяйте местом (ведь zub не замерял время цикла ):

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

  PLine := bmp.ScanLine[q.y];
  myTime:=now;

- время перед сканированием...
и произойдёт чудо оптимизации... У меня ваш код сработал в пределах 0,4. zub - 0,05. Так что: угу... на порядок оптимизировали.

п.с.
Советуют применять во время сканирование Begin...EndUpdate.
Ну..у и плюс вам необходимо подправить мелочи. А то уж слишком умён лазарь. Не чистая проверка получается.

Добавлено спустя 49 минут 9 секунд:
Re: Как оптимизировать определение границ произвольной фигуры ?
Да и оба теста, мало того что отдаленно равны, дык ещё и не соответствуют условию:

просто тест точка на линии или нет.

. Топчатся на одном месте в цикле и горя не знают. Странно всё это. Хотя и тема странная (тем более, как написал ТС:

это "квадратик вокруг кубика " ....НИГДЕ дальше не нужен

). И зачем тогда толочь воду?