Implementando el Convex Hull con Delphi

Hace un par de meses, publiqué un artículo llamado Convex Hull donde se muestra el máximo envoltorio convexo que rodea una serie de puntos. Pues bien, en este post, os muestro mi propia solución con Delphi y implementando la solución mediante listas de Objetos. El sistema es muy rápido y os dejo una aplicación llamada Thundax ConvexHull donde muestra la generación aleatoria de una serie de puntos, luego la pinta en un Timage y luego genero el Convex Hull. Mi implementación está basada en algoritmo de Andrew's monotone chain 2D convex hull de softSurfer (www.softsurfer.com). El código utilizado en C/C++ lo he traducido totalmente a Pascal y lo podréis encontrar aquí.


Se muestran en la primera columna los puntos creados aleatoriamente. Luego en la segunda lista los puntos ordenados. Fijaros como ordeno los puntos con el método sort, y como paso la función con @compare. De esta manera ordeno la lista de puntos según X y Y. En la tercera columna se muestra el cálculo del convex hull, es decir, los puntos que tendré que conectar para obtener el envoltorio convexo que contiene todos los puntos en su interior.

Función chainHull_2D:




function chainHull_2D(P: TObjectList): TObjectList;
function isLeft(P0, P1, P2: TCoord): double;
begin
result := (P1.x - P0.x) * (P2.y - P0.y) - (P2.x - P0.x) * (P1.y - P0.y);
end;
var
H: TObjectList;
bot, i, minmin, minmax, maxmin, maxmax, n: integer;
xmin, xmax: double;
output: boolean;
begin
H := TObjectList.Create();
minmin := 0;
xmin := TCoord(P[0]).x;
n := p.Count - 1;

for i := 1 to n - 1 do
if TCoord(P[i]).x <> xmin then
break;

minmax := i - 1;
output := false;
if (minmax = n - 1) then
begin
H.Add(TCoord(P[minmin]));
if (TCoord(P[minmax]).y <> TCoord(P[minmin]).y) then
H.Add(TCoord(P[minmax]));
H.Add(TCoord(P[minmin]));
output := true;
end;

if not output then
begin
maxmax := n - 1;
xmax := TCoord(P[n - 1]).x;
for i := n - 2 downto 0 do
if (TCoord(P[i]).x <> xmax) then
break;

maxmin := i + 1;
H.Add(TCoord(P[minmin]));
i := minmax;
while (i <= maxmin) do
begin
inc(i);
if ((isLeft(TCoord(P[minmin]), TCoord(P[maxmin]), TCoord(P[i])) >= 0) and (i < maxmin)) then
continue;

while (H.count > 1) do
if (isLeft(TCoord(H[H.count - 2]), TCoord(H[H.count - 1]), TCoord(P[i])) > 0) then
break
else
H.Remove(TCoord(H[H.count - 1]));
H.Add(TCoord(P[i]));
end;

if (maxmax <> maxmin) then
H.Add(TCoord(P[maxmax]));
bot := H.count - 1;
i := maxmin;
while (i > minmax) do
begin
dec(i);
if ((isLeft(TCoord(P[maxmax]), TCoord(P[minmax]), TCoord(P[i])) >= 0) and (i > minmax)) then
continue;

while (H.count > bot) do
if (isLeft(TCoord(H[H.count - 2]), TCoord(H[H.count - 1]), TCoord(P[i])) > 0) then
break
else
H.Remove(TCoord(H[H.count - 1]));
H.Add(TCoord(P[i]));

end;
if (minmax <> minmin) then
H.Add(TCoord(P[minmin]));
end;
result := H;
end;




Implementación:




type
TCoord = class(TObject)
x: integer;
y: integer;
constructor Point(x: integer; y: integer);
function ToString(): string;
end;


procedure TForm3.Button1Click(Sender: TObject);
function Compare(Item1: Pointer; Item2: Pointer): Integer;
begin
if (TCoord(Item1).x > TCoord(Item2).x) then
Result := 1
else if (TCoord(Item1).x = TCoord(Item2).x) then
if (TCoord(Item1).y > TCoord(Item2).y) then
Result := 1
else if (TCoord(Item1).y = TCoord(Item2).y) then
Result := 0
else
Result := -1
else
Result := -1
end;
var
Point: TCoord;
i: integer;
begin
objList := TObjectList.Create;
memo1.lines.clear;
DrawRectangle(image1, clblack, clblack);
if edit1.text = '' then
exit;
for i := 0 to StrToInt(Edit1.text) do
begin
Point := TCoord.Point(Random(image1.Width), Random(image1.Height));
memo1.lines.add(point.ToString);
DrawPoint(image1, Point, clyellow);
objList.add(point);
objlist.Sort(@Compare);
end;
end;

procedure TForm3.Button2Click(Sender: TObject);
var
i: integer;
point: TCoord;
begin
memo2.lines.clear;
for i := 0 to objList.count - 1 do
begin
point := TCoord(objList.Items[i]);
memo2.lines.add(point.ToString);
end;
end;

procedure TForm3.Button3Click(Sender: TObject);
var
obj: TObjectList;
i: integer;
point, point1, point2: TCoord;
begin
memo3.lines.clear;
obj := chainHull_2D(objList);
for i := 0 to obj.count - 1 do
begin
point := TCoord(obj.Items[i]);
memo3.lines.add(point.ToString);
end;
for i := 0 to obj.Count - 2 do
begin
point1 := TCoord(obj.Items[i]);
point2 := TCoord(obj.Items[i + 1]);
DrawLine(image1, point1, point2, clred);
end;

end;





espero que os sirva de ayuda. Encontrareis más información con las palabras clave "convex hull".

Comments

Popular Posts