add is_close in stdlib_math.

Author: zoziha

doc/specs/stdlib_math.md

@@ -275,25 +275,25 @@ program demo_logspace_rstart_cbase
 
 end program demo_logspace_rstart_cbase
 ```
-## `arange`
+### `arange`
 
-### Status
+#### Status
 
 Experimental
 
-### Class
+#### Class
 
 Pure function.
 
-### Description
+#### Description
 
 Creates a one-dimensional `array` of the `integer/real` type with fixed-spaced values of given spacing, within a given interval.
 
-### Syntax
+#### Syntax
 
 `result = [[stdlib_math(module):arange(interface)]](start [, end, step])`
 
-### Arguments
+#### Arguments
 
 All arguments should be the same type and kind.
 
@@ -309,18 +309,18 @@ The default `end` value is the inputted `start` value.
 This is an `intent(in)` and `optional` argument.   
 The default `step` value is `1`.
 
-#### Warning
+##### Warning
 If `step = 0`, the `step` argument will be corrected to `1/1.0` by the internal process of the `arange` function.   
 If `step < 0`, the `step` argument will be corrected to `abs(step)` by the internal process of the `arange` function. 
 
-### Return value
+#### Return value
 
 Returns a one-dimensional `array` of fixed-spaced values.
 
 For `integer` type arguments, the length of the result vector is `(end - start)/step + 1`.  
 For `real` type arguments, the length of the result vector is `floor((end - start)/step) + 1`.
 
-### Example
+#### Example
 
 ```fortran
 program demo_math_arange
@@ -342,4 +342,68 @@ program demo_math_arange
     print *, arange(0.0,2.0,0.0)       !! [0.0,1.0,2.0]. Not recommended: `step` argument is zero!
 
 end program demo_math_arange
+```
+
+### `is_close`
+
+#### Description
+
+Returns a boolean scalar/array where two scalars/arrays are element-wise equal within a tolerance.
+
+The tolerance values are positive, typically very small numbers. The relative difference `(rtol*abs(b))` and the absolute difference `atol` are added together to compare against the absolute difference between `a` and `b`.
+
+```fortran
+!> For `real` type
+abs(a - b) <= rtol*abs(b) + atol
+
+!> For `complex` type
+abs(a%re - b%re) <= rtol*abs(b%re) + atol
+abs(a%im - b%im) <= rtol*abs(b%im) + atol
+```
+
+#### Syntax
+
+`bool = [[stdlib_math(module):is_close(interface)]] (a, b [, rtol, atol])`
+
+#### Status
+
+Experimental.
+
+#### Class
+
+Elemental function.
+
+#### Arguments
+
+`a`: Shall be a `real/complex` scalar/array.
+This argument is `intent(in)`.
+
+`b`: Shall be a `real/complex` scalar/array.
+This argument is `intent(in)`.
+
+`rtol`: Shall be a `real` scalar.
+This argument is `intent(in)` and `optional`, which is `1.0e-5` by default.
+
+`atol`: Shall be a `real` scalar.
+This argument is `intent(in)` and `optional`, which is `1.0e-8` by default.
+
+Note: All `real/complex` arguments must have same `kind`.
+If the value of `rtol/atol` is negative (not recommended), it will be corrected to `abs(rtol/atol)` by the internal process of `is_close`.
+
+#### Result value
+
+Returns a `logical` scalar/array.
+
+#### Example
+
+```fortran
+program demo_math_is_close
+    use stdlib_math, only: is_close
+    use stdlib_error, only: check
+    real :: x(2) = [1, 2]
+    print *, is_close(x,[real :: 1, 2.1])     !! [T, F]
+    print *, is_close(2.0, 2.1, atol=0.1)     !! T
+    call check(all(is_close(x, [2.0, 2.0])), msg="all(is_close(x, [2.0, 2.0])) failed.", warn=.true.)
+        !! all(is_close(x, [2.0, 2.0])) failed.
+end program demo_math_is_close
 ```

src/CMakeLists.txt

@@ -33,6 +33,7 @@ set(fppFiles
     stdlib_math_linspace.fypp
     stdlib_math_logspace.fypp
     stdlib_math_arange.fypp
+    stdlib_math_is_close.fypp
     stdlib_string_type.fypp
 )
 

src/Makefile.manual

@@ -29,6 +29,7 @@ SRCFYPP =\
         stdlib_math.fypp \
 		stdlib_math_linspace.fypp \
 		stdlib_math_logspace.fypp \
+        stdlib_math_is_close.fypp \
         stdlib_stats_distribution_PRNG.fypp \
         stdlib_string_type.fypp
 
@@ -159,3 +160,5 @@ stdlib_math_logspace.o: \
 stdlib_math_arange.o: \
     stdlib_math.o
 stdlib_linalg_outer_product.o: stdlib_linalg.o
+stdlib_math_is_close.o: \
+    stdlib_math.o

src/stdlib_math.fypp

@@ -11,7 +11,7 @@ module stdlib_math
     public :: clip, linspace, logspace
     public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP, EULERS_NUMBER_QP
     public :: DEFAULT_LINSPACE_LENGTH, DEFAULT_LOGSPACE_BASE, DEFAULT_LOGSPACE_LENGTH
-    public :: arange
+    public :: arange, is_close
 
     integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100
     integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50
@@ -279,6 +279,21 @@ module stdlib_math
         #:endfor
     end interface arange
 
+    !> Version: experimental
+    !>
+    !> Determines whether the values of `a` and `b` are close.
+    !> ([Specification](../page/specs/stdlib_logic.html#is_close))
+    interface is_close
+        #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
+        #:for k1, t1 in RC_KINDS_TYPES
+        elemental module function is_close_${t1[0]}$${k1}$(a, b, rtol, atol) result(result)
+            ${t1}$, intent(in) :: a, b
+            real(${k1}$), intent(in), optional :: rtol, atol
+            logical :: result
+        end function is_close_${t1[0]}$${k1}$
+        #:endfor
+    end interface is_close
+
 contains
 
     #:for k1, t1 in IR_KINDS_TYPES

src/stdlib_math_is_close.fypp

@@ -0,0 +1,33 @@
+#:include "common.fypp"
+
+submodule(stdlib_math) stdlib_math_is_close
+
+contains
+
+    #! Determines whether the values of `a` and `b` are close.
+
+    #:for k1, t1 in REAL_KINDS_TYPES
+    elemental module function is_close_${t1[0]}$${k1}$(a, b, rtol, atol) result(result)
+        ${t1}$, intent(in) :: a, b
+        real(${k1}$), intent(in), optional :: rtol, atol
+        logical :: result
+
+        result = abs(a - b) <= abs(optval(rtol, 1.0e-5_${k1}$)*b) + &
+                               abs(optval(atol, 1.0e-8_${k1}$))
+
+    end function is_close_${t1[0]}$${k1}$
+    #:endfor
+
+    #:for k1, t1 in CMPLX_KINDS_TYPES
+    elemental module function is_close_${t1[0]}$${k1}$(a, b, rtol, atol) result(result)
+        ${t1}$, intent(in) :: a, b
+        real(${k1}$), intent(in), optional :: rtol, atol
+        logical :: result
+
+        result = is_close_r${k1}$(a%re, b%re, rtol, atol) .and. &
+                 is_close_r${k1}$(a%im, b%im, rtol, atol)
+
+    end function is_close_${t1[0]}$${k1}$
+    #:endfor
+
+end submodule stdlib_math_is_close

src/tests/math/CMakeLists.txt

@@ -1,4 +1,5 @@
 ADDTEST(stdlib_math)
 ADDTEST(linspace)
 ADDTEST(logspace)
-ADDTEST(math_arange)
+ADDTEST(math_arange)
+ADDTEST(math_is_close)

src/tests/math/Makefile.manual

@@ -1,5 +1,6 @@
 PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 test_logspace.f90 \
-    test_math_arange.f90
+    test_math_arange.f90 \
+    test_math_is_close.f90
 
 
 include ../Makefile.manual.test.mk

src/tests/math/test_math_is_close.f90

@@ -0,0 +1,40 @@
+program test_math_is_close
+
+    call test_math_is_close_real
+    call test_math_is_close_complex
+    print *, "All tests in `test_math_is_close` passed."
+
+contains
+
+    subroutine test_math_is_close_real
+        use stdlib_math, only: is_close
+        use stdlib_error, only: check
+
+        call check(is_close(2.5, 2.5, rtol=1.0e-5), msg="is_close(2.5, 2.5, rtol=1.0e-5) failed.")
+        call check(all(is_close([2.5, 3.2], [2.5, 10.0], rtol=1.0e-5)), &
+                   msg="all(is_close([2.5, 3.2], [2.5, 10.0], rtol=1.0e-5)) failed (expected).", warn=.true.)
+        call check(all(is_close(reshape([2.5, 3.2, 2.2, 1.0], [2, 2]), reshape([2.5, 3.2001, 2.25, 1.1], [2, 2]), &
+                   atol=1.0e-5, rtol=0.1)), &
+                   msg="all(is_close(reshape([2.5, 3.2, 2.2, 1.0],[2,2]), reshape([2.5, 3.2001, 2.25, 1.1],[2,2]), &
+                   &rtol=1.0e-5, atol=0.1)) failed.")
+
+    end subroutine test_math_is_close_real
+
+    subroutine test_math_is_close_complex
+        use stdlib_math, only: is_close
+        use stdlib_error, only: check
+
+        call check(is_close((2.5,1.2), (2.5,1.2), rtol=1.0e-5), &
+                   msg="is_close((2.5,1.2), (2.5,1.2), rtol=1.0e-5) failed.")
+        call check(all(is_close([(2.5,1.2), (3.2,1.2)], [(2.5,1.2), (10.0,1.2)], rtol=1.0e-5)), &
+                   msg="all(is_close([(2.5,1.2), (3.2,1.2)], [(2.5,1.2), (10.0,1.2)], rtol=1.0e-5)) failed (expected).", &
+                   warn=.true.)
+        call check(all(is_close(reshape([(2.5,1.2009), (3.2,1.199999)], [1, 2]), reshape([(2.4,1.2009), (3.15,1.199999)], [1, 2]), &
+                   atol=1.0e-5, rtol=0.1)), &
+                   msg="all(is_close(reshape([(2.5,1.2009), (3.2,1.199999)], [1, 2]), &
+                   &reshape([(2.4,1.2009), (3.15,1.199999)], [1, 2]), &
+                   &rtol=1.0e-5, atol=0.1)) failed.")
+
+    end subroutine test_math_is_close_complex
+
+end program test_math_is_close