Модератор: Модераторы
zub писал(а):но например простейшая линия что у тс, что у меня одинаковая
pupsik писал(а):Что произойдет с PLine после PLine := bmp.ScanLine[q.y];?

ничего это не значит. У вас сделана проверка цвета пикселя с определёнными координатами. А вот что дальше.... А дальше -нуль. Ну посчитали вы время цикла и что? Ну считаете что ScanLine не относится к алгоритму. Ну не правильно вы этот ScanLine использовали. Ну криво битмап выгрузили (из-за этого в лине у меня "мертвецы" валялись). Ну считаете begin..endupdate пошлостью (всё равно что это ускорило загрузку битмапа и показ формы). Ну не воспринимаете вы советы zub (хотя он не сильно то и программист, вроде у него профа иная). И т.д., и т.п.Если точка найдена, значит она уже на линии, т.к. кроме линии в задаче ничего больше нет.
 
 ох... Т.е. вы считаете что скачок времени произошёл из-за крутости алгоритма? Мдя..я: "Слышали звон, да не знаете где он". Лазарь не ругается, он делает ещё интереснее (гад такойт.к. это быстрее и Лазарус не ругается.
 ).
).pupsik писал(а):хотя он не сильно то и программист, вроде у него профа иная
pupsik писал(а): вы считаете что скачок времени произошёл из-за крутости алгоритма?
pupsik писал(а):У вас сделана проверка цвета пикселя с определёнными координатами.

vitaly_l писал(а):можно поставленную задачу - решать проще, а результат получать быстрее.
vitaly_l писал(а):Ну, встретились два "не программиста", ну обменялись знаниями и не знаниями.

ну да.. ну да. Вы практически это пробовали? У вас идеальная задача была, а вы только пиксель проверили. И не доказали что он "в линии". А вот куда интереснее будет когда с реальным изображением работать. И как "вытягивать" оттуда необходимое без, как вы выразились, математики?Цвет пикселя - это ID линии или фигуры, а дальше как в хорошей базе данных, что хотите, то и делаете.
хм..:Я ничего не считаю
- стало интересно..Жди, сейчас сварганю.
...Ну вот как и обещал, код работает на порядок быстрее. В частности, при абсолютно равных условиях, код художников возвращает 0.003 и 0.001 секунды, а код программиста zub возвращает 0.021 и 0.024. Тобишь, как и говорилось изначальнокод художников, на порядок быстрее при 1000000 итераций
- интерес потерялсято его код станет медленнее на два порядка, а скорость кода художников - не изменится
ну да : найти цвет по координатампросто показал, что: можно поставленную задачу - решать проще, а результат получать быстрее.
 
 вам бы тогда рисовать нечем было бы... Такие поделия тогда, при тех конфигах компов... вызвали бы шок и не только.И этот метод, известен мне очень давно, т.к. раньше все игры так делались
pupsik писал(а):ну да.. ну да. Вы практически это пробовали?
pupsik писал(а): И как "вытягивать" оттуда необходимое без, как вы выразились, математики?
pupsik писал(а):Такие поделия тогда, при тех конфигах компов... вызвали бы шок и не только.

э..э: вы о каком коде? Если о поиске цвета... то там, по сути, нет кода.этот максимально быстрый код
pupsik писал(а):Да и код хромает. Советую почитать доп. лит-ру.

хм... т.е. "мертвецы" висящие в системе - это не указание на ошибку? Разное (0,4 не могут резко стать 0,01 при почти одинаковых условиях) время срабатывание алгоритма - не указание на ошибки? э..э, а что тогда указание?Если видите что, я что-то не так написал в коде, то буду благодарен, если укажите на конкретную ошибку.
pupsik писал(а): "мертвецы" висящие в системе - это не указание на ошибку?
pupsik писал(а):Разное (0,4 не могут резко стать 0,01 при почти одинаковых условиях) время срабатывание алгоритма - не указание на ошибки? э..э, а что тогда указание?

это "предположение" было сделано на том коде который вы выложили.. Учитывая малый объем кода и выше сказанное... в общем не весело...а вы делаете ГИПОТЕТИЧЕСКИЕ предположения
будет происходить при реально больших объёмах.Так вот, 0.01 - становятся 0.4 и больше при реальной загрузке данных.
pupsik писал(а):"мертвецы" - про закрытии программы не освобождается память. Вот и висит себе програмка мертвым грузом.
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.

 
 bmp.Free; ))))))))))
))))))))))
pupsik писал(а):Вполне возможно в винде и нет "мертвых". Но в жтк у меня они висели и радовались.

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1