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".