Математика

Сравнительный анализ алгоритмов построения выпуклой оболочки на плоскости


  Сравнительный анализ алгоритмов построения выпуклой оболочки на плоскости



                                  Аннотация


  Тема данной курсовой работы  – " Сравнительный анализ алгоритмов
построения выпуклой оболочки на плоскости". Для сравнения взяты четыре
алгоритма: обход методом Грэхема, быстрый метод, метод “разделяй и
властвуй” и динамический метод. Задача этой работы – раскрыть эти алгоритмы
и провести исследования эффективности их.
  Программная часть для курсовой работы выполнена на Borland Delphi 4.

                                 Оглавление

Аннотация   2

Введение    4

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

Метод обхода Грэхема   9

Быстрые методы построения выпуклой оболочки. 11

Алгоритмы типа “разделяй и властвуй”.   12

Динамические алгоритмы построения выпуклой оболочки      14

Сравнительный анализ алгоритмов построения выпуклой оболочки  17

Выводы      20

Заключение  21

Приложение Unit1.pas   22

Литература  34

                                   Введение


  Множество различных задач вычислительной геометрии связано с построением
выпуклой оболочки. В настоящий момент эта задача хорошо исследована и имеет
широкое применение в распознавании образов[i], обработке изображений[ii], а
так же в задачах в задаче раскроя и компоновки материала[iii].
  Само понятие выпуклой оболочки является довольно простым и интуитивно
понятным. Если представить резиновый шнур, натянутый на множество точек, то
это и будет выпуклая оболочка для данного множества точек. Но, не смотря на
свою простоту, оно не конструктивно, поэтому далее будут рассмотрены
способы построения эффективных алгоритмов для построения выпуклой оболочки.
Так как алгоритмы для решения нашей задачи, как правило, являются
подзадачами других, более сложных задач, то интерес представляют только
алгоритмы имеющие сложность O(N log N).
  Само понятие выпуклой оболочки является довольно простым и интуитивно
понятным. Если представить резиновый шнур, натянутый на множество точек, то
это и будет выпуклая оболочка для данного множества точек. Но, не смотря на
свою простоту, оно не конструктивно, поэтому далее будут рассмотрены
способы построения эффективных алгоритмов для построения выпуклой оболочки.
Так как алгоритмы для решения нашей задачи, как правило, являются
подзадачами других, более сложных задач, то интерес представляют только
алгоритмы имеющие сложность O(N log N).
  Для начала, несколько определений:

  Определение 1. Область D принадлежащая пространству E2, будет называться
выпуклой, если для любой пары точек q1 и q2 из D отрезок q1q2 целиком
принадлежит D.

  Определение 2. Выпуклой оболочкой множества точек S, принадлежащих
пространству E2, называется граница наименьшей выпуклой области в E2,
которая охватывает S.

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

  Определение 3. Полиэдральным множеством или политопом называется
пересечение конечного множества замкнутых полупространств.

  Следующая теорема характеризует выпуклые оболочки в нужном нам плане.

  Теорема 1[iv]. Выпуклая оболочка  конечного множества точек в Ed является
выпуклым политопом. Наоборот, каждый выпуклый политоп является выпуклой
оболочкой конечного множества точек.

  Прежде чем переходить к описанию алгоритмов следует произвести постановку
задач и определить нижние оценки для решения их. Так как алгоритмы имеют
дело с границей выпуклой оболочки множества L conv(L), то введем для нее
обозначение CH(L) и будем ее также называть выпуклой оболочкой.
  Сформулируем две основные задачи:

  Задача ВО1. (Выпуклая оболочка). В E2 задано множество S, содержащее N
точек. Требуется построить их выпуклую оболочку (т.е. полное описание
границы CH(S)).

  Задача ВО2. (Открытый алгоритм для выпуклой оболочки). На плоскости
задана последовательность из N точек p1, …, pN. Требуется найти выпуклую
оболочку таким образом, чтобы, после обработки точки pi имелась CH({p1, …,
pi}).

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

  Теорема 2. Задача сортировки за линейное время сводится к задаче
построения выпуклой оболочки, и, следовательно, для нахождения
упорядоченной выпуклой оболочки для N точек на плоскости требуется время
((N log N).

  Доказательство. Сведем задачу сортировки N положительных действительных
чисел x1,.., xN к задаче ВО1. Поставим в соответствие числу xi точку (xi,
xi2) и присвоим ей номер i. Выпуклая оболочка этого множества,
представленная в стандартном виде будет представлять собой упорядоченное
относительно значения абсциссы множество всех точек из исходного. Из него
за линейное время можно получить отсортированный список.

  Очевидно, что если мы можем решать ВО2, то мы можем решить и ВО1, по-
этому задача ВО1 может быть сведена к ВО2 за линейное время. Следовательно,
нижняя оценка для ВО2 не ниже ((N log N).

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


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

  Определение 3. Точка p выпуклого множества S называется крайней, если не
существует пары точек a, b ( S таких, что p лежит на открытом отрезке ab.

  Очевидно, что подмножество крайних точек E является наименьшим
подмножеством S, выпуклая оболочка которого, является выпуклой оболочкой
множества S, или conv(E)=conv(S). Поэтому нам необходимо для нахождения
выпуклой оболочки выполнить два шага:
  Определить крайние точки.
  Упорядочить эти точки так, чтобы они образовали выпуклый многоугольник.

  Теорема 3. Точка p не является крайней точкой множества S только тогда
когда она лежит в некотором треугольнике, вершинами которого принадлежат S,
но сама она не является вершиной этого треугольника.

  Эта теорема дает возможность построить алгоритм проверки крайности точки.
Если мы имеем дело с множеством S мощности N, то можно построить O(N3)
треугольников. Проверка принадлежности точки треугольнику выполняется за
постоянное количество операций. Следовательно, за время O(N3) можно
определить, является ли точка крайней, а за O(N4) и для всех точек.
  Следующая теорема показывает, – в каком порядке должны быть точки в
конечном множестве.

  Теорема 4. Последовательные вершины выпуклого многоугольника
располагаются в порядке, соответствующем изменению угла относительно любой
внутренней точки.

  Упорядочить крайние точки множества  можно относительно их центроида.
Центроид  множества для N точек вычисляется за время O(N) арифметических
операций. Грэхем предложил использовать для этого только три любые
неколлинеарные точки множества S. В худшем случае это требует время O(N),
но почти всегда это первые три точки.
  Упорядочить их можно за время O(N log N). Таким образом, мы решаем задачу
ВО1 за время O(N4).


                            Метод обхода Грэхема


  Приведенный выше алгоритм является неэффективным, поэтому необходим
способ более быстрого построения выпуклой оболочки. Для этого нам необходим
другой подход.
  Грэхэм в одной из первых своих работ сумел показать, как можно,
предварительно отсортировав точки относительно полярного угла с центром в
какой-нибудь внутренней точке, можно найти крайние точки за линейное
время[v].
  Пусть центр координат в какой-нибудь внутренней точке. Упорядочим точки
относительно полярного угла, а если таковые совпадают относительно
расстояния от центра координат. Так как обе точки лежат на одной прямой
проходящей через центр координат, то для сравнения нам нет необходимости
вычислять расстояние, а можно сравнивать сумму абсолютных значений
координат.
  Отсортированные точки следует поместить в двусвязный список. Так как
внутренние точки принадлежат некоторому треугольнику (Opq), где p и q –
соседние вершины точке выпуклой оболочки. Суть алгоритма в последовательном
просмотре отсортированного списка и удалении внутренних вершин. Оставшиеся
точки будут являться вершинами выпуклой оболочки.
  Просмотр начнем с точки являющейся вершиной ВО. Для этого можно взять
точку с минимальной абсциссой, а если их несколько, то и минимальной
ординатой и пометить как начальную. После чего, обходим список, начиная с
нее, против часовой стрелки и проверяем внутренний угол для текущей точки.
Если он больше либо равен (, то удаляем вершину, а иначе переходим к
следующей. Так как за каждый просмотр мы или удаляем одну вершину, или
переходим к следующей, а просмотр заканчиваем при достижении вершины
начало, которая не удалится, то мы выполняем не более N  шагов.
Рассмотренный метод называют методом обхода Грэхема.

  Теорема 5. Выпуклая оболочка N точек на плоскости может быть найдена за
время O(N log N) при памяти O(N) с использованием только арифметических
операций и сравнений.

  Доказательство. Из предыдущего алгоритма видно, что в нем используются
только арифметические операции и сравнения. Для нахождения внутренней точки
и обхода требуется линейное время, а на сортировку уходит O(N log N). Для
представления списка нам достаточно O(N) памяти.

  Так как выше было доказано, что нижняя оценка для алгоритма решающего эту
задачу равна O(N log N), то получаем, что обход Грэхема имеет оптимальное
время выполнения. Но он является оптимальным в худшем случае, а поведение
его в среднем мы не изучили. Этот алгоритм имеет несколько недостатков.
  В нем используются тригонометрические функции, а так как их вычисление
связано с большими затратами по времени, то желательно от них избавиться.
Эндрю предложил метод решения этой проблемы[vi].
  Если на плоскости заданы N точек, то существует самая левая и самая
правая точки, и они являются вершинами выпуклой оболочки. Прямая,
проходящая через эти точки делит множество на две части. Это точки, которые
лежат выше и точки, которые ниже прямой. Оба множества  порождают
соответствующие им части выпуклой оболочки, причем они являются монотонными
ломаными относительно оси x. Поэтому, отдельно отсортировав эти множества
по значению абсциссы, производится обход Грэхема.
  Недостатками алгоритма являются и то, что он не открытый, а так же не
допускает разбиение исходной задачи на подзадачи для параллельной
обработки.


                Быстрые методы построения выпуклой оболочки.


  Для построения выпуклой оболочки можно создать алгоритмы построения
выпуклой оболочки, напоминающие быструю сортировку. Такие алгоритмы
называются быстрыми методами построения оболочки.
                                    [pic]

                  Рис. 1: h  – самая удаленная от bl точка.

  Суть алгоритма состоит в том, что исходное множество S из N точек
разбивается на два подмножества, каждое из которых будет содержать одну из
двух ломаных, которые при соединении образуют выпуклую оболочку. Для начала
нужно определить две точки, которые будут являться соседними вершинами
выпуклой оболочки. Можно взять самую левую вершину, пусть это будет b, и
самую левую относительно b из оставшихся, пусть это будет e. После чего
нужно найти  точку h максимально удаленную от прямой be. Все точки, лежащие
в  треугольнике bel исключаются из дальнейшего рассмотрения. Остальные
точки будут делиться на два подмножества: точки, которые лежать левее bh и
eh, и точки, которые лежат правее и bh, и eh. Каждое из них содержит
ломаные которые в сочетании с e, b и h дают выпуклую оболочку. С каждым из
них проделываем то же самое. В подмножестве точек S’, лежащих левее bh и eh
выбираем h’, максимально удаленную от eh, которая делит его на три части.
Из них одна выбрасывается, а остальные делятся опять. Это реализуется
рекурсивной процедурой, которая для данного ей множества возвращает
соответствующую часть выпуклой оболочки.
  В случае, когда мощность каждого, из подмножеств, на которое делится
множество, не превосходит некоторой константы умноженной на мощность
множества, получаем сложность алгоритма, как и в быстрой сортировке O(N log
N). Но в худшем случае может потребоваться время O(N 2).


                    Алгоритмы типа “разделяй и властвуй”.


  В данном алгоритме, в отличие от предыдущего, множество S разбивается на
два равномощных подмножества S’ и S’’, а затем рекурсивно строятся отдельно
оболочки для каждого из них и объединяются.

                CH(S) = CH(S’ ( S’’) = CH(CH(S’) ( CH (S’’))

  Сложность этого метода состоит в эффективном нахождении слияния двух
выпуклых оболочек. Следующий алгоритм слияния был предложен Шеймосом[vii]:
  Пусть у нас есть выпуклые многоугольники P’ и P’’. Нам требуется найти P
– их слияние. Этого берется любая внутренняя точка p для P’ и проверяется
на принадлежность P’’. Если она принадлежит, то по теореме 4 мы имеем два
упорядоченных относительно полярного угла к  p множества. За время равное
сумме точек в них мы можем из них получить один упорядоченный список. После
чего, используя обход Грэхема за такое же время получить требуемый выпуклый
многоугольник.
                                    [pic]

    Рис. 2: Так как точка p внутри обоих многоугольников, то вершины, как
     одного, так и второго, упорядочены относительно полярного угла к p.


  В случае, когда p не принадлежит P’’, придется найти левую и правую
опорные прямые из p к P’’, pl и pr соответственно. Опорной прямой к
выпуклому многоугольнику P будем называть прямую l, проходящую через
некоторую вершину этого многоугольника, таким образом, что внутренность P
находится по одну сторону от l. Для этого нам достаточно время O(N). Все
вершины P’’ между l и r, при движении от l к r против часовой стрелки,
убираем из рассмотрения и выполняем те действия, которые выполняли в случае
принадлежности.
                                    [pic]

    Рис. 3: Так как точка p внутри одного многоугольника, то удаляем все
                видимые из p вершины второго многоугольника.


  Как видно, и в этом случае на слияние требуется время O(N), где N – это
общее количество точек в многоугольниках. Отсюда следует теорема:

  Теорема 6. Выпуклая оболочка объединения двух выпуклых многоугольников
может быть найдена за время, пропорциональное суммарному числу их вершин.


             Динамические алгоритмы построения выпуклой оболочки


  Все приведенные алгоритмы не являются открытыми, так как требуют
изначально знать все точки множества S. Но в некоторых случаях требуется
иметь алгоритм способный при поступлении новой точки изменять выпуклую
оболочку. В данном случае мы имеем дело с задачей ВО2.
  Очевидно, что решение задачи существует. Можно каждый раз после
поступления точки использовать обход Грэхема и получить алгоритм со
сложностью O(N2 log N), но хотелось бы не приносить в жертву оценку O(N log
N).
  Для этого следует обратить внимание на то, что каждую новую точку
алгоритм должен или отбрасывать, или вставлять его в список точек
образующих выпуклую оболочку. Чтобы получить это оценку, мы на каждую точку
должны тратить время O(log N), то есть мы должна находить место вставки и
вставлять точку за O(log N). Такой алгоритм построил Препарата[viii].
  В этом алгоритме необходимо быстро находить опорные прямые к выпуклому
многоугольнику P и проходящие через некоторую точку p. После этого одну из
цепей, на которые разбивают опорные точки границу выпуклого многоугольника,
заменить на p.
  Будем называть опорную прямую pl левой, если многоугольник P лежит справа
от pl, и соответственно прямую pr правой, если слева. Точки l и r будем
называть опорными. Так же будем различать вогнутые вершины, т.е. те для
которых отрезок, соединяющий их и p, пересекает внутренность
многоугольника. А те, которые ни вогнутые и ни опорные будут выпуклыми.
  При поверке какой-то вершины на вогнутость или выгнутость мы можем
определить, где искать опорную точку. Тык же мы должны иметь возможность
быстро удалить цепочку вершин и вставить место нее p. Для этого нам нужно
хранить многоугольник не писком, как это делалось в предыдущих алгоритмах,
а AWL или другим сбалансированным деревом.
  В этом дереве T переход к левому потомку будет соответствовать движению
по часовой стрелке по выпуклой оболочке, а для правого против часовой
стрелки. Для каждого узла в этом дереве мы должны иметь возможность
получать доступ к самой левому узлу. Если рассмотреть корневой узел дерева
M и m – самый левый узел, то они разбивают границу выпуклого многоугольника
на две цепи, причем одна хранится в левом поддереве M, а вторая в правом. В
зависимости от типа вершины М и m, а также от того, какой угол (mpM) –
левый или правый, можно определить в каком поддереве находится опорная
вершина.
  Рассмотрим поиск левой опорной вершины. Если (mpM) – левый а m – вогнутая
или то (mpM) – правый а M – выпуклая, то поиск нежно продолжать в левом
поддереве, иначе – в правом. Аналогично и для правой опорной вершины.
  [pic][pic]

                     Рис. 4: Два варианта для m, M и p.


  Таким способом мы находим за время O(log i) левую и правую опорные
прямые. После этого за время O(log i) мы можем удалить все выпуклые вершины
и сбалансируем дерево. Отсюда следует теорема:

  Теорема 7. Выпуклая оболочка множества из N точек на плоскости может быть
найдена с помощью открытого алгоритма за время ((N log N) и со временем
коррекции ((log N).


        Сравнительный анализ алгоритмов построения выпуклой оболочки


  Так как теоретически показали, что время работы всех алгоритмов в среднем
O(log N), то следует ожидать при тестировании почти всегда результаты
отличающиеся на константу.
  Проведем исследования зависимости времени работы алгоритмов от размеров
задачи при равномерном распределении точек:

[pic]

  Рис. 5: Зависимость время выполнения алгоритмов при равномерном случайном
                        расположении точек (N<=100).


[pic]

  Рис. 6: Зависимость время выполнения алгоритмов при равномерном случайном
                       расположении точек (N<=200000).


  Как видно из диаграмм, все алгоритмы в среднем при равномерном
распределении точек показали почти линейное время. Различается время
примерно в одинаковое число раз, что связано с реализацией данных
алгоритмов. Так же видно, при данном распределении быстрее всех работает
быстрый алгоритм построения выпуклой оболочки. Это объясняется  тем, что в
этом случае при каждом шаге он отбрасывает примерно одинаковую  часть
точек. Поэтому на каждом i-том уровне рекурсии происходит обработка Nki
точек, где k часть вершин, которая остается. Это k будет меньше единицы, и
не будет сильно изменяться на более глубоких вызовах рекурсивной процедуры.
Отсюда получаем то, что время будет стремиться к линейному.
  Такого не должно наблюдаться при тестах, в которых почти все данные точки
будут являться вершинами выпуклой оболочки.
[pic]

 Рис. 7: Зависимость время выполнения при расположении точек на окружности.


   Как видно в данном случае алгоритм Грэхема оказался самым эффективным.
Быстрый метод в этом случае не выбрасывает на каждом шаге точек, но так как
делит их примерно на равные части, то получается, что он работает примерно
время O(N log N), что вполне приемлемо. Что касается динамического
построения, то в процессе добавления точек в дерево попадают все вершины, а
так как при работе с AWL деревом в моей реализации используются сложные
операции с указателями то и процедура получилась медленной.
                                    [pic]

   Рис. 8: Нежелательный случай расположения точек для быстрого алгоритма.

  Из алгоритма быстрого построения следует, что в некоторых случая на каком-
то шаге может оказаться, что не была удалена ни одна вершина, и все точки
оказались по одну сторону от bh и eh (рис. 8). Если такое случается очень
редко, то это не отразится на времени выполнения значительно, а если такое
происходит на каждом шаге, то это приводит к оценке O(N2). Для моей
реализации этого алгоритма можно взять график ex и точку, расположенную на
оси ординат над точкой O.

  [pic]

                Рис. 9: Время работы быстрой оболочки O(N2).



                                   Выводы


  Как видно из результатов тестов, быстрый метод с данной задачей
справляется неудовлетворительно.
  Теперь можно подвести итоги. В большинстве случаев самыми быстрыми
являются алгоритмы Грэхема и быстрый алгоритм. С учетом того, что они
просты для реализации, они вполне приемлемы для многих задач.
  Но быстрый метод имеет существенный недостаток. Если нас интересует
поведение алгоритма в худшем случае, он неприемлем.
  Алгоритм типа “разделяй и властвуй” не показал очень быстрых результатов
и не является очень простым в реализации, но он в худшем случае все равно
имеет оптимальную оценку. Так же он может быть очень эффективно
распараллелен.
  Динамический способ стоит реализовывать только в случае, если требуется
открытый алгоритм, так как он не является очень быстрым и его реализация
связана с различными трудностями.



                                 Заключение


    В этой работе были  показаны  основные  алгоритмы  построения  выпуклых
оболочек на  плоскости.  Так  же  были  проведены  сравнения  на  конкретных
реализациях  алгоритмов  и  тестах.  Все  задачи,  поставленные  перед  этой
работой, на мой взгляд, решены.

                            Приложение Unit1.pas


unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin;
const timew=10/24/60/60;
type
  tp=extended;
  pr=^rr;
  rr=record
           x,y:tp;
           n:pr;
      end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    ResetButton: TButton;
    PaintBox1: TPaintBox;
    RandomButton: TButton;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    QRandom: TSpinEdit;
    Range: TSpinEdit;
    GrahamButton: TButton;
    TimeL: TLabel;
    QButton: TButton;
    DiveRule: TButton;
    Circle: TButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure PaintBox1Paint(Sender: TObject);
    procedure RandomButtonClick(Sender: TObject);
    procedure ResetButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure GrahamButtonClick(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure QButtonClick(Sender: TObject);
    procedure DiveRuleClick(Sender: TObject);
    procedure CircleClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  cn,sn:pr;
  mx,my:tp;
  strr:string;
  x0,y0:integer;
  time:double;
  tt:pr;
  kkk:integer;

implementation


{$R *.DFM}
procedure Writ(x,y:tp);
var t:pr;
begin
     new(t);
     t^.x:=x;
     t^.y:=y;
     t^.n:=sn;
     sn:=t;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

var t:pr;
    rect:TRect;
    x,y:integer;

begin
     with PaintBox1 do
     begin
          Canvas.Brush.Color :=clBtnFace;
          rect.Left:=0;
          rect.Top:=0;
          rect.Bottom:=Height;
          rect.Right:=Width;
          Canvas.FillRect(rect);
          Canvas.Pen.Color :=clGray;
          x0:=Width div 2;
          y0:=Height div 2;
          Canvas.MoveTo(x0,y0);
          Canvas.LineTo(x0,0);
          Canvas.MoveTo(x0,y0);
          Canvas.LineTo(x0,Height);
          Canvas.MoveTo(x0,y0);
          Canvas.LineTo(0,y0);
          Canvas.MoveTo(x0,y0);
          Canvas.LineTo(Width,y0);

          Canvas.Pen.Color :=clGreen;
          if sn<>nil then
          begin
               t:=sn;
               x:=x0+Trunc(t^.x*mx);
               y:=y0+Trunc(t^.y*my);
               Canvas.MoveTo(x,y);
               while t<>nil do
               begin
                    x:=x0+Trunc(t^.x*mx);
                    y:=y0+Trunc(t^.y*my);
                    Canvas.LineTo(x,y);
                    t:=t^.n;
               end;
               x:=x0+Trunc(sn^.x*mx);
               y:=y0+Trunc(sn^.y*my);
               Canvas.LineTo(x,y);
          end;

          Canvas.Pen.Color :=clBlue;
          t:=cn;
          while t<>nil do
          begin
               x:=x0+Trunc(t^.x*mx);
               y:=y0+Trunc(t^.y*my);
               Canvas.Ellipse(x-1,y-1,x+1,y+1);
               t:=t^.n;
          end;
     end;
end;
procedure TForm1.RandomButtonClick(Sender: TObject);
var
    i:integer;
    t:pr;
begin
     randomize();
     while cn<>nil do
     begin
          t:=cn^.n;
          dispose(cn);
          cn:=t;
     end;
     while sn<>nil do
     begin
          t:=sn^.n;
          dispose(sn);
          sn:=t;
     end;
     mx:=0;
     my:=0;
     for i:=1 to QRandom.Value do
     begin
          new(t);
          t^.n:=cn;
          cn:=t;
          t^.x:=random(2*Range.Value+1)-Range.Value;
          t^.y:=random(2*Range.Value+1)-Range.Value;
          if mx0 then mx:=0.8*(Width div 2)/mx;
     if my<>0 then my:=0.8*(Height div 2)/my;
     PaintBox1.Refresh;
end;
procedure TForm1.ResetButtonClick(Sender: TObject);
var
   t:pr;
begin
     while cn<>nil do
     begin
          t:=cn^.n;
          dispose(cn);
          cn:=t;
     end;
     while sn<>nil do
     begin
          t:=sn^.n;
          dispose(sn);
          sn:=t;
     end;
     mx:=1;
     my:=1;
     PaintBox1.Refresh;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     cn:=nil;
     sn:=nil;
     mx:=1;
     my:=1;
     with PaintBox1 do
     begin
          x0:=Width div 2;
          y0:=Height div 2;
     end;
end;
procedure TForm1.GrahamButtonClick(Sender: TObject);
label repl;
type
      prec=^rec;
      rec=record
               x,y:tp;
               next,prev:prec;
         end;
var  st,t,s,l,r,p:prec;

procedure inss(var st:prec;t,d:prec);
begin
   if st=nil then
   begin
       st:=t;
       d^.next:=t;
       st^.prev:=d;
   end else
   begin
       st^.prev^.next:=t;
       d^.next:=st;
       t^.prev:=st^.prev;
       st^.prev:=d;
   end;
end;

procedure ins(var st,t:prec);
begin
   if st=nil then
   begin
       st:=t;
       st^.next:=t;
       st^.prev:=t;
   end else
   begin
       t^.next:=st;
       t^.prev:=st^.prev;
       st^.prev^.next:=t;
       st^.prev:=t;
   end;
end;

procedure cut(var st,t:prec);
begin
    if st^.next=st then st:=nil else
    begin
        if t=st
        then st:=t^.next;
        t^.next^.prev:=t^.prev;
        t^.prev^.next:=t^.next;
    end;
end;
procedure sort(var b:prec;e:prec);
var p,q:prec;
    x:tp;
begin
     if b=e then exit;
     if b^.next=e then
     begin
         if (b^.x>e^.x) or ((b^.x=e^.x)and(b^.y>e^.y)) then
         begin
             x:=b^.x;
             b^.x:=e^.x;
             e^.x:=x;
             x:=b^.y;
             b^.y:=e^.y;
             e^.y:=x;
         end;
         exit;
     end;
     p:=b;
     q:=e;
     while (p<>q)and(p^.next<>q) do
     begin
          p:=p^.next;
          q:=q^.prev;
     end;
     if p=q then q:=q.next;
     p^.next:=b;
     b^.prev:=p;
     q^.prev:=e;
     e^.next:=q;
     sort(b,p);
     sort(q,e);
     p:=b;
     b:=nil;
     while (p<>nil)and(q<>nil) do
     begin
         if (p^.x>q^.x)or((p^.x=q^.x)and(p^.y>q^.y)) then
         begin
             e:=q;
             cut(q,e);
             ins(b,e);
         end else
         begin
             e:=p;
             cut(p,e);
             ins(b,e);
         end;
     end;
     if p<>nil then
     begin
         e:=p;
         inss(b,e,e^.prev);
     end;
     if q<>nil then
     begin
         e:=q;
         inss(b,e,e^.prev);
     end;
end;
procedure sort2(var b:prec;e:prec);
var p,q:prec;
    x:tp;
begin
     if b=e then exit;
     if b^.next=e then
     begin
         if (b^.xq)and(p^.next<>q) do
     begin
          p:=p^.next;
          q:=q^.prev;
     end;
     if p=q then q:=q.next;
     p^.next:=b;
     b^.prev:=p;
     q^.prev:=e;
     e^.next:=q;
     sort2(b,p);
     sort2(q,e);
     p:=b;
     b:=nil;
     while (p<>nil)and(q<>nil) do
     begin
         if (p^.xnil then
     begin
         e:=p;
         inss(b,e,e^.prev);
     end;
     if q<>nil then
     begin
         e:=q;
         inss(b,e,e^.prev);
     end;
end;

procedure grah(var st:prec);
var r,t,g:prec;
    f:integer;
begin
    if st^.next=st^.prev then exit;
    r:=st;
    t:=st;
    f:=0;
    while (f<=0) or (t<>r) do
    begin
         if (t^.next^.x-t^.prev^.x)*(t^.y-t^.prev^.y)>=(t^.x-
t^.prev^.x)*(t^.next^.y-t^.prev^.y) then
         begin
             if t=r then
             begin
                 dec(f);
                 r:=t^.next;
             end;
             t:=t^.prev;
             g:=t^.next;
             cut(st,g);
             dispose(g);
         end else
         begin
             t:=t^.next;
             if t=r then inc(f);
         end;
    end;
end;
begin
     time:=now;
     kkk:=0;
     repeat
     while sn<>nil do
     begin
         tt:=sn^.n;
         dispose(sn);
         sn:=tt;
     end;

     st:=nil;
     s:=nil;
     tt:=cn;
     if tt=nil then exit;
     while tt<>nil do
     begin
         new(t);
         t^.x:=tt^.x;
         t^.y:=tt^.y;
         tt:=tt^.n;
         ins(st,t);
     end;
     if st=nil then exit;
     l:=st;
     r:=st;
     t:=st;
     repeat
           if (r^.xt^.x) or ((l^.y>t^.y)and(l^.x=t^.x)) then l:=t;
           t:=t^.next;
     until t=st;
     if l^.x=r^.x then
     begin
          str((now-time)*24*60*60:0:2,strr);
          TimeL.Caption:=strr+'s';
          writ(l^.x,l^.y);
          if not((r^.x=l^.x)and(r^.y=l^.y)) then writ(r^.x,r^.y);
          t:=l;
          while l<>nil do
          begin
              t:=l;
              cut(l,t);
              dispose(t);
          end;
          exit;
     end;
     t:=l;
     t:=st;
     repeat
repl:
           if st=nil then break;
           p:=t;
           t:=t^.next;
           if (p^.x-l^.x)*(r^.y-l^.y)<=(p^.y-l^.y)*(r^.x-l^.x) then
           begin
                cut(st,p);
                ins(s,p);
                goto repl;
           end;
     until t=st;
     sort2(s,s^.prev);
     if st <> nil then
     begin
          sort(st,st^.prev);
          t:=st^.prev;
          st^.prev^.next:=s;
          st^.prev:=s^.prev;
          s^.prev^.next:=st;
          s^.prev:=t;
          st:=st^.prev;
          grah(s);
     end;
     t:=s;
     repeat
           writ(t^.x,t^.y);
           t:=t^.next;
     until t=s;
     while s<>nil do
     begin
         t:=s;
         cut(s,t);
         dispose(t);
     end;
     inc(kkk);
     until now-time>timew;
     str((now-time)/kkk*24*60*60:0:6,strr);
     TimeL.Caption:=strr+'s';
     PaintBox1.Refresh;
end;
{ end graham}
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
   t:pr;
begin
        new(t);
        t^.x:=(x-x0)/mx;
        t^.y:=(y-y0)/my;
        t^.n:=cn;
        cn:=t;
        Canvas.Pen.Color :=clBlue;
        Canvas.Ellipse(x-1,y-1,x+1,y+1);
end;
{-------------------------------------}
procedure TForm1.QButtonClick(Sender: TObject);
type  prec=^rec;
      rec=record
               x,y:tp;
               p,n:prec;
         end;
      list=record
               b,e:prec;
           end;
var  t,bb,ee:prec;
     ll,gr,ls:list;

procedure cut(var l:list;t:prec);
begin
    if t^.p<>nil then t^.p^.n:=t^.n
                 else l.b:=t^.n;
    if t^.n<>nil then t^.n^.p:=t^.p
                 else l.e:=t^.p;
end;
procedure clr(var l:list);
begin
     l.b:=nil;
     l.e:=nil;
end;
procedure add(var l:list;var t:prec);
begin
    t^.n:=nil;
    if l.e<>nil then l.e^.n:=t;
    t^.p:=l.e;
    l.e:=t;
    if l.b=nil then l.b:=t;
end;
procedure con(var l1,l2:list);
begin
    if l2.b<>nil then l2.b^.p:=l1.e else exit;
    if l1.b<>nil then l1.e^.n:=l2.b else
    begin
         l1:=l2;
         exit;
    end;
    l1.e:=l2.e;
end;
procedure proc(var ls:list;b,e:prec);
var l1,l2:list;
    r,t,m:prec;
begin
     if ls.b=nil then exit;
     t:=ls.b;
     m:=t;
     while t<>nil do
     begin
          if (b^.x-m^.x)*(b^.y+m^.y)+(m^.x-e^.x)*(e^.y+m^.y)<(b^.x-
t^.x)*(b^.y+t^.y)+(t^.x-e^.x)*(e^.y+t^.y) then
             m:=t;
          t:=t^.n;
     end;
     cut(ls,m);
     clr(l1);
     t:=ls.b;
     while t<>nil do
     begin
          r:=t^.n;
          if (t^.x-b^.x)*(m^.y-b^.y)>(m^.x-b^.x)*(t^.y-b^.y) then
          begin
             cut(ls,t);
             add(l1,t)
          end;
          t:=r;
     end;
     clr(l2);
     t:=ls.b;
     while t<>nil do
     begin
          r:=t^.n;
          if (t^.x-e^.x)*(m^.y-e^.y)<(m^.x-e^.x)*(t^.y-e^.y) then
          begin
             cut(ls,t);
             add(l2,t)
          end;
          t:=r;
     end;
     con(gr,ls);
     proc(l1,b,m);
     proc(l2,m,e);
     ls:=l1;
     add(ls,m);
     con(ls,l2);
end;
begin
     time:=now;
     kkk:=0;
     repeat

     while sn<>nil do
     begin
         tt:=sn^.n;
         dispose(sn);
         sn:=tt;
     end;
     clr(ls);
     clr(gr);
     tt:=cn;
     if tt=nil then exit;
     while tt<>nil do
     begin
         new(t);
         t^.x:=tt^.x;
         t^.y:=tt^.y;
         tt:=tt^.n;
         add(ls,t);
     end;

     bb:=ls.b;
     t:=ls.b;
     while t<>nil do
     begin
          if (t^.xnil) and ((t^.x=bb^.x)and(t^.y=bb^.y)) do
          t:=t^.n;
     ee:=t;
     while t<>nil do
     begin
          if ((t^.x<>bb^.x)or(t^.y<>bb^.y)) and
             (((t^.x-bb^.x)*(ee^.y-bb^.y)<(ee^.x-bb^.x)*(t^.y-bb^.y)) or
             (((t^.x-bb^.x)*(ee^.y-bb^.y)=(ee^.x-bb^.x)*(t^.y-
bb^.y))and(abs(ee^.x-bb^.x)+abs(ee^.y-bb^.y)nil) and ((ee^.x<>bb^.x) or (ee^.y<>bb^.y)) then
     begin
          cut(ls,ee);
          proc(ls,bb,ee);
          clr(ll);
          add(ll,bb);
          con(ll,ls);
          add(ll,ee);
          ls:=ll;
     end else
     begin
          clr(ls);
          add(ls,bb);
          dispose(ee);
     end;
     t:=ls.b;
     while ls.b<>nil do
     begin
          if (t=ls.b)or(t=ls.e)or
          ((t^.x-t^.p^.x)*(t^.n^.y-t^.p^.y)<>(t^.n^.x-t^.p^.x)*(t^.y-
t^.p^.y)) then writ(t^.x,t^.y);
          t:=t^.n;
          dispose(ls.b);
          ls.b:=t;
     end;
     t:=gr.b;
     while t<>gr.e do
     begin
         t:=t^.n;
         dispose(t^.p);
     end;
     if t<>nil then dispose(t);
     inc(kkk);
     until now-time>timew;
     str((now-time)/kkk*24*60*60:0:6,strr);
     TimeL.Caption:=strr+'s';
     PaintBox1.Refresh;
end;
{------------------------------}
procedure TForm1.DiveRuleClick(Sender: TObject);
type
      prec=^rec;
      rec=record
               a,x,y:tp;
               p,n:prec;
         end;

var  r,t,ls,gs:prec;
procedure add(var l:prec;t:prec);
begin
    if l=nil then
    begin
        l:=t;
        t^.n:=l;
        t^.p:=l
    end else
    begin
        t^.n:=l;
        t^.p:=l^.p;
        l^.p^.n:=t;
        l^.p:=t;
    end;
end;
function arc(x,y:extended):extended;
begin
    if abs(x)>abs(y) then
    begin
         if x>0 then
             arc:=1+y/x
         else
             arc:=5+y/x;
    end
    else
    begin
         if y>0 then
            arc:=3-x/y
         else
         begin
              if abs(y)=0 then
                  arc:=0
              else
                  arc:=7-x/y;
         end;
    end;
end;
procedure con(var l1,l2:prec);
var t:prec;
begin
    if l2=nil then exit;
    if l1=nil then
    begin
         l1:=l2;
         exit;
    end;
    l1^.p^.n:=l2;
    l2^.p^.n:=l1;
    t:=l1^.p;
    l1^.p:=l2^.p;
    l2^.p:=t;
end;

procedure cut(l1,l2:prec);
var t:prec;
begin
    l1^.p^.n:=l2;
    l2^.p^.n:=l1;
    t:=l1^.p;
    l1^.p:=l2^.p;
    l2^.p:=t;
end;

procedure grah(var st:prec);
var r,t,d:prec;
    f:integer;
begin
    if st^.n=st^.p then exit;
    r:=st;
    t:=st;
    f:=0;
    while (f<=0) or (t<>r) do
    begin
         if t^.n=t^.p then break;
         if ((t^.n^.x-t^.p^.x)*(t^.y-t^.p^.y)>(t^.x-t^.p^.x)*(t^.n^.y-
t^.p^.y))
         or (((t^.n^.x-t^.p^.x)*(t^.y-t^.p^.y)=(t^.x-t^.p^.x)*(t^.n^.y-
t^.p^.y))
         and (abs(t^.y-t^.p^.y)+abs(t^.y-t^.n^.y)=abs(t^.p^.y-t^.n^.y))
and(abs(t^.x-t^.p^.x)+abs(t^.x-t^.n^.x)=abs(t^.p^.x-t^.n^.x)))
          then
         begin
             if t=r then
             begin
                 dec(f);
                 r:=t^.n;
             end;
             d:=t;
             t:=t^.n;
             cut(t,d);
             t:=t^.p;
             con(gs,d);
         end else
         begin
             t:=t^.n;
             if t=r then inc(f);
         end;
    end;
    st:=t;
end;
procedure proc(var ls:prec);
var t,l1,l2,r,l:prec;
    x,y:tp;
    f:boolean;
begin
     if ls^.n=ls
        then exit;

     l1:=ls;
     l2:=ls;
     repeat
         l1:=l1^.n;
         l2:=l2^.p;
     until (l1=l2) or (l1^.p=l2);
     l1:=ls;
     cut(l1,l2);
     proc(l1);
     proc(l2);
     if l1^.n=l1 then
        if l2^.n<>l2 then begin
           t:=l1;
           l1:=l2;
           l2:=t;
        end else
        begin
            l1^.n:=l2;
            l1^.p:=l2;
            l2^.n:=l1;
            l2^.p:=l1;
            ls:=l1;
            exit;
        end;

     x:=(l1^.x+l1^.n^.x+l1^.n^.n^.x)/3;
     y:=(l1^.y+l1^.n^.y+l1^.n^.n^.y)/3;

     r:=l1;
     r^.a:=arc((r^.x-x),(r^.y-y));
     t:=l1;
     repeat
           t^.a:=arc((t^.x-x),(t^.y-y));
           if (r^.a>t^.a) or ((r^.a=t^.a) and (abs(r^.x-x)+abs(r^.y-
y)>abs(t^.x-x)+abs(t^.y-y))) then r:=t;
           t:=t^.n;
     until t=l1;
     l1:=r;
     l:=l2;
     r:=l;
     t:=r;
     f:=false;
     repeat
           if (t.x-x)*(r^.y-y)>(r^.x-x)*(t.y-y) then r:=t;
           if (t.x-x)*(l^.y-y)<(l^.x-x)*(t.y-y) then l:=t;
           f:=f or((x-t^.p^.x)*(t^.y-t^.p^.y)>(t^.x-t^.p^.x)*(y-t^.p^.y));
           t:=t^.n;
     until (t=l2);

     if (l^.x=x) and (l^.y=y) then r:=r^.n
                              else l:=l^.n;
     if f then
     begin
          cut(l,r);
          if l<>r then con(gs,l);
     end;
     l2:=r;

     r:=l2;
     r^.a:=arc((r^.x-x),(r^.y-y));
     t:=l2;
     repeat
           t^.a:=arc((t^.x-x),(t^.y-y));
           if (r^.a>t^.a) or ((r^.a=t^.a) and (abs(r^.x-x)+abs(r^.y-
y)>abs(t^.x-x)+abs(t^.y-y))) then r:=t;
           t:=t^.n;
     until t=l2;
     l2:=r;
     l1^.p^.n:=nil;
     l2^.p^.n:=nil;
     r:=l1;
     l:=l2;
     ls:=nil;
     while (r<>nil) and (l<>nil) do
     begin
         if (r^.anil then r^.p:=t^.p;
             add(ls,t);
         end else
         begin
             t:=l;
             l:=l^.n;
             if l<>nil then l^.p:=t^.p;
             add(ls,t);
         end;
     end;
     if r<>nil then
     begin
          r^.p^.n:=r;
          con(ls,r);
     end;
     if l<>nil then
     begin
          l^.p^.n:=l;
          con(ls,l);
     end;
     grah(ls);
end;
begin
     time:=now;
     kkk:=0;
     repeat

     while sn<>nil do
     begin
         tt:=sn^.n;
         dispose(sn);
         sn:=tt;
     end;
     ls:=nil;
     gs:=nil;
     tt:=cn;
     if tt=nil then exit;
     while tt<>nil do
     begin
         new(t);
         t^.x:=tt^.x;
         t^.y:=tt^.y;
         tt:=tt^.n;
         add(ls,t);
     end;
     proc(ls);
     t:=ls;
     if t<>nil then
     repeat
          r:=t;
          writ(t^.x,t^.y);
          t:=t^.n;
          dispose(r);
     until t=ls;
     t:=gs;
     if t<>nil then
     repeat
          r:=t;
          t:=t^.n;
          dispose(r);
     until t=gs;
     inc(kkk);
     until now-time>timew;
     str((now-time)/kkk*24*60*60:0:6,strr);
     TimeL.Caption:=strr+'s';
     PaintBox1.Refresh;
end;
{Div end}
procedure TForm1.CircleClick(Sender: TObject);
var
    i:integer;
    t:pr;
begin

     while cn<>nil do
     begin
          t:=cn^.n;
          dispose(cn);
          cn:=t;
     end;
     while sn<>nil do
     begin
          t:=sn^.n;
          dispose(sn);
          sn:=t;
     end;
     mx:=0;
     my:=0;
     for i:=1 to QRandom.Value do
     begin
          new(t);
          t^.n:=cn;
          cn:=t;
          t^.x:=Range.Value*sin(i);
          t^.y:=Range.Value*cos(i);
          if mx0 then mx:=0.8*(Width div 2)/mx;
     if my<>0 then my:=0.8*(Height div 2)/my;
     PaintBox1.Refresh;
end;
{ online}
procedure TForm1.Button2Click(Sender: TObject);
label onend;
type
    prec=^TTree;
    TTree=record
                x,y:tp;
                l,r,u,n,p,gr:prec;
                kl,kr:integer;
          end;
var ls,t,p,n,gr:prec;
procedure disp(t:prec);
begin
    if t=nil then exit;
    disp(t^.l);
    disp(t^.r);
    dispose(t);
end;
function max(a,b:integer):integer;
begin
    if a>b then max:=a
           else max:=b;
end;
procedure getleft(m,n:prec;var l:prec);
var fm,fn,f:boolean;
begin
     l:=nil;
     if ((p^.x=m^.x) and (p^.y=m^.y)) or ((p^.x=n^.x) and (p^.y=n^.y)) then
exit;
     if ((p^.x=m^.n^.x) and (p^.y=m^.n^.y)) or ((p^.x=n^.n^.x) and
(p^.y=n^.n^.y)) then exit;
     if (m^.n=m) or
        (((m^.n^.x-p^.x)*(m^.y-p^.y)=(m^.x-p^.x)*(m^.n^.y-p^.y)) and
(abs(m^.x-p^.x)=abs(m^.n^.x-p^.x)+abs(m^.n^.x-m^.x)) and (abs(m^.y-
p^.y)=abs(m^.n^.y-p^.y)+abs(m^.n^.y-m^.y))) or
        (((m^.p^.x-p^.x)*(m^.y-p^.y)>(m^.x-p^.x)*(m^.p^.y-p^.y)) and
((m^.n^.x-p^.x)*(m^.y-p^.y)>(m^.x-p^.x)*(m^.n^.y-p^.y)))
        then
     begin
         l:=m;
         exit;
     end;
     if (n^.n=n) or
        (((n^.n^.x-p^.x)*(n^.y-p^.y)=(n^.x-p^.x)*(n^.n^.y-p^.y)) and
(abs(n^.x-p^.x)=abs(n^.n^.x-p^.x)+abs(n^.n^.x-n^.x)) and (abs(n^.y-
p^.y)=abs(n^.n^.y-p^.y)+abs(n^.n^.y-n^.y))) or
        (((n^.p^.x-p^.x)*(n^.y-p^.y)>(n^.x-p^.x)*(n^.p^.y-p^.y)) and
((n^.n^.x-p^.x)*(n^.y-p^.y)>(n^.x-p^.x)*(n^.n^.y-p^.y)))
        then
     begin
         l:=n;
         exit;
     end;
     if m^.n<>m then
     begin
          fm:=((m^.n^.x-p^.x)*(m^.y-p^.y)>(m^.x-p^.x)*(m^.n^.y-p^.y)) or
              ((m^.p^.x-p^.x)*(m^.y-p^.y)<(m^.x-p^.x)*(m^.p^.y-p^.y));
          fn:=((n^.n^.x-p^.x)*(n^.y-p^.y)>(n^.x-p^.x)*(n^.n^.y-p^.y)) or
              ((n^.p^.x-p^.x)*(n^.y-p^.y)<(n^.x-p^.x)*(n^.p^.y-p^.y));
          f:=(m^.x-p^.x)*(n^.y-p^.y)>(n^.x-p^.x)*(m^.y-p^.y);

          if (m^.l<>nil) and ((f and not(fn)) or (not(f) and fm)) then
             getleft(m^.l,n,l)
          else if m^.r<>nil then
              getleft(m^.r,m^.n,l);
     end;
end;
procedure getright(m,n:prec;var l:prec);
var fm,fn,f:boolean;
begin
     l:=nil;
     if ((p^.x=m^.x) and (p^.y=m^.y)) or ((p^.x=n^.x) and (p^.y=n^.y)) then
exit;
     if ((p^.x=m^.p^.x) and (p^.y=m^.p^.y)) or ((p^.x=n^.p^.x) and
(p^.y=n^.p^.y)) then exit;
     if (m^.n=m) or
        (((m^.p^.x-p^.x)*(m^.y-p^.y)=(m^.x-p^.x)*(m^.p^.y-p^.y)) and
(abs(m^.x-p^.x)=abs(m^.p^.x-p^.x)+abs(m^.p^.x-m^.x)) and (abs(m^.y-
p^.y)=abs(m^.p^.y-p^.y)+abs(m^.p^.y-m^.y))) or
        (((m^.p^.x-p^.x)*(m^.y-p^.y)<(m^.x-p^.x)*(m^.p^.y-p^.y)) and
((m^.n^.x-p^.x)*(m^.y-p^.y)<(m^.x-p^.x)*(m^.n^.y-p^.y)))
        then
     begin
         l:=m;
         exit;
     end;
     if (n^.n=n) or
        (((n^.p^.x-p^.x)*(n^.y-p^.y)=(n^.x-p^.x)*(n^.p^.y-p^.y)) and
(abs(n^.x-p^.x)=abs(n^.p^.x-p^.x)+abs(n^.p^.x-n^.x)) and (abs(n^.y-
p^.y)=abs(n^.p^.y-p^.y)+abs(n^.p^.y-n^.y))) or
        (((n^.p^.x-p^.x)*(n^.y-p^.y)<(n^.x-p^.x)*(n^.p^.y-p^.y)) and
((n^.n^.x-p^.x)*(n^.y-p^.y)<(n^.x-p^.x)*(n^.n^.y-p^.y)))
        then
     begin
         l:=n;
         exit;
     end;
     if m^.n<>m then
     begin
          fm:=((m^.n^.x-p^.x)*(m^.y-p^.y)>(m^.x-p^.x)*(m^.n^.y-p^.y)) or
              ((m^.p^.x-p^.x)*(m^.y-p^.y)<(m^.x-p^.x)*(m^.p^.y-p^.y));
          fn:=((n^.n^.x-p^.x)*(n^.y-p^.y)>(n^.x-p^.x)*(n^.n^.y-p^.y)) or
              ((n^.p^.x-p^.x)*(n^.y-p^.y)<(n^.x-p^.x)*(n^.p^.y-p^.y));
    f:=(m^.x-p^.x)*(n^.y-p^.y)>(n^.x-p^.x)*(m^.y-p^.y);
          if (m^.l<>nil) and ((f and not(fm)) or (not(f) and fn)) then
             getright(m^.l,n,l)
          else if m^.r<>nil then
             getright(m^.r,m^.n,l);
     end;
end;
procedure balance(m:prec;var t:prec;f:boolean);
var u,r,k,l:prec;
    kr:integer;
begin
     if m=nil then exit;
     if m^.l<>nil then m^.kl:=max(m^.l^.kl,m^.l^.kr)+1 else m^.kl:=0;
     if m^.r<>nil then m^.kr:=max(m^.r^.kl,m^.r^.kr)+1 else m^.kr:=0;
     u:=m^.u;
     k:=m;
     if m^.kl>m^.kr+1 then
     begin
          k:=m^.l;
          if k^.kr>k^.kl then
             k:=k^.r;
          if k^.u^.l=k then
             k^.u^.l:=k^.l
          else
             k^.u^.r:=k^.l;
          if k^.u^.l=k then
             k^.u^.kl:=k^.kl
          else
             k^.u^.kr:=k^.kl;
          if k^.l<>nil then k^.l^.u:=k^.u;
          r:=m^.l;
          kr:=m^.kl;
          m^.l:=k^.r;
          m^.kl:=k^.kr;
          if k^.r<>nil then k^.r^.u:=m;
          k^.l:=r;
          k^.kl:=kr;
          r^.u:=k;
          k^.r:=m;
          m^.u:=k;
          if u<>nil then
          begin
          if u^.l=m then
              u^.l:=k
          else
              u^.r:=k;
          end
          else t:=k;
          k^.u:=u;
          balance(m,t,false);
{          balance(r,t);}
     end else
     if m^.kr>m^.kl+1 then
     begin
          k:=m^.r;
          if k^.kl>k^.kr then
             k:=k^.l;
          if k^.u^.r=k then
             k^.u^.r:=k^.r
          else
             k^.u^.l:=k^.r;
          if k^.u^.r=k then
             k^.u^.kr:=k^.kr
          else
             k^.u^.kl:=k^.kr;
if k^.r<>nil then k^.r^.u:=k^.u;
          r:=m^.r;
          kr:=m^.kr;
          m^.r:=k^.l;
          m^.kr:=k^.kl;
          if k^.l<>nil then k^.l^.u:=m;
          k^.r:=r;
          k^.kr:=kr;
          r^.u:=k;
          k^.l:=m;
          m^.u:=k;
          if u<>nil then
          begin
          if u^.l=m then
              u^.l:=k
          else
              u^.r:=k;
          end
          else t:=k;
          k^.u:=u;
          balance(m,t,false);
end;
     if f then balance(u,t,true);
end;

procedure ins(m,d:prec);
begin
    if m^.r<>nil then m^.r^.u:=d;
    d^.r:=m^.r;
    d^.l:=nil;
    d^.u:=m;
    m^.r:=d;
    balance(d,t,true);

end;
procedure cutl(l:prec;var dl,dr:prec);
var
   r,c:prec;
begin
     r:=l;
     dl:=nil;
     if r^.l<>nil then
     begin
         dl:=r^.l;
         dl^.u:=nil;
         r^.l:=nil;
         r^.kl:=0;
end;
     while r<>nil do
     begin
          c:=r^.u;
          if c<>nil then
          begin
             if c^.r=r then
             begin
                  if c^.u<>nil then
                  begin
                     if c^.u^.l=c then
                     begin
                          c^.u^.l:=r;
                          r^.u:=c^.u;
                     end
                     else
                     begin
                          c^.u^.r:=r;
                          r^.u:=c^.u;
                     end;
                  end else
                  begin
                      dr:=r;
                      r^.u:=nil;
                  end;
                  c^.r:=dl;
                  if dl<>nil then dl^.u:=c;
                  dl:=c;
                  dl^.u:=nil;
continue;
             end;
          end;
          r:=r^.u;
     end;
     balance(l,dr,true);
end;
procedure cutr(r:prec;var dl,dr:prec);
var
   l,c:prec;
begin
     l:=r;
     dr:=nil;
     if l^.r<>nil then
     begin
         dr:=l^.r;
         dr^.u:=nil;
         l^.r:=nil;
end;
     while l<>nil do
     begin
          c:=l^.u;
          if c<>nil then
          begin
             if c^.l=l then
             begin
                  if c^.u<>nil then
                  begin
                     if c^.u^.l=c then
                     begin
                          c^.u^.l:=l;
                          l^.u:=c^.u;
                     end
                     else
                     begin
                          c^.u^.r:=l;
                          l^.u:=c^.u;
                     end;
                  end else
                  begin
                      dl:=l;
                      l^.u:=nil;
                  end;
                  c^.l:=dr;
if dr<>nil then dr^.u:=c;
                  dr:=c;
                  dr^.u:=nil;
continue;
             end;
          end;
          l:=l^.u;
     end;
     balance(r,dl,true);
end;
procedure add(p:prec);
var l,r,d:prec;
begin
     getleft(t,n,l);
     if l<>nil then
     begin
         getright(t,n,r);
         if (n=r) or ((n^.x-r^.x)*(l^.y-r^.y)<(l^.x-r^.x)*(n^.y-r^.y)) then
         begin
             cutl(r,d,t);
      n:=r;
             cutr(l,t,d);

      ins(l,p);

         end else
         begin
             cutr(l,t,d);

             balance(l^.n,d,true);

             p^.l:=t;
             t^.u:=p;
             t:=d;
             cutl(r,d,t);
      p^.r:=t;
             t^.u:=p;
             t:=p;
             p^.u:=nil;
             balance(p,t,true);
         end;
         l^.n:=p;
         p^.p:=l;
         r^.p:=p;
         p^.n:=r;
     end;
end;
begin
     kkk:=0;
     time:=now;
     repeat
     while sn<>nil do
     begin
         tt:=sn^.n;
         dispose(sn);
         sn:=tt;
     end;
     ls:=nil;
     gr:=nil;
     tt:=cn;
     if tt=nil then goto onend;
     while tt<>nil do
     begin
         new(t);
         t^.gr:=gr;
         gr:=t;
         t^.x:=tt^.x;
         t^.y:=tt^.y;
         t^.n:=ls;
         ls:=t;
         tt:=tt^.n;
     end;
     t:=ls;
     ls:=ls^.n;
     t^.u:=nil;
     t^.l:=nil;
     t^.r:=nil;
     t^.n:=t;
     t^.p:=t;
     t^.kl:=0;
     t^.kr:=0;
     n:=t;
     while ls<>nil do
     begin
          p:=ls;
          ls:=ls^.n;
          add(p);
     end;
     p:=n;
     repeat
          writ(p^.x,p^.y);
          t:=p;
          p:=p^.n;
until p=n;
     while gr<>nil do
     begin
         p:=gr;
         gr:=gr^.gr;
         dispose(p);
     end;

onend:
     inc(kkk);
     until now-time>timew;
     str((now-time)/kkk*24*60*60:0:6,strr);
     TimeL.Caption:=strr+'s';
     PaintBox1.Refresh;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
    while sn<>nil do
     begin
         tt:=sn^.n;
         dispose(sn);
         sn:=tt;
     end;
     while cn<>nil do
     begin
         tt:=cn^.n;
         dispose(cn);
         cn:=tt;
     end;
     halt;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
    i:integer;
    t:pr;
begin
     randomize();
     while cn<>nil do
     begin
          t:=cn^.n;
          dispose(cn);
          cn:=t;
     end;
     while sn<>nil do
     begin
          t:=sn^.n;
          dispose(sn);
          sn:=t;
     end;
     mx:=0;
     my:=0;
     new(t);
     t^.n:=cn;
     cn:=t;
     t^.x:=0;
     t^.y:=10;
     if mx0 then mx:=0.8*(Width div 2)/mx;
     if my<>0 then my:=0.8*(Height div 2)/my;
     PaintBox1.Refresh;
end;
end.


                                 Литература


-----------------------
     F. P. Preparata, M. I. Shamos, Computational geometry, Ph. D. Thesis,
Dept. Of Comput. Sci., Yale Univ., 1985.
[i] S. G. Akl and G. T. Toussaint, Efficient convex hull algorithm for
patt???????????????????????????????????????????????????????????????????ern
recognition aplications, Proc. 4th Int’l Joint Conf. On Pattern
Recognition, Kyoto, Japan, pp. 483-487 (1978).
[ii] A. Rosenfeld, Picture Processing by Computers, Academic Press, New
York, 1969.
[iii] H. Freeman, Computer processing of line-drawing images, Comput.
Surveys 6, 57-97 (1974).
[iv] P. McMullen and G. C. Shephard, Convex Polytopes and the Upper Bound
Conjecture, Cambridge University Press, Cambridge, England, 1971
[v] R. L. Graham, An  efficient algorithm for determining the convex hull
of a finite planar set, Info, Proc. Lett. 1, 132-133 (1972).
[vi] A. M. Andrew, Another efficient algorithm for convex hulls in two
dimension, Info. Proc. Lett. 9, 216-219 (1979).
[vii] M. I. Shamos, Computational  geometry, Ph. D. Thesis, Dept. Of
Comput. Sci., Yale Univ., 1978.
[viii] F. P. Preparata, An optimal real time algorithm for planar convex
hulls, Comm. ACM 22, 402-405 (1979).



смотреть на рефераты похожие на "Сравнительный анализ алгоритмов построения выпуклой оболочки на плоскости"