From 5d39177e874c0ad39d4e8fd643648218b4fc3ab8 Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Tue, 16 Jan 2024 14:11:19 +1100 Subject: [PATCH] math: Add 'almost_Equals' function. --- 1-base/math/source/generic/any_math.adb | 20 ++++++++++++++++++++ 1-base/math/source/generic/any_math.ads | 17 +++++++++++------ 2 files changed, 31 insertions(+), 6 deletions(-) diff --git a/1-base/math/source/generic/any_math.adb b/1-base/math/source/generic/any_math.adb index 3d2bcad..fb825ee 100644 --- a/1-base/math/source/generic/any_math.adb +++ b/1-base/math/source/generic/any_math.adb @@ -74,6 +74,16 @@ is end almost_Zero; + function almost_Equals (Self, + Other, + Tolerance : in Real := Real'Base'Model_Small) return Boolean + is + begin + return Self <= Other + Tolerance + and Self >= Other - Tolerance; + end almost_Equals; + + function Clamped (Self : in Real; Low, High : in Real) return Real is begin @@ -603,6 +613,16 @@ is end "abs"; + function almost_Equals (Self, Other : in Vector_3; + Tolerance : in Real := Real'Base'Model_Small) return Boolean + is + begin + return almost_Equals (Self (1), Other (1), Tolerance) + and almost_Equals (Self (2), Other (2), Tolerance) + and almost_Equals (Self (3), Other (3), Tolerance); + end almost_Equals; + + --------- -- Matrix -- diff --git a/1-base/math/source/generic/any_math.ads b/1-base/math/source/generic/any_math.ads index 922ad89..811f49b 100644 --- a/1-base/math/source/generic/any_math.ads +++ b/1-base/math/source/generic/any_math.ads @@ -49,15 +49,18 @@ is subtype Real is Real_t; subtype unit_Interval is Real range 0.0 .. 1.0; - function almost_Zero (Self : in Real) return Boolean; + function almost_Zero (Self : in Real) return Boolean; + function almost_Equals (Self, + Other, + Tolerance : in Real := Real'Base'Model_Small) return Boolean; - function Clamped (Self : in Real; Low, High : in Real) return Real; - procedure clamp (Self : in out Real; Low, High : in Real); + function Clamped (Self : in Real; Low, High : in Real) return Real; + procedure clamp (Self : in out Real; Low, High : in Real); - procedure swap (Left, - Right : in out Real); + procedure swap (Left, + Right : in out Real); - function Image (Self : in Real; Precision : in Natural := 5) return String; + function Image (Self : in Real; Precision : in Natural := 5) return String; ------------- @@ -170,6 +173,8 @@ is overriding function "abs" (Right : in Vector_3) return Vector_3; + function almost_Equals (Self, Other : in Vector_3; + Tolerance : in Real := Real'Base'Model_Small) return Boolean; ----------- -- Matrices