From d3957409192f2afa4aaf5e034a335119a5bd7ec6 Mon Sep 17 00:00:00 2001 From: zoziha13 <1325686572@qq.com> Date: Thu, 26 Aug 2021 20:48:47 +0800 Subject: [PATCH 01/10] add `is_close` in `stdlib_math`. --- doc/specs/stdlib_math.md | 82 ++++++++++++++++++++++++--- src/CMakeLists.txt | 1 + src/Makefile.manual | 3 + src/stdlib_math.fypp | 17 +++++- src/stdlib_math_is_close.fypp | 33 +++++++++++ src/tests/math/CMakeLists.txt | 3 +- src/tests/math/Makefile.manual | 3 +- src/tests/math/test_math_is_close.f90 | 40 +++++++++++++ 8 files changed, 170 insertions(+), 12 deletions(-) create mode 100644 src/stdlib_math_is_close.fypp create mode 100644 src/tests/math/test_math_is_close.f90 diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 8d7fb516b..3a78dc8a5 100644 --- a/doc/specs/stdlib_math.md +++ b/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 ``` \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c4c6cf858..217bcfb3f 100644 --- a/src/CMakeLists.txt +++ b/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 ) diff --git a/src/Makefile.manual b/src/Makefile.manual index 9e78df5d8..35003eb6f 100644 --- a/src/Makefile.manual +++ b/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 diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 2ca0f543d..34a4ddef8 100644 --- a/src/stdlib_math.fypp +++ b/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 diff --git a/src/stdlib_math_is_close.fypp b/src/stdlib_math_is_close.fypp new file mode 100644 index 000000000..1a9b05368 --- /dev/null +++ b/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 diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index 0bcaf1e1a..899818bc7 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -1,4 +1,5 @@ ADDTEST(stdlib_math) ADDTEST(linspace) ADDTEST(logspace) -ADDTEST(math_arange) \ No newline at end of file +ADDTEST(math_arange) +ADDTEST(math_is_close) \ No newline at end of file diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index f11cbf7a4..31bfa38c8 100644 --- a/src/tests/math/Makefile.manual +++ b/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 diff --git a/src/tests/math/test_math_is_close.f90 b/src/tests/math/test_math_is_close.f90 new file mode 100644 index 000000000..409055928 --- /dev/null +++ b/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 From 9cebec7d208c1f6e1a5f8b1a81e539750e829d9a Mon Sep 17 00:00:00 2001 From: zoziha13 <1325686572@qq.com> Date: Thu, 26 Aug 2021 20:49:11 +0800 Subject: [PATCH 02/10] Fix a warning in `arange` and avoid type conversion. --- src/stdlib_math_arange.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math_arange.fypp b/src/stdlib_math_arange.fypp index 075d76f7a..eb3be3202 100644 --- a/src/stdlib_math_arange.fypp +++ b/src/stdlib_math_arange.fypp @@ -44,7 +44,7 @@ contains step_ = optval(step, 1_${k1}$) step_ = sign(merge(step_, 1_${k1}$, step_ /= 0_${k1}$), end_ - start_) - allocate(result((end_ - start_)/step_ + 1)) + allocate(result((end_ - start_)/step_ + 1_${k1}$)) result = [(i, i=start_, end_, step_)] From c3d0bdd2397837a2c645f3b708ef7db71ec3a4bd Mon Sep 17 00:00:00 2001 From: zoziha Date: Wed, 29 Sep 2021 23:01:36 +0800 Subject: [PATCH 03/10] Update stdlib_math.is_close, like python math.isclose --- doc/specs/stdlib_math.md | 31 +++++++++++++-------------- src/stdlib_math.fypp | 6 +++--- src/stdlib_math_is_close.fypp | 20 ++++++++--------- src/tests/math/test_math_is_close.f90 | 28 ++++++++++++++---------- 4 files changed, 45 insertions(+), 40 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 3a78dc8a5..f6d10aa70 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -348,22 +348,20 @@ end program demo_math_arange #### 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`. +Returns a boolean scalar/array where two scalars/arrays are element-wise equal within a tolerance, behaves like `isclose` in Python stdlib. ```fortran !> For `real` type -abs(a - b) <= rtol*abs(b) + atol +is_close(a, b, rel_tol, abs_tol) = abs(a - b) <= max(rel_tol*(abs(a), abs(b)), abs_tol) !> For `complex` type -abs(a%re - b%re) <= rtol*abs(b%re) + atol -abs(a%im - b%im) <= rtol*abs(b%im) + atol +is_close(a, b, rel_tol, abs_tol) = is_close(a%re, b%re, rel_tol, abs_tol) .and. & + is_close(a%im, b%im, rel_tol, abs_tol) ``` #### Syntax -`bool = [[stdlib_math(module):is_close(interface)]] (a, b [, rtol, atol])` +`bool = [[stdlib_math(module):is_close(interface)]] (a, b [, rel_tol, abs_tol])` #### Status @@ -381,14 +379,15 @@ 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. +`rel_tol`: Shall be a `real` scalar. +This argument is `intent(in)` and `optional`, which is `1.0e-9` by default. -`atol`: Shall be a `real` scalar. -This argument is `intent(in)` and `optional`, which is `1.0e-8` by default. +`abs_tol`: Shall be a `real` scalar. +This argument is `intent(in)` and `optional`, which is `0.0` 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`. +Note: All `real/complex` arguments must have same `kind`. +If the value of `rel_tol/abs_tol` is negative (not recommended), +it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `is_close`. #### Result value @@ -398,11 +397,11 @@ Returns a `logical` scalar/array. ```fortran program demo_math_is_close - use stdlib_math, only: 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 + print *, is_close(x,[real :: 1, 2.1]) !! [T, F] + print *, is_close(2.0, 2.1, abs_tol=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 diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 34a4ddef8..602c23d2d 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -286,10 +286,10 @@ module stdlib_math 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) + elemental module function is_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) ${t1}$, intent(in) :: a, b - real(${k1}$), intent(in), optional :: rtol, atol - logical :: result + real(${k1}$), intent(in), optional :: rel_tol, abs_tol + logical :: close end function is_close_${t1[0]}$${k1}$ #:endfor end interface is_close diff --git a/src/stdlib_math_is_close.fypp b/src/stdlib_math_is_close.fypp index 1a9b05368..3e3832471 100644 --- a/src/stdlib_math_is_close.fypp +++ b/src/stdlib_math_is_close.fypp @@ -7,25 +7,25 @@ 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) + elemental module function is_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) ${t1}$, intent(in) :: a, b - real(${k1}$), intent(in), optional :: rtol, atol - logical :: result + real(${k1}$), intent(in), optional :: rel_tol, abs_tol + logical :: close - result = abs(a - b) <= abs(optval(rtol, 1.0e-5_${k1}$)*b) + & - abs(optval(atol, 1.0e-8_${k1}$)) + close = abs(a - b) <= max( abs(optval(rel_tol, 1.0e-9_${k1}$)*max(abs(a), abs(b))), & + abs(optval(abs_tol, 0.0_${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) + elemental module function is_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) ${t1}$, intent(in) :: a, b - real(${k1}$), intent(in), optional :: rtol, atol - logical :: result + real(${k1}$), intent(in), optional :: rel_tol, abs_tol + logical :: close - result = is_close_r${k1}$(a%re, b%re, rtol, atol) .and. & - is_close_r${k1}$(a%im, b%im, rtol, atol) + close = is_close_r${k1}$(a%re, b%re, rel_tol, abs_tol) .and. & + is_close_r${k1}$(a%im, b%im, rel_tol, abs_tol) end function is_close_${t1[0]}$${k1}$ #:endfor diff --git a/src/tests/math/test_math_is_close.f90 b/src/tests/math/test_math_is_close.f90 index 409055928..165066f54 100644 --- a/src/tests/math/test_math_is_close.f90 +++ b/src/tests/math/test_math_is_close.f90 @@ -10,13 +10,16 @@ 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(is_close(2.5, 2.5, rel_tol=1.0e-5), msg="is_close(2.5, 2.5, rel_tol=1.0e-5) failed.") + call check(all(is_close([2.5, 3.2], [2.5, 10.0], rel_tol=1.0e-5)), & + msg="all(is_close([2.5, 3.2], [2.5, 10.0], rel_tol=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)), & + abs_tol=1.0e-5, rel_tol=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.") + &rel_tol=1.0e-5, abs_tol=0.1)) failed.") + + !> Tests for zeros + call check(is_close(0.0, -0.0), msg="is_close(0.0, -0.0) failed.") end subroutine test_math_is_close_real @@ -24,16 +27,19 @@ 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).", & + call check(is_close((2.5,1.2), (2.5,1.2), rel_tol=1.0e-5), & + msg="is_close((2.5,1.2), (2.5,1.2), rel_tol=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)], rel_tol=1.0e-5)), & + msg="all(is_close([(2.5,1.2), (3.2,1.2)], [(2.5,1.2), (10.0,1.2)], rel_tol=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)), & + abs_tol=1.0e-5, rel_tol=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.") + &rel_tol=1.0e-5, abs_tol=0.1)) failed.") + + !> Tests for zeros + call check(is_close((0.0, -0.0), (-0.0, 0.0)), msg="is_close((0.0, -0.0), (-0.0, 0.0)) failed.") end subroutine test_math_is_close_complex From f9acfbe9fb618f939a8947822ac3722ae10de054 Mon Sep 17 00:00:00 2001 From: zoziha Date: Wed, 29 Sep 2021 23:10:15 +0800 Subject: [PATCH 04/10] Fix src/makefile.manual --- src/Makefile.manual | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 22754bf91..b4653d6a2 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -75,7 +75,8 @@ $(SRCGEN): %.f90: %.fypp common.fypp # Fortran module dependencies f18estop.o: stdlib_error.o stdlib_ascii.o: stdlib_kinds.o -stdlib_bitsets.o: stdlib_kinds.o +stdlib_bitsets.o: stdlib_kinds.o \ + stdlib_optval.o stdlib_bitsets_64.o: stdlib_bitsets.o stdlib_bitsets_large.o: stdlib_bitsets.o stdlib_error.o: stdlib_optval.o From d477d5a3d80b60bf6315d32f11b4f0fd595b5a24 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sat, 2 Oct 2021 20:32:02 +0800 Subject: [PATCH 05/10] Add `all_close` function in `stdlib_math`. --- doc/specs/stdlib_math.md | 62 +++++++++++++++++++++++++- src/CMakeLists.txt | 1 + src/stdlib_math.fypp | 18 +++++++- src/stdlib_math_all_close.fypp | 40 +++++++++++++++++ src/tests/math/CMakeLists.txt | 3 +- src/tests/math/Makefile.manual | 3 +- src/tests/math/test_math_all_close.f90 | 38 ++++++++++++++++ 7 files changed, 160 insertions(+), 5 deletions(-) create mode 100644 src/stdlib_math_all_close.fypp create mode 100644 src/tests/math/test_math_all_close.f90 diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index f6d10aa70..482a08cdb 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -405,4 +405,64 @@ program demo_math_is_close 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 -``` \ No newline at end of file +``` + +### `all_close` + +#### Description + +Returns a boolean scalar where two arrays are element-wise equal within a tolerance, behaves like `all(is_close(a, b [, rel_tol, abs_tol]))`. + +#### Syntax + +`bool = [[stdlib_math(module):all_close(interface)]] (a, b [, rel_tol, abs_tol])` + +#### Status + +Experimental. + +#### Class + +Impure function. + +#### Arguments + +`a`: Shall be a `real/complex` array. +This argument is `intent(in)`. + +`b`: Shall be a `real/complex` array. +This argument is `intent(in)`. + +`rel_tol`: Shall be a `real` scalar. +This argument is `intent(in)` and `optional`, which is `1.0e-9` by default. + +`abs_tol`: Shall be a `real` scalar. +This argument is `intent(in)` and `optional`, which is `0.0` by default. + +Note: All `real/complex` arguments must have same `kind`. +If the value of `rel_tol/abs_tol` is negative (not recommended), +it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `all_close`. + +#### Result value + +Returns a `logical` scalar. + +#### Example + +```fortran +program demo_math_all_close + use stdlib_math, only: all_close + use stdlib_error, only: check + real :: x(2) = [1, 2], random(4, 4) + complex :: z(4, 4) + + call check(all_close(x, [2.0, 2.0], rel_tol=1.0e-6, abs_tol=1.0e-3), & + msg="all_close(x, [2.0, 2.0]) failed.", warn=.true.) + !! all_close(x, [2.0, 2.0]) failed. + + call random_number(random(4, 4)) + z = 1.0 + print *, all_close(z+1.0e-11*random, z) !! T + +end program demo_math_all_close +``` diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 69a3d67a0..e7e33e154 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -34,6 +34,7 @@ set(fppFiles stdlib_math_logspace.fypp stdlib_math_arange.fypp stdlib_math_is_close.fypp + stdlib_math_all_close.fypp stdlib_string_type.fypp stdlib_string_type_constructor.fypp stdlib_strings_to_string.fypp diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 602c23d2d..1122e92c5 100644 --- a/src/stdlib_math.fypp +++ b/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, is_close + public :: arange, is_close, all_close integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 @@ -281,7 +281,7 @@ module stdlib_math !> Version: experimental !> - !> Determines whether the values of `a` and `b` are close. + !> Returns a boolean scalar/array where two scalar/arrays are element-wise equal within a tolerance. !> ([Specification](../page/specs/stdlib_logic.html#is_close)) interface is_close #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES @@ -294,6 +294,20 @@ module stdlib_math #:endfor end interface is_close + !> Version: experimental + !> + !> Returns a boolean scalar where two arrays are element-wise equal within a tolerance. + !> ([Specification](../page/specs/stdlib_logic.html#all_close)) + interface all_close + #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + #:for k1, t1 in RC_KINDS_TYPES + logical module function all_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + ${t1}$, intent(in) :: a(..), b(..) + real(${k1}$), intent(in), optional :: rel_tol, abs_tol + end function all_close_${t1[0]}$${k1}$ + #:endfor + end interface all_close + contains #:for k1, t1 in IR_KINDS_TYPES diff --git a/src/stdlib_math_all_close.fypp b/src/stdlib_math_all_close.fypp new file mode 100644 index 000000000..12e0ae86e --- /dev/null +++ b/src/stdlib_math_all_close.fypp @@ -0,0 +1,40 @@ +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + +submodule (stdlib_math) stdlib_math_all_close + + implicit none + +contains + + #:def inrank(r1) + rank(${r1}$) + select rank(b) + rank(${r1}$) + close = all(is_close(a, b, rel_tol, abs_tol)) + rank default + error stop "** The ranks of `a` and `b` in `all_close` are not equal." + end select + #:enddef + + #:for k1, t1 in RC_KINDS_TYPES + logical module function all_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + + ${t1}$, intent(in) :: a(..), b(..) + real(${k1}$), intent(in), optional :: rel_tol, abs_tol + + select rank(a) + + #:for r1 in RANKS + $:inrank(r1) + #:endfor + + rank default + error stop "** The rank of `a` in `all_close` is too large to be supported." + end select + + end function all_close_${t1[0]}$${k1}$ + #:endfor + +end submodule stdlib_math_all_close \ No newline at end of file diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index 899818bc7..80f3bbf28 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -2,4 +2,5 @@ ADDTEST(stdlib_math) ADDTEST(linspace) ADDTEST(logspace) ADDTEST(math_arange) -ADDTEST(math_is_close) \ No newline at end of file +ADDTEST(math_is_close) +ADDTEST(math_all_close) \ No newline at end of file diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index 31bfa38c8..1adcb415a 100644 --- a/src/tests/math/Makefile.manual +++ b/src/tests/math/Makefile.manual @@ -1,6 +1,7 @@ PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 test_logspace.f90 \ test_math_arange.f90 \ - test_math_is_close.f90 + test_math_is_close.f90 \ + test_math_all_close.f90 include ../Makefile.manual.test.mk diff --git a/src/tests/math/test_math_all_close.f90 b/src/tests/math/test_math_all_close.f90 new file mode 100644 index 000000000..34cf0766e --- /dev/null +++ b/src/tests/math/test_math_all_close.f90 @@ -0,0 +1,38 @@ +program tester + + use stdlib_math, only: all_close + use stdlib_error, only: check + implicit none + + call test_math_all_close_real + call test_math_all_close_complex + print *, "All tests in `test_math_all_close` passed." + +contains + + subroutine test_math_all_close_real + + real :: x(4, 4), random(4, 4) + + call random_number(random) + x = 1.0 + + call check(all_close(x+1.0e-11*random, x), msg="REAL: all_close(x+1.0e-11*random, x) failed.") + call check(all_close(x+1.0e-5 *random, x), msg="REAL: all_close(x+1.0e-5 *random, x) failed.", warn=.true.) + + end subroutine test_math_all_close_real + + subroutine test_math_all_close_complex + + real :: random(4, 4) + complex :: x(4, 4) + + call random_number(random) + x = 1.0 + + call check(all_close(x+1.0e-11*random, x), msg="CMPLX: all_close(x+1.0e-11*random, x)") + call check(all_close(x+1.0e-5 *random, x), msg="CMPLX: all_close(x+1.0e-5 *random, x) failed.", warn=.true.) + + end subroutine test_math_all_close_complex + +end program tester From 064e7f38bd04427830c2fa357fc5fa55c23c354f Mon Sep 17 00:00:00 2001 From: zoziha Date: Sun, 3 Oct 2021 17:20:22 +0800 Subject: [PATCH 06/10] Change the `all_close` implementation: gcc9 not support `select rank`. --- src/stdlib_math.fypp | 9 ++++++--- src/stdlib_math_all_close.fypp | 28 ++++++---------------------- 2 files changed, 12 insertions(+), 25 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 1122e92c5..1909b6fc4 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -300,11 +300,14 @@ module stdlib_math !> ([Specification](../page/specs/stdlib_logic.html#all_close)) interface all_close #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + #:set RANKS = range(1, MAXRANK + 1) #:for k1, t1 in RC_KINDS_TYPES - logical module function all_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) - ${t1}$, intent(in) :: a(..), b(..) + #:for r1 in RANKS + logical module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + ${t1}$, intent(in) :: a${ranksuffix(r1)}$, b${ranksuffix(r1)}$ real(${k1}$), intent(in), optional :: rel_tol, abs_tol - end function all_close_${t1[0]}$${k1}$ + end function all_close_${r1}$_${t1[0]}$${k1}$ + #:endfor #:endfor end interface all_close diff --git a/src/stdlib_math_all_close.fypp b/src/stdlib_math_all_close.fypp index 12e0ae86e..0bec888de 100644 --- a/src/stdlib_math_all_close.fypp +++ b/src/stdlib_math_all_close.fypp @@ -8,33 +8,17 @@ submodule (stdlib_math) stdlib_math_all_close contains - #:def inrank(r1) - rank(${r1}$) - select rank(b) - rank(${r1}$) - close = all(is_close(a, b, rel_tol, abs_tol)) - rank default - error stop "** The ranks of `a` and `b` in `all_close` are not equal." - end select - #:enddef - #:for k1, t1 in RC_KINDS_TYPES - logical module function all_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + #:for r1 in RANKS + logical module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) - ${t1}$, intent(in) :: a(..), b(..) + ${t1}$, intent(in) :: a${ranksuffix(r1)}$, b${ranksuffix(r1)}$ real(${k1}$), intent(in), optional :: rel_tol, abs_tol - select rank(a) - - #:for r1 in RANKS - $:inrank(r1) - #:endfor + close = all(is_close(a, b, rel_tol, abs_tol)) - rank default - error stop "** The rank of `a` in `all_close` is too large to be supported." - end select - - end function all_close_${t1[0]}$${k1}$ + end function all_close_${r1}$_${t1[0]}$${k1}$ + #:endfor #:endfor end submodule stdlib_math_all_close \ No newline at end of file From 122837df0d5964f2615762f19388c9b500352836 Mon Sep 17 00:00:00 2001 From: zoziha Date: Sun, 3 Oct 2021 17:59:45 +0800 Subject: [PATCH 07/10] Add `pure` label for `all_close`. --- doc/specs/stdlib_math.md | 2 +- src/stdlib_math.fypp | 2 +- src/stdlib_math_all_close.fypp | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 96f7f1279..7ce29ccbd 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -468,7 +468,7 @@ Experimental. #### Class -Impure function. +Pure function. #### Arguments diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 23407e801..72d9e1808 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -313,7 +313,7 @@ module stdlib_math #:set RANKS = range(1, MAXRANK + 1) #:for k1, t1 in RC_KINDS_TYPES #:for r1 in RANKS - logical module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + logical pure module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) ${t1}$, intent(in) :: a${ranksuffix(r1)}$, b${ranksuffix(r1)}$ real(${k1}$), intent(in), optional :: rel_tol, abs_tol end function all_close_${r1}$_${t1[0]}$${k1}$ diff --git a/src/stdlib_math_all_close.fypp b/src/stdlib_math_all_close.fypp index 0bec888de..ff70a5671 100644 --- a/src/stdlib_math_all_close.fypp +++ b/src/stdlib_math_all_close.fypp @@ -10,7 +10,7 @@ contains #:for k1, t1 in RC_KINDS_TYPES #:for r1 in RANKS - logical module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + logical pure module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) ${t1}$, intent(in) :: a${ranksuffix(r1)}$, b${ranksuffix(r1)}$ real(${k1}$), intent(in), optional :: rel_tol, abs_tol From adfb820a56cd0ec03f36385ff0b8115270dda828 Mon Sep 17 00:00:00 2001 From: zoziha Date: Wed, 10 Nov 2021 11:51:21 +0800 Subject: [PATCH 08/10] Add `equal_nan` argument, for `**_close` in stdlib_math. --- doc/specs/stdlib_math.md | 48 ++++++++++++++++++-------- src/stdlib_math.fypp | 7 ++-- src/stdlib_math_all_close.fypp | 5 +-- src/stdlib_math_is_close.fypp | 28 ++++++++++----- src/tests/math/test_math_all_close.f90 | 31 ++++++++++------- src/tests/math/test_math_is_close.f90 | 39 ++++++++++++++++----- 6 files changed, 109 insertions(+), 49 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index b51430bbb..36420f889 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -406,7 +406,7 @@ is_close(a, b, rel_tol, abs_tol) = is_close(a%re, b%re, rel_tol, abs_tol) .and. #### Syntax -`bool = [[stdlib_math(module):is_close(interface)]] (a, b [, rel_tol, abs_tol])` +`bool = [[stdlib_math(module):is_close(interface)]] (a, b [, rel_tol, abs_tol, equal_nan])` #### Status @@ -424,12 +424,15 @@ This argument is `intent(in)`. `b`: Shall be a `real/complex` scalar/array. This argument is `intent(in)`. -`rel_tol`: Shall be a `real` scalar. +`rel_tol`: Shall be a `real` scalar/array. This argument is `intent(in)` and `optional`, which is `1.0e-9` by default. -`abs_tol`: Shall be a `real` scalar. +`abs_tol`: Shall be a `real` scalar/array. This argument is `intent(in)` and `optional`, which is `0.0` by default. +`equal_nan`: Shall be a `logical` scalar/array. +This argument is `intent(in)` and `optional`, which is `.false.` by default. + Note: All `real/complex` arguments must have same `kind`. If the value of `rel_tol/abs_tol` is negative (not recommended), it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `is_close`. @@ -442,13 +445,22 @@ Returns a `logical` scalar/array. ```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, abs_tol=0.1) !! T + real :: x(2) = [1, 2], y, NAN + + y = -3 + NAN = sqrt(y) + + print *, is_close(x,[real :: 1, 2.1]) !! [T, F] + print *, is_close(2.0, 2.1, abs_tol=0.1) !! T + print *, NAN, is_close(2.0, NAN), is_close(2.0, NAN, equal_nan=.true.) !! NAN, F, F + print *, is_close(NAN, NAN), is_close(NAN, NAN, equal_nan=.true.) !! F, 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. + !! all(is_close(x, [2.0, 2.0])) failed. + end program demo_math_is_close ``` @@ -456,11 +468,11 @@ end program demo_math_is_close #### Description -Returns a boolean scalar where two arrays are element-wise equal within a tolerance, behaves like `all(is_close(a, b [, rel_tol, abs_tol]))`. +Returns a boolean scalar where two arrays are element-wise equal within a tolerance, behaves like `all(is_close(a, b [, rel_tol, abs_tol, equal_nan]))`. #### Syntax -`bool = [[stdlib_math(module):all_close(interface)]] (a, b [, rel_tol, abs_tol])` +`bool = [[stdlib_math(module):all_close(interface)]] (a, b [, rel_tol, abs_tol, equal_nan])` #### Status @@ -484,6 +496,9 @@ This argument is `intent(in)` and `optional`, which is `1.0e-9` by default. `abs_tol`: Shall be a `real` scalar. This argument is `intent(in)` and `optional`, which is `0.0` by default. +`equal_nan`: Shall be a `logical` scalar. +This argument is `intent(in)` and `optional`, which is `.false.` by default. + Note: All `real/complex` arguments must have same `kind`. If the value of `rel_tol/abs_tol` is negative (not recommended), it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `all_close`. @@ -496,18 +511,23 @@ Returns a `logical` scalar. ```fortran program demo_math_all_close + use stdlib_math, only: all_close use stdlib_error, only: check - real :: x(2) = [1, 2], random(4, 4) + real :: x(2) = [1, 2], y, NAN complex :: z(4, 4) + y = -3 + NAN = sqrt(y) + z = (1.0, 1.0) + + print *, all_close(z+cmplx(1.0e-11, 1.0e-11), z) !! T + print *, NAN, all_close([NAN], [NAN]), all_close([NAN], [NAN], equal_nan=.true.) + !! NAN, F, T + call check(all_close(x, [2.0, 2.0], rel_tol=1.0e-6, abs_tol=1.0e-3), & msg="all_close(x, [2.0, 2.0]) failed.", warn=.true.) !! all_close(x, [2.0, 2.0]) failed. - - call random_number(random(4, 4)) - z = 1.0 - print *, all_close(z+1.0e-11*random, z) !! T end program demo_math_all_close ``` diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 593312bf2..a52bff34d 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -296,10 +296,10 @@ module stdlib_math 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, rel_tol, abs_tol) result(close) + elemental module logical function is_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol, equal_nan) result(close) ${t1}$, intent(in) :: a, b real(${k1}$), intent(in), optional :: rel_tol, abs_tol - logical :: close + logical, intent(in), optional :: equal_nan end function is_close_${t1[0]}$${k1}$ #:endfor end interface is_close @@ -313,9 +313,10 @@ module stdlib_math #:set RANKS = range(1, MAXRANK + 1) #:for k1, t1 in RC_KINDS_TYPES #:for r1 in RANKS - logical pure module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + logical pure module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol, equal_nan) result(close) ${t1}$, intent(in) :: a${ranksuffix(r1)}$, b${ranksuffix(r1)}$ real(${k1}$), intent(in), optional :: rel_tol, abs_tol + logical, intent(in), optional :: equal_nan end function all_close_${r1}$_${t1[0]}$${k1}$ #:endfor #:endfor diff --git a/src/stdlib_math_all_close.fypp b/src/stdlib_math_all_close.fypp index ff70a5671..788587e62 100644 --- a/src/stdlib_math_all_close.fypp +++ b/src/stdlib_math_all_close.fypp @@ -10,12 +10,13 @@ contains #:for k1, t1 in RC_KINDS_TYPES #:for r1 in RANKS - logical pure module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close) + logical pure module function all_close_${r1}$_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol, equal_nan) result(close) ${t1}$, intent(in) :: a${ranksuffix(r1)}$, b${ranksuffix(r1)}$ real(${k1}$), intent(in), optional :: rel_tol, abs_tol + logical, intent(in), optional :: equal_nan - close = all(is_close(a, b, rel_tol, abs_tol)) + close = all(is_close(a, b, rel_tol, abs_tol, equal_nan)) end function all_close_${r1}$_${t1[0]}$${k1}$ #:endfor diff --git a/src/stdlib_math_is_close.fypp b/src/stdlib_math_is_close.fypp index 3e3832471..fd1fab7c6 100644 --- a/src/stdlib_math_is_close.fypp +++ b/src/stdlib_math_is_close.fypp @@ -2,30 +2,40 @@ submodule(stdlib_math) stdlib_math_is_close + use, intrinsic :: ieee_arithmetic, only: ieee_is_nan + implicit none + 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, rel_tol, abs_tol) result(close) + elemental module logical function is_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol, equal_nan) result(close) ${t1}$, intent(in) :: a, b real(${k1}$), intent(in), optional :: rel_tol, abs_tol - logical :: close - - close = abs(a - b) <= max( abs(optval(rel_tol, 1.0e-9_${k1}$)*max(abs(a), abs(b))), & - abs(optval(abs_tol, 0.0_${k1}$)) ) + logical, intent(in), optional :: equal_nan + logical :: equal_nan_ + + equal_nan_ = optval(equal_nan, .false.) + + if (ieee_is_nan(a) .or. ieee_is_nan(b)) then + close = merge(.true., .false., equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b)) + else + close = abs(a - b) <= max( abs(optval(rel_tol, 1.0e-9_${k1}$)*max(abs(a), abs(b))), & + abs(optval(abs_tol, 0.0_${k1}$)) ) + end if 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, rel_tol, abs_tol) result(close) + elemental module logical function is_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol, equal_nan) result(close) ${t1}$, intent(in) :: a, b real(${k1}$), intent(in), optional :: rel_tol, abs_tol - logical :: close + logical, intent(in), optional :: equal_nan - close = is_close_r${k1}$(a%re, b%re, rel_tol, abs_tol) .and. & - is_close_r${k1}$(a%im, b%im, rel_tol, abs_tol) + close = is_close_r${k1}$(a%re, b%re, rel_tol, abs_tol, equal_nan) .and. & + is_close_r${k1}$(a%im, b%im, rel_tol, abs_tol, equal_nan) end function is_close_${t1[0]}$${k1}$ #:endfor diff --git a/src/tests/math/test_math_all_close.f90 b/src/tests/math/test_math_all_close.f90 index 34cf0766e..afdffa56c 100644 --- a/src/tests/math/test_math_all_close.f90 +++ b/src/tests/math/test_math_all_close.f90 @@ -3,7 +3,11 @@ program tester use stdlib_math, only: all_close use stdlib_error, only: check implicit none - + real :: y, NAN + + y = -3 + NAN = sqrt(y) + call test_math_all_close_real call test_math_all_close_complex print *, "All tests in `test_math_all_close` passed." @@ -12,26 +16,29 @@ program tester subroutine test_math_all_close_real - real :: x(4, 4), random(4, 4) + real :: x(4, 4) = 1.0 - call random_number(random) - x = 1.0 + call check(all_close(x + 1.0e-11, x), msg="REAL: all_close(x+1.0e-11, x) failed.") + call check(all_close(x + 1.0e-5, x), msg="REAL: all_close(x+1.0e-5 , x) failed. (expected)", warn=.true.) - call check(all_close(x+1.0e-11*random, x), msg="REAL: all_close(x+1.0e-11*random, x) failed.") - call check(all_close(x+1.0e-5 *random, x), msg="REAL: all_close(x+1.0e-5 *random, x) failed.", warn=.true.) + !> Tests for NAN + call check(all_close(x + NAN, x), msg="REAL: all_close(x+NAN, x) failed. (expected)", warn=.true.) + call check(all_close(x + NAN, x + NAN, equal_nan=.true.), msg="REAL: all_close(x+NAN, x, equal_nan=.true.) failed.") end subroutine test_math_all_close_real subroutine test_math_all_close_complex - real :: random(4, 4) - complex :: x(4, 4) + complex :: x(4, 4) = cmplx(1.0, 1.0) - call random_number(random) - x = 1.0 + call check(all_close(x + cmplx((1.0e-15, 1.0e-15)), x), msg="CMPLX: all_close(x+cmplx(1.0e-11, 1.0e-11), x)") + call check(all_close(x + cmplx(1.0e-5, 1.0e-5), x), & + msg="CMPLX: all_close(x+cmplx(1.0e-5 , 1.0e-5 ), x) failed. (expected)", warn=.true.) - call check(all_close(x+1.0e-11*random, x), msg="CMPLX: all_close(x+1.0e-11*random, x)") - call check(all_close(x+1.0e-5 *random, x), msg="CMPLX: all_close(x+1.0e-5 *random, x) failed.", warn=.true.) + !> Tests for NAN + call check(all_close(x + cmplx(NAN, NAN), x), msg="REAL: all_close(x+cmplx(NAN, NAN), x) failed. (expected)", warn=.true.) + call check(all_close(x + cmplx(NAN, NAN), x + cmplx(NAN, NAN), equal_nan=.true.), & + msg="REAL: all_close(x+cmplx(NAN, NAN), x, equal_nan=.true.) failed.") end subroutine test_math_all_close_complex diff --git a/src/tests/math/test_math_is_close.f90 b/src/tests/math/test_math_is_close.f90 index 165066f54..e11043f83 100644 --- a/src/tests/math/test_math_is_close.f90 +++ b/src/tests/math/test_math_is_close.f90 @@ -1,5 +1,11 @@ program test_math_is_close + implicit none + + real :: x, NAN + x = -3 + NAN = sqrt(x) + call test_math_is_close_real call test_math_is_close_complex print *, "All tests in `test_math_is_close` passed." @@ -12,7 +18,7 @@ subroutine test_math_is_close_real call check(is_close(2.5, 2.5, rel_tol=1.0e-5), msg="is_close(2.5, 2.5, rel_tol=1.0e-5) failed.") call check(all(is_close([2.5, 3.2], [2.5, 10.0], rel_tol=1.0e-5)), & - msg="all(is_close([2.5, 3.2], [2.5, 10.0], rel_tol=1.0e-5)) failed (expected).", warn=.true.) + msg="all(is_close([2.5, 3.2], [2.5, 10.0], rel_tol=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]), & abs_tol=1.0e-5, rel_tol=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]), & @@ -21,26 +27,41 @@ subroutine test_math_is_close_real !> Tests for zeros call check(is_close(0.0, -0.0), msg="is_close(0.0, -0.0) failed.") + !> Tests for NaN + call check(is_close(NAN, NAN), msg="is_close(NAN, NAN) failed.", warn=.true.) + call check(is_close(NAN, NAN, equal_nan=.true.), msg="is_close(NAN, NAN, equal_nan=.true.) 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), rel_tol=1.0e-5), & + call check(is_close((2.5, 1.2), (2.5, 1.2), rel_tol=1.0e-5), & msg="is_close((2.5,1.2), (2.5,1.2), rel_tol=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)], rel_tol=1.0e-5)), & - msg="all(is_close([(2.5,1.2), (3.2,1.2)], [(2.5,1.2), (10.0,1.2)], rel_tol=1.0e-5)) failed (expected).", & + call check(all(is_close([(2.5, 1.2), (3.2, 1.2)], [(2.5, 1.2), (10.0, 1.2)], rel_tol=1.0e-5)), & + msg="all(is_close([(2.5,1.2), (3.2,1.2)], [(2.5,1.2), (10.0,1.2)], rel_tol=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]), & - abs_tol=1.0e-5, rel_tol=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]), & - &rel_tol=1.0e-5, abs_tol=0.1)) failed.") + 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]), & + abs_tol=1.0e-5, rel_tol=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]), & + &rel_tol=1.0e-5, abs_tol=0.1)) failed.") !> Tests for zeros call check(is_close((0.0, -0.0), (-0.0, 0.0)), msg="is_close((0.0, -0.0), (-0.0, 0.0)) failed.") + !> Tests for NaN + call check(is_close(cmplx(NAN, NAN), cmplx(NAN, NAN)), & + msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN)) failed. (expected)", warn=.true.) + call check(is_close(cmplx(NAN, NAN), cmplx(NAN, NAN), equal_nan=.true.), & + msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN), equal_nan=.true.) failed.") + call check(is_close(cmplx(NAN, 1.0), cmplx(NAN, 1.0)), & + msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN)) failed. (expected)", warn=.true.) + call check(is_close(cmplx(NAN, 1.0), cmplx(NAN, 1.0), equal_nan=.true.), & + msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN), equal_nan=.ture.) failed.") + end subroutine test_math_is_close_complex end program test_math_is_close From 268cedc522c73a675545ebd0e5e754609287993b Mon Sep 17 00:00:00 2001 From: zoziha Date: Wed, 8 Dec 2021 17:38:58 +0800 Subject: [PATCH 09/10] Update tests for **_close, 1.0e-9 -> sqrt(epsilon(..)) --- doc/specs/stdlib_math.md | 37 +++++------ src/stdlib_math.fypp | 4 +- src/stdlib_math_is_close.fypp | 6 +- src/tests/math/test_stdlib_math.fypp | 93 +++++++++++++++++++++++++++- 4 files changed, 116 insertions(+), 24 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 36420f889..2ce8bfce6 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -393,13 +393,13 @@ end program demo_math_arange #### Description -Returns a boolean scalar/array where two scalars/arrays are element-wise equal within a tolerance, behaves like `isclose` in Python stdlib. +Returns a boolean scalar/array where two scalars/arrays are element-wise equal within a tolerance. ```fortran !> For `real` type is_close(a, b, rel_tol, abs_tol) = abs(a - b) <= max(rel_tol*(abs(a), abs(b)), abs_tol) -!> For `complex` type +!> and for `complex` type is_close(a, b, rel_tol, abs_tol) = is_close(a%re, b%re, rel_tol, abs_tol) .and. & is_close(a%im, b%im, rel_tol, abs_tol) ``` @@ -418,6 +418,10 @@ Elemental function. #### Arguments +Note: All `real/complex` arguments must have same `kind`. +If the value of `rel_tol/abs_tol` is negative (not recommended), +it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `is_close`. + `a`: Shall be a `real/complex` scalar/array. This argument is `intent(in)`. @@ -425,17 +429,15 @@ This argument is `intent(in)`. This argument is `intent(in)`. `rel_tol`: Shall be a `real` scalar/array. -This argument is `intent(in)` and `optional`, which is `1.0e-9` by default. +This argument is `intent(in)` and `optional`, which is `sqrt(epsilon(..))` by default. `abs_tol`: Shall be a `real` scalar/array. This argument is `intent(in)` and `optional`, which is `0.0` by default. `equal_nan`: Shall be a `logical` scalar/array. This argument is `intent(in)` and `optional`, which is `.false.` by default. - -Note: All `real/complex` arguments must have same `kind`. -If the value of `rel_tol/abs_tol` is negative (not recommended), -it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `is_close`. +Whether to compare `NaN` values as equal. If `.true.`, +`NaN` values in `a` will be considered equal to `NaN` values in `b`. #### Result value @@ -457,9 +459,6 @@ program demo_math_is_close print *, is_close(2.0, 2.1, abs_tol=0.1) !! T print *, NAN, is_close(2.0, NAN), is_close(2.0, NAN, equal_nan=.true.) !! NAN, F, F print *, is_close(NAN, NAN), is_close(NAN, NAN, equal_nan=.true.) !! F, 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 ``` @@ -468,7 +467,7 @@ end program demo_math_is_close #### Description -Returns a boolean scalar where two arrays are element-wise equal within a tolerance, behaves like `all(is_close(a, b [, rel_tol, abs_tol, equal_nan]))`. +Returns a boolean scalar where two arrays are element-wise equal within a tolerance. #### Syntax @@ -484,6 +483,10 @@ Pure function. #### Arguments +Note: All `real/complex` arguments must have same `kind`. +If the value of `rel_tol/abs_tol` is negative (not recommended), +it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `all_close`. + `a`: Shall be a `real/complex` array. This argument is `intent(in)`. @@ -491,17 +494,15 @@ This argument is `intent(in)`. This argument is `intent(in)`. `rel_tol`: Shall be a `real` scalar. -This argument is `intent(in)` and `optional`, which is `1.0e-9` by default. +This argument is `intent(in)` and `optional`, which is `sqrt(epsilon(..))` by default. `abs_tol`: Shall be a `real` scalar. This argument is `intent(in)` and `optional`, which is `0.0` by default. `equal_nan`: Shall be a `logical` scalar. This argument is `intent(in)` and `optional`, which is `.false.` by default. - -Note: All `real/complex` arguments must have same `kind`. -If the value of `rel_tol/abs_tol` is negative (not recommended), -it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `all_close`. +Whether to compare `NaN` values as equal. If `.true.`, +`NaN` values in `a` will be considered equal to `NaN` values in `b`. #### Result value @@ -524,10 +525,6 @@ program demo_math_all_close print *, all_close(z+cmplx(1.0e-11, 1.0e-11), z) !! T print *, NAN, all_close([NAN], [NAN]), all_close([NAN], [NAN], equal_nan=.true.) !! NAN, F, T - - call check(all_close(x, [2.0, 2.0], rel_tol=1.0e-6, abs_tol=1.0e-3), & - msg="all_close(x, [2.0, 2.0]) failed.", warn=.true.) - !! all_close(x, [2.0, 2.0]) failed. end program demo_math_all_close ``` diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index a0d451841..2db5d2a56 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -297,7 +297,7 @@ module stdlib_math !> Version: experimental !> !> Returns a boolean scalar/array where two scalar/arrays are element-wise equal within a tolerance. - !> ([Specification](../page/specs/stdlib_logic.html#is_close)) + !> ([Specification](../page/specs/stdlib_math.html#is_close)) interface is_close #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES #:for k1, t1 in RC_KINDS_TYPES @@ -312,7 +312,7 @@ module stdlib_math !> Version: experimental !> !> Returns a boolean scalar where two arrays are element-wise equal within a tolerance. - !> ([Specification](../page/specs/stdlib_logic.html#all_close)) + !> ([Specification](../page/specs/stdlib_math.html#all_close)) interface all_close #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES #:set RANKS = range(1, MAXRANK + 1) diff --git a/src/stdlib_math_is_close.fypp b/src/stdlib_math_is_close.fypp index fd1fab7c6..b97134802 100644 --- a/src/stdlib_math_is_close.fypp +++ b/src/stdlib_math_is_close.fypp @@ -5,6 +5,10 @@ submodule(stdlib_math) stdlib_math_is_close use, intrinsic :: ieee_arithmetic, only: ieee_is_nan implicit none + #:for k1 in REAL_KINDS + real(${k1}$), parameter :: sqrt_eps_${k1}$ = sqrt(epsilon(1.0_${k1}$)) + #:endfor + contains #! Determines whether the values of `a` and `b` are close. @@ -21,7 +25,7 @@ contains if (ieee_is_nan(a) .or. ieee_is_nan(b)) then close = merge(.true., .false., equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b)) else - close = abs(a - b) <= max( abs(optval(rel_tol, 1.0e-9_${k1}$)*max(abs(a), abs(b))), & + close = abs(a - b) <= max( abs(optval(rel_tol, sqrt_eps_${k1}$)*max(abs(a), abs(b))), & abs(optval(abs_tol, 0.0_${k1}$)) ) end if diff --git a/src/tests/math/test_stdlib_math.fypp b/src/tests/math/test_stdlib_math.fypp index 651fea610..72c3adf5b 100644 --- a/src/tests/math/test_stdlib_math.fypp +++ b/src/tests/math/test_stdlib_math.fypp @@ -4,7 +4,7 @@ module test_stdlib_math use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_math, only: clip + use stdlib_math, only: clip, is_close, all_close use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp implicit none @@ -32,6 +32,14 @@ contains new_unittest("clip-real-double-bounds", test_clip_rdp_bounds), & new_unittest("clip-real-quad", test_clip_rqp), & new_unittest("clip-real-quad-bounds", test_clip_rqp_bounds) & + + !> Tests for `is_close` and `all_close` + #:for k1 in REAL_KINDS + , new_unittest("is_close-real-${k1}$", test_is_close_real_${k1}$) & + , new_unittest("is_close-cmplx-${k1}$", test_is_close_cmplx_${k1}$) & + , new_unittest("all_close-real-${k1}$", test_all_close_real_${k1}$) & + , new_unittest("all_close-cmplx-${k1}$", test_all_close_cmplx_${k1}$) & + #:endfor ] end subroutine collect_stdlib_math @@ -203,6 +211,89 @@ contains #:endif end subroutine test_clip_rqp_bounds + + #:for k1 in REAL_KINDS + subroutine test_is_close_real_${k1}$(error) + type(error_type), allocatable, intent(out) :: error + real(${k1}$) :: x, NAN + x = -3; NAN = sqrt(x) + + call check(error, is_close(2.5_${k1}$, 2.5_${k1}$), .true.) + if (allocated(error)) return + call check(error, is_close(0.0_${k1}$, -0.0_${k1}$), .true.) + if (allocated(error)) return + call check(error, is_close(2.5_${k1}$, 1.2_${k1}$), .false.) + if (allocated(error)) return + call check(error, is_close(NAN, NAN), .false.) + if (allocated(error)) return + call check(error, is_close(NAN, 0.0_${k1}$), .false.) + if (allocated(error)) return + call check(error, is_close(NAN, NAN, equal_nan=.true.), .true.) + + end subroutine test_is_close_real_${k1}$ + + subroutine test_is_close_cmplx_${k1}$(error) + type(error_type), allocatable, intent(out) :: error + real(${k1}$) :: x, NAN + x = -3; NAN = sqrt(x) + + call check(error, is_close((2.5_${k1}$, 1.5_${k1}$), (2.5_${k1}$, 1.5_${k1}$)), .true.) + if (allocated(error)) return + call check(error, is_close((2.5_${k1}$, 1.2_${k1}$), (2.5_${k1}$, 1.5_${k1}$)), .false.) + if (allocated(error)) return + call check(error, is_close(cmplx(NAN, NAN, ${k1}$), cmplx(NAN, NAN, ${k1}$)), .false.) + if (allocated(error)) return + call check(error, is_close(cmplx(NAN, NAN, ${k1}$), cmplx(NAN, 0.0_${k1}$, ${k1}$)), .false.) + if (allocated(error)) return + call check(error, is_close(cmplx(NAN, NAN, ${k1}$), cmplx(NAN, NAN, ${k1}$), equal_nan=.true.), .true.) + if (allocated(error)) return + call check(error, is_close(cmplx(NAN, 1.2_${k1}$, ${k1}$), cmplx(NAN, 1.2_${k1}$, ${k1}$), equal_nan=.true.), .true.) + + end subroutine test_is_close_cmplx_${k1}$ + + subroutine test_all_close_real_${k1}$(error) + type(error_type), allocatable, intent(out) :: error + real(${k1}$) :: x(2, 2), eps, NAN + x = 1; eps = -3; NAN = sqrt(eps) + + eps = sqrt(epsilon(1.0_${k1}$)) + + call check(error, all_close(x, x), .true.) + if (allocated(error)) return + call check(error, all_close(x + x*eps + 1.0e-6, x), .false.) + if (allocated(error)) return + call check(error, all_close(x + NAN, x), .false.) + if (allocated(error)) return + call check(error, all_close(x + NAN, x, equal_nan=.true.), .false.) + if (allocated(error)) return + call check(error, all_close(x + NAN, x + NAN), .false.) + if (allocated(error)) return + call check(error, all_close(x + NAN, x + NAN, equal_nan=.true.), .true.) + + end subroutine test_all_close_real_${k1}$ + + subroutine test_all_close_cmplx_${k1}$(error) + type(error_type), allocatable, intent(out) :: error + real(${k1}$) :: eps, NAN + complex(${k1}$) :: x(2, 2) + x = (1, 1); eps = -3; NAN = sqrt(eps) + + eps = sqrt(epsilon(1.0_${k1}$)) + + call check(error, all_close(x, x), .true.) + if (allocated(error)) return + call check(error, all_close(x + x*eps + 1.0e-6, x), .false.) + if (allocated(error)) return + call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x), .false.) + if (allocated(error)) return + call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x, equal_nan=.true.), .false.) + if (allocated(error)) return + call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x + cmplx(NAN, NAN, ${k1}$), equal_nan=.true.), .true.) + if (allocated(error)) return + call check(error, all_close(x + cmplx(NAN, NAN, ${k1}$), x + cmplx(NAN, NAN, ${k1}$)), .false.) + + end subroutine test_all_close_cmplx_${k1}$ + #:endfor end module test_stdlib_math From 549ee96c726bd7f37798ab0b6f064737549aff39 Mon Sep 17 00:00:00 2001 From: zoziha Date: Wed, 8 Dec 2021 17:40:28 +0800 Subject: [PATCH 10/10] Remove old tests for **_close. --- src/tests/math/CMakeLists.txt | 2 - src/tests/math/Makefile.manual | 2 - src/tests/math/test_math_all_close.f90 | 45 ----------------- src/tests/math/test_math_is_close.f90 | 67 -------------------------- 4 files changed, 116 deletions(-) delete mode 100644 src/tests/math/test_math_all_close.f90 delete mode 100644 src/tests/math/test_math_is_close.f90 diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index 4223db15d..9d11bf765 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -8,5 +8,3 @@ ADDTEST(stdlib_math) ADDTEST(linspace) ADDTEST(logspace) ADDTEST(math_arange) -ADDTEST(math_is_close) -ADDTEST(math_all_close) diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index 935d02f73..9063a376b 100644 --- a/src/tests/math/Makefile.manual +++ b/src/tests/math/Makefile.manual @@ -4,8 +4,6 @@ SRCGEN = $(SRCFYPP:.fypp=.f90) PROGS_SRC = test_linspace.f90 test_logspace.f90 \ test_math_arange.f90 \ - test_math_is_close.f90 \ - test_math_all_close.f90 \ $(SRCGEN) $(SRCGEN): %.f90: %.fypp ../../common.fypp diff --git a/src/tests/math/test_math_all_close.f90 b/src/tests/math/test_math_all_close.f90 deleted file mode 100644 index afdffa56c..000000000 --- a/src/tests/math/test_math_all_close.f90 +++ /dev/null @@ -1,45 +0,0 @@ -program tester - - use stdlib_math, only: all_close - use stdlib_error, only: check - implicit none - real :: y, NAN - - y = -3 - NAN = sqrt(y) - - call test_math_all_close_real - call test_math_all_close_complex - print *, "All tests in `test_math_all_close` passed." - -contains - - subroutine test_math_all_close_real - - real :: x(4, 4) = 1.0 - - call check(all_close(x + 1.0e-11, x), msg="REAL: all_close(x+1.0e-11, x) failed.") - call check(all_close(x + 1.0e-5, x), msg="REAL: all_close(x+1.0e-5 , x) failed. (expected)", warn=.true.) - - !> Tests for NAN - call check(all_close(x + NAN, x), msg="REAL: all_close(x+NAN, x) failed. (expected)", warn=.true.) - call check(all_close(x + NAN, x + NAN, equal_nan=.true.), msg="REAL: all_close(x+NAN, x, equal_nan=.true.) failed.") - - end subroutine test_math_all_close_real - - subroutine test_math_all_close_complex - - complex :: x(4, 4) = cmplx(1.0, 1.0) - - call check(all_close(x + cmplx((1.0e-15, 1.0e-15)), x), msg="CMPLX: all_close(x+cmplx(1.0e-11, 1.0e-11), x)") - call check(all_close(x + cmplx(1.0e-5, 1.0e-5), x), & - msg="CMPLX: all_close(x+cmplx(1.0e-5 , 1.0e-5 ), x) failed. (expected)", warn=.true.) - - !> Tests for NAN - call check(all_close(x + cmplx(NAN, NAN), x), msg="REAL: all_close(x+cmplx(NAN, NAN), x) failed. (expected)", warn=.true.) - call check(all_close(x + cmplx(NAN, NAN), x + cmplx(NAN, NAN), equal_nan=.true.), & - msg="REAL: all_close(x+cmplx(NAN, NAN), x, equal_nan=.true.) failed.") - - end subroutine test_math_all_close_complex - -end program tester diff --git a/src/tests/math/test_math_is_close.f90 b/src/tests/math/test_math_is_close.f90 deleted file mode 100644 index e11043f83..000000000 --- a/src/tests/math/test_math_is_close.f90 +++ /dev/null @@ -1,67 +0,0 @@ -program test_math_is_close - - implicit none - - real :: x, NAN - x = -3 - NAN = sqrt(x) - - 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, rel_tol=1.0e-5), msg="is_close(2.5, 2.5, rel_tol=1.0e-5) failed.") - call check(all(is_close([2.5, 3.2], [2.5, 10.0], rel_tol=1.0e-5)), & - msg="all(is_close([2.5, 3.2], [2.5, 10.0], rel_tol=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]), & - abs_tol=1.0e-5, rel_tol=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]), & - &rel_tol=1.0e-5, abs_tol=0.1)) failed.") - - !> Tests for zeros - call check(is_close(0.0, -0.0), msg="is_close(0.0, -0.0) failed.") - - !> Tests for NaN - call check(is_close(NAN, NAN), msg="is_close(NAN, NAN) failed.", warn=.true.) - call check(is_close(NAN, NAN, equal_nan=.true.), msg="is_close(NAN, NAN, equal_nan=.true.) 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), rel_tol=1.0e-5), & - msg="is_close((2.5,1.2), (2.5,1.2), rel_tol=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)], rel_tol=1.0e-5)), & - msg="all(is_close([(2.5,1.2), (3.2,1.2)], [(2.5,1.2), (10.0,1.2)], rel_tol=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]), & - abs_tol=1.0e-5, rel_tol=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]), & - &rel_tol=1.0e-5, abs_tol=0.1)) failed.") - - !> Tests for zeros - call check(is_close((0.0, -0.0), (-0.0, 0.0)), msg="is_close((0.0, -0.0), (-0.0, 0.0)) failed.") - - !> Tests for NaN - call check(is_close(cmplx(NAN, NAN), cmplx(NAN, NAN)), & - msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN)) failed. (expected)", warn=.true.) - call check(is_close(cmplx(NAN, NAN), cmplx(NAN, NAN), equal_nan=.true.), & - msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN), equal_nan=.true.) failed.") - call check(is_close(cmplx(NAN, 1.0), cmplx(NAN, 1.0)), & - msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN)) failed. (expected)", warn=.true.) - call check(is_close(cmplx(NAN, 1.0), cmplx(NAN, 1.0), equal_nan=.true.), & - msg="is_close(cmplx(NAN, NAN), cmplx(NAN, NAN), equal_nan=.ture.) failed.") - - end subroutine test_math_is_close_complex - -end program test_math_is_close