Модератор: Модераторы
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 писал(а):Вполне возможно в винде и нет "мертвых". Но в жтк у меня они висели и радовались.
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 62