implemented clip function

doc/specs/stdlib_math.md

@@ -0,0 +1,98 @@
+---
+title: math
+---
+
+# The `stdlib_math` module
+
+[TOC]
+
+## Introduction
+
+`stdlib_math` module provides general purpose mathematical functions.
+
+
+## Procedures and Methods provided
+
+
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `clip` function
+
+#### Description
+
+Returns a value which lies in the given interval [`xmin`, `xmax`] (interval is `xmin` and `xmax` inclusive) and is closest to the input value `x`.  
+
+#### Syntax
+
+`res = [[stdlib_math(module):clip(interface)]] (x, xmin, xmax)`
+
+#### Status
+
+Experimental
+
+#### Class
+
+Elemental function.
+
+#### Argument(s)
+
+`x`: scalar of either `integer` or `real` type. This argument is `intent(in)`.  
+`xmin`: scalar of either `integer` or `real` type. This argument is `intent(in)`.  
+`xmax`: scalar of either `integer` or `real` type, which must be greater than or equal to `xmin`. This argument is `intent(in)`.
+
+Note: All arguments must have same `type` and same `kind`.
+
+#### Output value or Result value
+
+The output is a scalar of `type` and `kind` same as to that of the arguments.
+
+#### Examples
+
+##### Example 1:
+
+Here inputs are of type `integer` and kind `int32`
+```fortran
+program demo_clip_integer
+  use stdlib_math
+  use stdlib_kinds
+  implicit none
+  integer(int32) :: x
+  integer(int32) :: xmin
+  integer(int32) :: xmax
+  integer(int32) :: clipped_value
+
+  xmin = -5_int32
+  ! xmin <- -5
+  xmax = 5_int32
+  ! xmax <- 5
+  x = 12_int32
+  ! x <- 12
+
+  clipped_value = clip(x, xmin, xmax)
+  ! clipped_value <- 5
+end program demo_clip_integer
+```
+
+##### Example 2:
+
+Here inputs are of type `real` and kind `sp`
+```fortran
+program demo_clip_real
+  use stdlib_math
+  use stdlib_kinds
+  implicit none
+  real(sp) :: x
+  real(sp) :: xmin
+  real(sp) :: xmax
+  real(sp) :: clipped_value
+
+  xmin = -5.769_sp
+  ! xmin <-  -5.76900005
+  xmax = 3.025_sp
+  ! xmax <- 3.02500010
+  x = 3.025_sp
+  ! x <- 3.02500010
+
+  clipped_value = clip(x, xmin, xmax)
+  ! clipped_value <- 3.02500010
+end program demo_clip_real
+```

src/CMakeLists.txt

@@ -22,6 +22,7 @@ set(fppFiles
     stdlib_quadrature_trapz.fypp
     stdlib_quadrature_simps.fypp
     stdlib_stats_distribution_PRNG.fypp
+    stdlib_math.fypp
 )
 
 

src/Makefile.manual

@@ -18,6 +18,7 @@ SRCFYPP =\
         stdlib_stats_moment_mask.fypp \
         stdlib_stats_moment_scalar.fypp \
         stdlib_stats_var.fypp \
+		stdlib_math.fypp \
 	stdlib_stats_distribution_PRNG.fypp
 
 SRC = f18estop.f90 \

src/stdlib_math.fypp

@@ -0,0 +1,30 @@
+#:include "common.fypp"
+#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES
+
+module stdlib_math
+    use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp
+
+    implicit none
+    private
+    public :: clip
+
+    interface clip
+    #:for k1, t1 in IR_KINDS_TYPES
+        module procedure clip_${k1}$
+    #:endfor
+    end interface clip
+
+contains
+
+    #:for k1, t1 in IR_KINDS_TYPES
+    elemental function clip_${k1}$(x, xmin, xmax) result(res)
+        ${t1}$, intent(in) :: x
+        ${t1}$, intent(in) :: xmin
+        ${t1}$, intent(in) :: xmax
+        ${t1}$ :: res
+
+        res = max(min(x, xmax), xmin)
+    end function clip_${k1}$
+
+    #:endfor
+end module stdlib_math

src/tests/CMakeLists.txt

@@ -16,6 +16,7 @@ add_subdirectory(stats)
 add_subdirectory(string)
 add_subdirectory(system)
 add_subdirectory(quadrature)
+add_subdirectory(math)
 
 ADDTEST(always_skip)
 set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77)

src/tests/Makefile.manual

@@ -9,6 +9,7 @@ all:
 	$(MAKE) -f Makefile.manual --directory=quadrature
 	$(MAKE) -f Makefile.manual --directory=stats
 	$(MAKE) -f Makefile.manual --directory=string
+	$(MAKE) -f Makefile.manual --directory=math
 
 test:
 	$(MAKE) -f Makefile.manual --directory=ascii test
@@ -19,6 +20,7 @@ test:
 	$(MAKE) -f Makefile.manual --directory=quadrature test
 	$(MAKE) -f Makefile.manual --directory=stats test
 	$(MAKE) -f Makefile.manual --directory=string test
+	$(MAKE) -f Makefile.manual --directory=math test
 
 clean:
 	$(MAKE) -f Makefile.manual --directory=ascii clean
@@ -28,3 +30,4 @@ clean:
 	$(MAKE) -f Makefile.manual --directory=optval clean
 	$(MAKE) -f Makefile.manual --directory=stats clean
 	$(MAKE) -f Makefile.manual --directory=string clean
+	$(MAKE) -f Makefile.manual --directory=math clean

src/tests/math/CMakeLists.txt

@@ -0,0 +1 @@
+ADDTEST(math)

src/tests/math/Makefile.manual

@@ -0,0 +1,4 @@
+PROGS_SRC = test_math.f90
+
+
+include ../Makefile.manual.test.mk

src/tests/math/test_math.f90

@@ -0,0 +1,129 @@
+! SPDX-Identifier: MIT
+
+module test_math
+    use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp
+    use stdlib_error, only : check
+    use stdlib_math
+
+    implicit none
+
+contains
+
+    subroutine test_clip_int8(x, xmin, xmax, compare)
+        integer(int8), intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_int8
+
+    subroutine test_clip_int16(x, xmin, xmax, compare)
+        integer(int16), intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_int16
+
+    subroutine test_clip_int32(x, xmin, xmax, compare)
+        integer(int32), intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_int32
+
+    subroutine test_clip_int64(x, xmin, xmax, compare)
+        integer(int64), intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_int64
+
+    subroutine test_clip_sp(x, xmin, xmax, compare)
+        real(sp), intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_sp
+
+    subroutine test_clip_dp(x, xmin, xmax, compare)
+        real(dp), intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_dp
+
+    subroutine test_clip_qp(x, xmin, xmax, compare)
+        real(qp), intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_qp
+
+end module test_math
+
+
+program tester
+    use test_math
+    implicit none
+
+    ! test case format: (x, xmin, xmax, correct answer)
+    ! valid case: xmin is not greater than xmax
+    ! invalid case: xmin is greater than xmax
+
+
+    ! type: integer(int8), kind: int8
+        ! valid test cases
+        call test_clip_int8(2_int8, -2_int8, 5_int8, 2_int8)
+        call test_clip_int8(127_int8, -127_int8, 0_int8, 0_int8)
+        ! invalid test cases
+        call test_clip_int8(2_int8, 5_int8, -2_int8, 5_int8)
+        call test_clip_int8(127_int8, 0_int8, -127_int8, 0_int8)
+
+    ! type: integer(int16), kind: int16
+        ! valid test cases
+        call test_clip_int16(2_int16, -2_int16, 5_int16, 2_int16)
+        call test_clip_int16(32767_int16, -32767_int16, 0_int16, 0_int16)
+        ! invalid test cases
+        call test_clip_int16(2_int16, 5_int16, -2_int16, 5_int16)
+        call test_clip_int16(32767_int16, 0_int16, -32767_int16, 0_int16)
+
+    ! type: integer(int32), kind: int32
+        ! valid test cases
+        call test_clip_int32(2_int32, -2_int32, 5_int32, 2_int32)
+        call test_clip_int32(-2147483647_int32, 0_int32, 2147483647_int32, 0_int32)
+        ! invalid test cases
+        call test_clip_int32(2_int32, 5_int32, -2_int32, 5_int32)
+        call test_clip_int32(-2147483647_int32, 2147483647_int32, 0_int32, 2147483647_int32)
+
+    ! type: integer(int64), kind: int64
+        ! valid test cases
+        call test_clip_int64(2_int64, -2_int64, 5_int64, 2_int64)
+        call test_clip_int64(-922337203_int64, -10_int64, 25_int64, -10_int64)
+        ! invalid test cases
+        call test_clip_int64(2_int64, 5_int64, -2_int64, 5_int64)
+        call test_clip_int64(-922337203_int64, 25_int64, -10_int64, 25_int64)
+
+    ! type: real(sp), kind: sp
+        ! valid test cases
+        call test_clip_sp(3.025_sp, -5.77_sp, 3.025_sp, 3.025_sp)
+        call test_clip_sp(0.0_sp, -1578.025_sp, -59.68_sp, -59.68_sp)
+        ! invalid test cases
+        call test_clip_sp(3.025_sp, 3.025_sp, -5.77_sp, 3.025_sp)
+        call test_clip_sp(0.0_sp, -59.68_sp, -1578.025_sp, -59.68_sp)
+
+    ! type: real(dp), kind: dp
+        ! valid test cases
+        call test_clip_dp(3.025_dp, -5.77_dp, 3.025_dp, 3.025_dp)
+        call test_clip_dp(-7.0_dp, 0.059668_dp, 1.00268_dp, 0.059668_dp)
+        ! invalid test cases
+        call test_clip_dp(3.025_dp, 3.025_dp, -5.77_dp, 3.025_dp)
+        call test_clip_dp(-7.0_dp, 1.00268_dp, 0.059668_dp, 1.00268_dp)
+
+    ! type: real(qp), kind: qp
+        ! valid test cases
+        call test_clip_qp(3.025_qp, -5.77_qp, 3.025_qp, 3.025_qp)
+        call test_clip_qp(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp, -689712245.23_qp)
+        ! invalid test cases
+        call test_clip_qp(3.025_qp, 3.025_qp, -5.77_qp, 3.025_qp)
+        call test_clip_qp(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp, -689712245.23_qp)
+
+end program tester

src/tests/math/test_math.fypp

@@ -0,0 +1,63 @@
+! SPDX-Identifier: MIT
+#:include "common.fypp"
+#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES
+
+module test_math
+    use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp
+    use stdlib_error, only : check
+    use stdlib_math
+
+    implicit none
+
+contains
+
+    #:for k1, t1 in IR_KINDS_TYPES
+    subroutine test_clip_${k1}$(x, xmin, xmax, compare)
+        ${t1}$, intent(in) :: x, xmin, xmax, compare
+
+        call check(clip(x, xmin, xmax) == compare)
+
+    end subroutine test_clip_${k1}$
+
+    #:endfor
+end module test_math
+
+
+program tester
+    use test_math
+    implicit none
+
+    ! test case format: (x, xmin, xmax, correct answer)
+    ! valid case: xmin is not greater than xmax
+    ! invalid case: xmin is greater than xmax
+    #:set valid_cases = [ [('2_int8', '-2_int8', '5_int8', '2_int8'), ('127_int8', '-127_int8', '0_int8', '0_int8')], &
+                        [('2_int16', '-2_int16', '5_int16', '2_int16'), ('32767_int16', '-32767_int16', '0_int16', '0_int16')], &
+                        [('2_int32', '-2_int32', '5_int32', '2_int32'), ('-2147483647_int32', '0_int32', '2147483647_int32', '0_int32')], &
+                        [('2_int64', '-2_int64', '5_int64', '2_int64'), ('-922337203_int64', '-10_int64', '25_int64', '-10_int64')], &
+                        [('3.025_sp', '-5.77_sp', '3.025_sp', '3.025_sp'), ('0.0_sp', '-1578.025_sp', '-59.68_sp', '-59.68_sp')], &
+                        [('3.025_dp', '-5.77_dp', '3.025_dp', '3.025_dp'), ('-7.0_dp', '0.059668_dp', '1.00268_dp', '0.059668_dp')], &
+                        [('3.025_qp', '-5.77_qp', '3.025_qp', '3.025_qp'), ('-55891546.2_qp', '-8958133457.23_qp', '-689712245.23_qp', '-689712245.23_qp')] ]
+
+    #:set invalid_cases = [ [('2_int8', '5_int8', '-2_int8', '5_int8'), ('127_int8', '0_int8', '-127_int8', '0_int8')], &
+                        [('2_int16', '5_int16', '-2_int16', '5_int16'), ('32767_int16', '0_int16', '-32767_int16', '0_int16')], &
+                        [('2_int32', '5_int32', '-2_int32', '5_int32'), ('-2147483647_int32', '2147483647_int32', '0_int32', '2147483647_int32')], &
+                        [('2_int64', '5_int64', '-2_int64', '5_int64'), ('-922337203_int64', '25_int64', '-10_int64', '25_int64')], &
+                        [('3.025_sp', '3.025_sp', '-5.77_sp', '3.025_sp'), ('0.0_sp', '-59.68_sp', '-1578.025_sp', '-59.68_sp')], &
+                        [('3.025_dp', '3.025_dp', '-5.77_dp', '3.025_dp'), ('-7.0_dp', '1.00268_dp', '0.059668_dp', '1.00268_dp')], &
+                        [('3.025_qp', '3.025_qp', '-5.77_qp', '3.025_qp'), ('-55891546.2_qp', '-689712245.23_qp', '-8958133457.23_qp', '-689712245.23_qp')] ]
+
+    #:set checking_function = 0
+    #:for k1, t1 in IR_KINDS_TYPES
+    ! type: ${t1}$, kind: ${k1}$
+        ! valid test cases
+    #:for case in valid_cases[checking_function]
+        call test_clip_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$)
+    #:endfor
+        ! invalid test cases
+    #:for case in invalid_cases[checking_function]
+        call test_clip_${k1}$(${case[0]}$, ${case[1]}$, ${case[2]}$, ${case[3]}$)
+    #:endfor
+
+    #:set checking_function = checking_function + 1
+    #:endfor
+end program tester