IPB
ЛогинПароль:

> Многоугольник, Fpc, Ооп, Оптимизация
Bokul
сообщение 26.12.2006 9:32
Сообщение #1


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Реализовал объект многоугольник, который имеет неопределенное количество вершин. Но скорость работы с ним критическая, поэтому надо как можно сильнее его оптимизировать.
Вот, что он из себя представляет:
  
unit Polygone;
interface
uses UnitTVector,ListOfVertex,objects;
    TPPolygone=^TPolygone;
    TPolygone=object
       List:TVertexList;//Кольцевой список
       constructor init;//инициализируем поля
       procedure   AddVertex(x,y:integer);//добавляем вершину, x,y - ее координаты
       procedure   Increase(Const vector:TVector);//Увеличиваем координаты всех вершины на вектор vector, описание - ниже
       procedure   Decrease(Const vector:TVector);//Уменьшаем координаты всех вершины на вектор vector, описание - ниже
       procedure   ForEach(proc:ToDO);//Проделываем процедуру типа ToDO с каждой вершиной
       function    ContainsPoint(point:TPoint):boolean;//входит ли точка point в объект
       function    IsInside(OtherPolyg:TPolygone):boolean;//входит ли объект в OtherPolyg
       function    ContainsOtherPolyg(OtherPolyg:TPolygone):boolean;// входит ли OtherPolyg в объект
       destructor  done;//Удаляем все поля
    end;


Кольцевой список

unit ListOfVertex;
interface
uses objects;
type
   ToDo=procedure(point:TPoint);//тип процедуры, вызываемой с ForEach

   TPVertexItem=^TVertexItem;//элемент списка
   TVertexItem=record
      vertex:TPoint;//информационная часть - координаты вершины
      next:TPVertexItem;
   end;

   TPVertexList=^TVertexList;
   TVertexList=object
      Last:TPVertexItem;
      constructor init;//инициализируем поля
      procedure   AddElement(data:TPoint);//добавляем новый элемент
      function    DeleteElement(p:TPVertexItem):boolean;//удаляем элемент
      procedure   ForEach(proc:ToDo);//Проделываем процедуру типа ToDO с каждым элементом
      destructor  done;//удаляемся
   end;


Модуль для работы с векторами

unit UnitTVector;
interface
Type
    TVector=record
       X,Y:integer;
    end;
Operator + (Const v1,v2:TVector) R:TVector; //складываем два вектора
Operator - (Const v1,v2:TVector) R:TVector;//отнимаем от первого вектора второй
Operator * (Const k:double; v:TVector) R:TVector;//перемножаем вектор на коэффициент k
Operator * (Const v:TVector; k:double) R:TVector;//тоже самое, только другой порядок
Operator / (Const v:TVector; k:double) R:TVector;//делим вектор на коэффициент 



Программа для проверки минимальной работоспособности

uses crt,ListOfVertex,objects, UnitTVector, Polygone;
procedure Show(p:TPoint);
begin
  writeln('X = ',p.x,' Y = ',p.y);
end;

var obj1,obj2:TPPolygone;
    p1:TPoint;
    mem:longint;
    vector:TVector;
begin
  clrscr;
  mem:=GetHeapStatus.TotalFree;
  vector.x:=4;
  vector.y:=8;
  p1.x:=40;
  p1.y:=50;
  new(obj2,init);
  with obj2^ do
       begin
            AddVertex(30,10);
            AddVertex(30,20);
            AddVertex(50,20);
            AddVertex(50,10);
       end;
  new(obj1,init);
  with obj1^ do
       begin
            AddVertex(10,10);
            AddVertex(40,60);
            AddVertex(1000,10);
            writeln('First');
            ForEach(show);
            writeln;
            writeln('Point x=',p1.x,' y=',p1.y);
            if ContainsPoint(p1) then writeln('First contains Point')
            else writeln('First does not contain Point');
            writeln; 
            Writeln('After decrease: ');
            writeln('Vector: x=',vector.x,' y=',vector.y);
            decrease(vector);
            ForEach(show);
            writeln;
            writeln('Second');
            obj2^.ForEach(show);
            if ContainsOtherPolyg(obj2^) then writeln('First contains second object')
            else writeln('First does not contain second object');
            if IsInside(obj2^) then writeln('Second is inside first object')
            else writeln('Second is not inside first object');
       end;
  dispose(obj1,done);
  dispose(obj2,done);
  writeln;
  writeln('Difference: ',mem-GetHeapStatus.TotalFree);
  readln;
end.


Три модуля вмести:Прикрепленный файл  Polygone.rar ( 13.71 килобайт ) Кол-во скачиваний: 434


PS в принципе код прозрачен, но если что-то не понятно - спрашивайте. smile.gif


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Bokul
сообщение 26.12.2006 19:32
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Цитата
Я бы сделал версию со статистикой (причем, используя директивы {$IFDEF}, хорошая статистика она никогда не помешает, но надо, чтоб ее можно было отключать быстро, а не переписывать из-за этого пол-программы)


Да, правильно - так и надо, сделаем...
Цитата
(если пойти чуть дальше - сколько времени в среднем выполняется каждый метод)

Как в Fpc засекать время?

Цитата
Кстати, почему бы Increase/Decrease тоже не реализовать через ForEach?

Вообще то сначала они у меня были в виде перегруженных операторов (+-), но никак не получалось заставить их правильно работать - один из аргументов менял свое значение в независимости от того, как я его передавал в подпрограмму (оно и правильно, ведь если мы даже скопируем ссылку, данные расположенные по ее адресу останутся на месте). А почему без ForEach - для этого процедуре надо передавать еще один параметр - вектор, но ForEach работает только с таким типом
ToDo=procedure(point:TPoint);

PS volvo, где у тебя произошла такая утечка? ypriamii.gif


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 28.07.2025 7:41
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"