From 6d5ae833a14de1f27e763b4f2425584189c860e9 Mon Sep 17 00:00:00 2001 From: Olly Date: Thu, 21 Sep 2023 04:35:35 +0100 Subject: [PATCH] Tweak MinAreaCircle --- .../imports/simba/simba.import_circle.pas | 6 +- .../simbaclasses/simba.import_class_image.pas | 10 +- Source/simba.circle.pas | 28 ++-- Source/simba.image.pas | 71 +++++++++- Source/simba.math.pas | 7 + Source/simba.mufasatypes.pas | 31 ----- Source/simba.tpa.pas | 125 ++++++++++-------- 7 files changed, 172 insertions(+), 106 deletions(-) diff --git a/Source/script/imports/simba/simba.import_circle.pas b/Source/script/imports/simba/simba.import_circle.pas index f5a8f43af..5146ff8e5 100644 --- a/Source/script/imports/simba/simba.import_circle.pas +++ b/Source/script/imports/simba/simba.import_circle.pas @@ -34,7 +34,7 @@ implementation *) procedure _LapeCircle_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PCircle(Result)^ := TCircle.Create(PPoint(Params^[0])^, PInteger(Params^[1])^); + PCircle(Result)^ := TCircle.Create(PInteger(Params^[0])^, PInteger(Params^[1])^, PInteger(Params^[2])^); end; (* @@ -199,10 +199,10 @@ procedure ImportCircle(Compiler: TSimbaScript_Compiler); begin ImportingSection := 'TCircle'; - addGlobalType('record Center: TPoint; Radius: Integer; end;', 'TCircle'); + addGlobalType('record X, Y, Radius: Integer; end;', 'TCircle'); addGlobalType('array of TCircle;', 'TCircleArray'); - addGlobalFunc('function TCircle.Create(ACenter: TPoint; ARadius: Integer): TCircle; static; overload', @_LapeCircle_Create); + addGlobalFunc('function TCircle.Create(X, Y, Radius: Integer): TCircle; static; overload', @_LapeCircle_Create); addGlobalFunc('function TCircle.CreateFromPoints(Points: TPointArray): TCircle; static; overload', @_LapeCircle_CreateFromPoints); addGlobalFunc('function TCircle.ToTPA(Filled: Boolean): TPointArray', @_LapeCircle_ToTPA); diff --git a/Source/script/imports/simbaclasses/simba.import_class_image.pas b/Source/script/imports/simbaclasses/simba.import_class_image.pas index 6301d3435..833e71bb0 100644 --- a/Source/script/imports/simbaclasses/simba.import_class_image.pas +++ b/Source/script/imports/simbaclasses/simba.import_class_image.pas @@ -572,11 +572,11 @@ procedure _LapeImage_DrawLine(const Params: PParamArray); LAPE_WRAPPER_CALLING_C (* TImage.DrawLine ~~~~~~~~~~~~~~~ -> procedure TImage.DrawLine(Start, Stop: TPoint; Color: TColor); +> procedure TImage.DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); *) procedure _LapeImage_DrawLineEx(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawLine(PPoint(Params^[1])^, PPoint(Params^[2])^, PColor(Params^[3])^); + PSimbaImage(Params^[0])^.DrawLine(PPoint(Params^[1])^, PPoint(Params^[2])^, PInteger(Params^[3])^, PColor(Params^[4])^); end; (* @@ -1316,8 +1316,8 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TImage.DrawATPA(ATPA: T2DPointArray; Color: TColor = -1)', @_LapeImage_DrawATPA); addGlobalFunc('procedure TImage.DrawTPA(TPA: TPointArray; Color: TColor);', @_LapeImage_DrawTPA); - addGlobalFunc('procedure TImage.DrawCrosshairs(ACenter: TPoint; Size: Integer; Thickness: Integer; Color: TColor);', @_LapeImage_DrawCrosshairs); - addGlobalFunc('procedure TImage.DrawCross(ACenter: TPoint; Radius: Integer; Thickness: Integer; Color: TColor);', @_LapeImage_DrawCross); + addGlobalFunc('procedure TImage.DrawCrosshairs(ACenter: TPoint; Size: Integer; Color: TColor);', @_LapeImage_DrawCrosshairs); + addGlobalFunc('procedure TImage.DrawCross(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeImage_DrawCross); addGlobalFunc('procedure TImage.DrawLine(Start, Stop: TPoint; Color: TColor); overload', @_LapeImage_DrawLine); addGlobalFunc('procedure TImage.DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); overload', @_LapeImage_DrawLineEx); @@ -1342,7 +1342,7 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TImage.DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawBoxArray); addGlobalFunc('procedure TImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawPolygonArray); addGlobalFunc('procedure TImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawCircleArray); - addGlobalFunc('procedure TImage.DrawCrossArray(Points: TPointArray; Radius: Integer; Thickness: Integer; Color: TColor = -1);', @_LapeImage_DrawCrossArray); + addGlobalFunc('procedure TImage.DrawCrossArray(Points: TPointArray; Radius: Integer; Color: TColor = -1);', @_LapeImage_DrawCrossArray); addGlobalFunc('procedure TImage.DrawHSLCircle(ACenter: TPoint; Radius: Integer)', @_LapeImage_DrawHSLCircle); diff --git a/Source/simba.circle.pas b/Source/simba.circle.pas index de28abd7c..10727f3ba 100644 --- a/Source/simba.circle.pas +++ b/Source/simba.circle.pas @@ -16,7 +16,8 @@ interface type PCircle = ^TCircle; TCircle = record - Center: TPoint; + X: Integer; + Y: Integer; Radius: Integer; end; PCircleArray = ^TCircleArray; @@ -24,14 +25,15 @@ TCircle = record TCircleHelper = type helper for TCircle public const - DEFAULT_VALUE: TCircle = (Center: (X: 0; Y: 0); Radius: 0); + ZERO: TCircle = (X: 0; Y: 0; Radius: 0); public - class function Create(ACenter: TPoint; ARadius: Integer): TCircle; static; + class function Create(AX, AY: Integer; ARadius: Integer): TCircle; static; class function CreateFromPoints(Points: TPointArray): TCircle; static; + function Center: TPoint; inline; + function Contains(const P: TPoint): Boolean; function Bounds: TBox; function ToTPA(Filled: Boolean): TPointArray; - function Contains(const P: TPoint): Boolean; inline; function PointAtDegrees(Degrees: Double): TPoint; function Circumference: Double; function Area: Double; @@ -49,11 +51,12 @@ implementation uses Math, - simba.tpa, simba.random, simba.overallocatearray; + simba.math, simba.tpa, simba.random, simba.overallocatearray; -class function TCircleHelper.Create(ACenter: TPoint; ARadius: Integer): TCircle; +class function TCircleHelper.Create(AX, AY: Integer; ARadius: Integer): TCircle; begin - Result.Center := ACenter; + Result.X := AX; + Result.Y := AY; Result.Radius := ARadius; end; @@ -62,6 +65,12 @@ class function TCircleHelper.CreateFromPoints(Points: TPointArray): TCircle; Result := Points.MinAreaCircle(); end; +function TCircleHelper.Center: TPoint; +begin + Result.X := X; + Result.Y := Y; +end; + function TCircleHelper.Bounds: TBox; begin Result := TBox.Create(Center, Radius, Radius); @@ -74,7 +83,7 @@ function TCircleHelper.ToTPA(Filled: Boolean): TPointArray; function TCircleHelper.Contains(const P: TPoint): Boolean; begin - Result := Hypot(P.X - Self.Center.X, P.Y - Self.Center.Y) <= Self.Radius; + Result := DistanceF(X, Y, P.X, P.Y) <= Radius; end; function TCircleHelper.PointAtDegrees(Degrees: Double): TPoint; @@ -102,7 +111,8 @@ function TCircleHelper.Expand(Amount: Integer): TCircle; function TCircleHelper.Offset(P: TPoint): TCircle; begin Result := Self; - Result.Center := Result.Center.Offset(P); + Result.X += P.X; + Result.Y += P.Y; end; function TCircleHelper.Extract(Points: TPointArray): TPointArray; diff --git a/Source/simba.image.pas b/Source/simba.image.pas index 66a36182a..b6d63a56a 100644 --- a/Source/simba.image.pas +++ b/Source/simba.image.pas @@ -124,7 +124,8 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawCrosshairs(ACenter: TPoint; Size: Integer; Color: TColor); procedure DrawCross(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawLine(Start, Stop: TPoint; Color: TColor); + procedure DrawLine(Start, Stop: TPoint; Color: TColor); overload; + procedure DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); overload; procedure DrawPolygon(Points: TPointArray; Color: TColor); procedure DrawPolygonFilled(Points: TPointArray; Color: TColor); @@ -902,6 +903,74 @@ procedure TSimbaImage.DrawLine(Start, Stop: TPoint; Color: TColor); end; end; +procedure TSimbaImage.DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); +var + BGR: TColorBGRA; + Templ: TPointArray; + H: Integer; + + procedure PutPixel(const X, Y: Single); inline; + var + XX, YY: Integer; + I: Integer; + P: TPoint; + begin + XX := Round(X); + YY := Round(Y); + + for I := 0 to H do + begin + P.X := XX + Templ[I].X; + P.Y := YY + Templ[I].Y; + if (P.X >= 0) and (P.Y >= 0) and (P.X < FWidth) and (P.Y < FHeight) then + FData[P.Y * FWidth + P.X] := BGR; + end; + end; + +var + DX, DY, Step, I: Integer; + RX, RY, X, Y: Single; +begin + if (Thickness <= 1) then + begin + DrawLine(Start, Stop, Color); + Exit; + end; + + BGR := ColorToBGRA(Color); + + Templ := TPointArray.CreateFromCircle(TPoint.Create(0,0), Thickness, True); + H := High(Templ); + + DX := (Stop.X - Start.X); + DY := (Stop.Y - Start.Y); + if (Abs(DX) > Abs(DY)) then + Step := Abs(DX) + else + Step := Abs(DY); + + if (Step = 0) then + begin + RX := DX; + RY := DY; + end else + begin + RX := DX / Step; + RY := DY / Step; + end; + X := Start.X; + Y := Start.Y; + + PutPixel(X, Y); + for I := 1 to Step do + begin + X := X + RX; + Y := Y + RY; + + PutPixel(X, Y); + end; +end; + procedure TSimbaImage.DrawPolygon(Points: TPointArray; Color: TColor); begin Self.DrawTPA(Points.Connect(), Color); diff --git a/Source/simba.math.pas b/Source/simba.math.pas index 369fd5823..0210aa356 100644 --- a/Source/simba.math.pas +++ b/Source/simba.math.pas @@ -20,6 +20,8 @@ interface SQRT_3 = Double(1.73205080756888); SQRT_5 = Double(2.23606797749979); +function DistanceF(const X1,Y1,X2,Y2: Double): Double; inline; + function Distance(const X1, Y1, X2, Y2: Integer): Integer; inline; overload; function Distance(const P1, P2: TPoint): Integer; inline; overload; function NextPower2(const n: Integer): Integer; @@ -75,6 +77,11 @@ function NextPower2(const n: Integer): Integer; Result := Result + 1; end; +function DistanceF(const X1, Y1, X2, Y2: Double): Double; +begin + Result := Sqrt(Sqr(Double(X2) - Double(X1)) + Sqr(Double(Y2) - Double(Y1))); +end; + function Distance(const X1, Y1, X2, Y2: Integer): Integer; begin Result := Round(Sqrt(Sqr(ValReal(X2) - ValReal(X1)) + Sqr(ValReal(Y2) - ValReal(Y1)))); // convert to ValReal to prevent integer overflows diff --git a/Source/simba.mufasatypes.pas b/Source/simba.mufasatypes.pas index 951b9f4d0..6e733b830 100644 --- a/Source/simba.mufasatypes.pas +++ b/Source/simba.mufasatypes.pas @@ -392,9 +392,6 @@ function Max(const A, B: Single): Single; inline; overload; function Min(const A, B: Double): Double; inline; overload; function Max(const A, B: Double): Double; inline; overload; -function Min(const A, B, C: Integer): Integer; inline; overload; -function Max(const A, B, C: Integer): Integer; inline; overload; - procedure Swap(var A, B: Byte); overload; procedure Swap(var A, B: Integer); overload; procedure Swap(var A, B: Single); overload; @@ -635,34 +632,6 @@ function Max(const A, B: Double): Double; Result := B; end; -function Min(const A, B, C: Integer): Integer; -begin - if A < B then - if C < A then - Result := C - else - Result := A - else - if C < B then - Result := C - else - Result := B; -end; - -function Max(const A, B, C: Integer): Integer; -begin - if A > B then - if C > A then - Result := C - else - Result := A - else - if C > B then - Result := C - else - Result := B; -end; - procedure Swap(var A, B: Byte); begin specialize Swap(A, B); diff --git a/Source/simba.tpa.pas b/Source/simba.tpa.pas index d2550b689..285efc1f8 100644 --- a/Source/simba.tpa.pas +++ b/Source/simba.tpa.pas @@ -28,6 +28,12 @@ - Cluster } +{ + https://www.nayuki.io/page/smallest-enclosing-circle + + - MinAreaCircle +} + unit simba.tpa; {$DEFINE SIMBA_MAX_OPTIMIZATION} @@ -2234,21 +2240,22 @@ function TPointArrayHelper.MinAreaCircle: TCircle; var Points: TPointArray; - function NewCircle2(const p0, p1: TPoint): TCircle; + function makeDiameter(const p0, p1: TPoint): TCircle; + var + x,y: Integer; begin - Result.Center.X := (p0.x + p1.x) div 2; - Result.Center.Y := (p0.y + p1.y) div 2; - Result.Radius := Ceil(Max( - Hypot(Result.Center.X - p0.X, Result.Center.Y - p0.Y), - Hypot(Result.Center.X - p1.X, Result.Center.Y - p1.Y) - )); + x := (p0.x + p1.x) div 2; + y := (p0.y + p1.y) div 2; + Result.X := X; + Result.Y := Y; + Result.Radius := Ceil(Max(Hypot(x-p0.x,y-p0.y), Hypot(x-p1.x,y-p1.y))); end; - function NewCircle3(const p0, p1, p2: TPoint): TCircle; + // Mathematical algorithm from Wikipedia: Circumscribed circle + function makeCircumcircle(const p0, p1, p2: TPoint): TCircle; var d,ax,ay,bx,by,cx,cy,ox,oy,x,y,ra,rb,rc: Integer; begin - // Mathematical algorithm from Wikipedia: Circumscribed circle ax := p0.x; ay := p0.y; bx := p1.x; by := p1.y; cx := p2.x; cy := p2.y; @@ -2259,7 +2266,7 @@ function TPointArrayHelper.MinAreaCircle: TCircle; cx -= ox; cy -= oy; d := (ax * (by - cy) + bx * (cy - ay) + cx * (ay - by)) * 2; - if (d <> 0) then + if (Abs(d) >= 10) then begin x := ox + ((ax * ax + ay * ay) * (by - cy) + (bx * bx + by * by) * (cy - ay) + (cx * cx + cy * cy) * (ay - by)) div d; y := oy + ((ax * ax + ay * ay) * (cx - bx) + (bx * bx + by * by) * (ax - cx) + (cx * cx + cy * cy) * (bx - ax)) div d; @@ -2267,100 +2274,104 @@ function TPointArrayHelper.MinAreaCircle: TCircle; rb := Ceil(Hypot(x-p1.x, y-p1.y)); rc := Ceil(Hypot(x-p2.x, y-p2.y)); - Result.Center.X := x; - Result.Center.Y := y; - Result.Radius := Max(ra, rb, rc); + Result.X := X; + Result.Y := Y; + Result.Radius := Max(Max(ra, rb), rc); end else - Result := TCircle.DEFAULT_VALUE; + Result := TCircle.ZERO; end; // Two boundary Points known - function makeCircleTwoPoints(stop: Integer; P, Q: TPoint): TCircle; + function makeCircleTwoPoints(const count: Integer; const p, q: TPoint): TCircle; var - I: Integer; c, circ, Left, Right: TCircle; + r: TPoint; cross: Double; + I: Integer; begin - Left := TCircle.DEFAULT_VALUE; - Right := TCircle.DEFAULT_VALUE; + Left := TCircle.ZERO; + Right := TCircle.ZERO; - circ := NewCircle2(P, Q); + circ := makeDiameter(p, q); // For each point not in the two-point circle - for I := 0 to Min(stop, High(Points)) do + for I := 0 to count do begin - if (circ.Contains(Points[I])) then + r := Points[I]; + if (circ.Contains(r)) then Continue; // Form a circumcircle and classify it on Left or Right side - cross := TSimbaGeometry.CrossProduct(P, Q, Points[I]); - c := NewCircle3(P, Q, Points[I]); + c := makeCircumcircle(p, q, r); if (c.Radius = 0) then Continue; - if (cross > 0) and ((Left.Radius = 0) or (TSimbaGeometry.CrossProduct(P, Q, C.Center) > TSimbaGeometry.CrossProduct(P, Q, Left.Center))) then + cross := TSimbaGeometry.CrossProduct(p.x, p.y, q.x, q.y, r.x, r.y); + if (cross > 0) and ((Left.Radius = 0) or (TSimbaGeometry.CrossProduct(p.x, p.y, q.x, q.y, c.center.x, c.center.y) > TSimbaGeometry.CrossProduct(p.x, p.y, q.x, q.y, Left.center.x, Left.center.y))) then Left := c else - if (cross < 0) and ((Right.Radius = 0) or (TSimbaGeometry.CrossProduct(P, Q, C.Center) < TSimbaGeometry.CrossProduct(P, Q, Right.Center))) then + if (cross < 0) and ((Right.Radius = 0) or (TSimbaGeometry.CrossProduct(p.x, p.y, q.x, q.y, c.center.x, c.center.y) < TSimbaGeometry.CrossProduct(p.x, p.y, q.x, q.y, Right.center.x, Right.center.y))) then Right := c; end; // Select which circle to return if (Left.Radius = 0) and (Right.Radius = 0) then Result := circ - else if (Left.Radius = 0) then + else + if (Left.Radius = 0) then Result := Right - else if (Right.Radius = 0) or (Left.Radius <= Right.Radius) then + else + if (Right.Radius = 0) then + Result := Left + else + if (Left.Radius <= Right.Radius) then Result := Left else Result := Right; end; // One boundary point known - function makeCircleOnePoint(stop:Integer; P:TPoint): TCircle; + function makeCircleOnePoint(const count: Integer; const p: TPoint): TCircle; var I: Integer; - Q: TPoint; + q: TPoint; begin - Result := TCircle.Create(P, 0); + Result.X := p.x; + Result.Y := p.y; + Result.Radius := 0; - for I := 0 to Min(stop, High(Points)) do + for I := 0 to count do begin - Q := Points[I]; - if Result.Contains(Q) then - Continue; - - if (Result.Radius = 0) then - Result := NewCircle2(P, Q) - else - Result := makeCircleTwoPoints(I+1, P, Q); + q := Points[I]; + if (not Result.Contains(q)) then + begin + if (Result.Radius = 0) then + Result := makeDiameter(p, q) + else + Result := makeCircleTwoPoints(I, p, q); + end; end; end; var I: Integer; - P: TPoint; begin - Result := TCircle.DEFAULT_VALUE; - + Result := TCircle.ZERO; + if (Length(Self) = 0) then + Exit; if (Length(Self) = 1) then - Result.Center := Self[0] - else - if (Length(Self) > 1) then begin - // Copy the list and shuffle - Points := Copy(Self); - for I := High(Points) downto 0 do - Swap(Points[I], Points[Random(I+1)]); - - // Add Points to circle one by one, and if needed recompute circle - for I := 0 to High(Points) do - begin - P := Points[I]; - if (Result.Radius = 0) or (not Result.Contains(P)) then - Result := makeCircleOnePoint(I+1, P); - end; + Result.X := Self[0].X; + Result.X := Self[0].Y; + Exit; end; + + Points := ConvexHull(); + + // Add Points to circle one by one, and if needed recompute circle + for I := 0 to High(Points) do + if (Result.Radius = 0) or (not Result.Contains(Points[I])) then + Result := makeCircleOnePoint(I, Points[I]); end; end.