Merge branch 'master' into least_squares

perazz · web-flow · commit 1773de88e5ee · 2024-04-26T09:25:57.000+02:00
diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md
@@ -157,11 +157,13 @@ Procedures to manipulate `key_type` data:
   `key_in`, to contents of the key, `key_out`.
 
 * `get( key, value )` - extracts the contents of `key` into `value`,
-  an `int8` array or character string.
+  an `int8` array, 'int32' array, or character string.
 
 * `free_key( key )` - frees the memory in `key`.
 
-* `set( key, value )` - sets the content of `key` to `value`.
+* `set( key, value )` - sets the content of `key` to `value`.  
+  Supported key types are `int8` array, `int32` array, and character
+  string.
 
 Procedures to manipulate `other_type` data:
 
@@ -474,9 +476,9 @@ is an `intent(in)` argument.
 
 `value`: if the the first argument is of `key_type` `value` shall be
 an allocatable default character string variable, or 
-an allocatable vector variable of type integer and kind `int8`,
-otherwise the first argument is of `other_type` and `value` shall be
-an allocatable of `class(*)`. It is an `intent(out)` argument.
+an allocatable vector variable of type integer and kind `int8` or 
+`int32`, otherwise the first argument is of `other_type` and `value` 
+shall be an allocatable of `class(*)`. It is an `intent(out)` argument.
 
 ##### Example
 
@@ -751,13 +753,14 @@ is an `intent(out)` argument.
 
 `value`: if the first argument is `key` `value` shall be a default
 character string scalar expression, or a vector expression of type integer
-and kind `int8`, while for a first argument of type `other` `value`
-shall be of type `class(*)`. It is an `intent(in)` argument.
+and kind `int8` or `int32`, while for a first argument of type 
+`other` `value` shall be of type `class(*)`. It is an `intent(in)` 
+argument.
 
 ##### Note
 
-Values of types other than a scalar default character or an
-`int8` vector can be used as the basis of a `key` by transferring the
+Values of types other than a scalar default character or and
+`int8` or `int32` vector can be used as the basis of a `key` by transferring the
 value to an `int8` vector.
 
 ##### Example
diff --git a/doc/specs/stdlib_linalg.md b/doc/specs/stdlib_linalg.md
@@ -643,3 +643,77 @@ Exceptions trigger an `error stop`.
 ```fortran
 {!example/linalg/example_lstsq.f90!}
 ```
+
+## `det` - Computes the determinant of a square matrix
+
+### Status
+
+Experimental
+
+### Description
+
+This function computes the determinant of a `real` or `complex` square matrix.
+
+This interface comes with a `pure` version `det(a)`, and a non-pure version `det(a,overwrite_a,err)` that
+allows for more expert control.
+
+### Syntax
+
+`c = ` [[stdlib_linalg(module):det(interface)]] `(a [, overwrite_a, err])`
+
+### Arguments
+
+`a`: Shall be a rank-2 square array
+
+`overwrite_a` (optional): Shall be an input `logical` flag. if `.true.`, input matrix `a` will be used as temporary storage and overwritten. This avoids internal data allocation.
+ This is an `intent(in)` argument.
+
+`err` (optional): Shall be a `type(linalg_state_type)` value.  This is an `intent(out)` argument.
+
+### Return value
+
+Returns a `real` scalar value of the same kind of `a` that represents the determinant of the matrix.
+
+Raises `LINALG_ERROR` if the matrix is singular.
+Raises `LINALG_VALUE_ERROR` if the matrix is non-square.
+Exceptions are returned to the `err` argument if provided; an `error stop` is triggered otherwise.
+
+### Example
+
+```fortran
+{!example/linalg/example_determinant.f90!}
+```
+
+## `.det.` - Determinant operator of a square matrix
+
+### Status
+
+Experimental
+
+### Description
+
+This operator returns the determinant of a real square matrix.
+
+This interface is equivalent to the `pure` version of determinant [[stdlib_linalg(module):det(interface)]]. 
+
+### Syntax
+
+`c = ` [[stdlib_linalg(module):operator(.det.)(interface)]] `(a)`
+
+### Arguments
+
+`a`: Shall be a rank-2 square array of any `real` or `complex` kinds. It is an `intent(in)` argument.
+
+### Return value
+
+Returns a real scalar value that represents the determinnt of the matrix.
+
+Raises `LINALG_ERROR` if the matrix is singular.
+Raises `LINALG_VALUE_ERROR` if the matrix is non-square.
+Exceptions trigger an `error stop`.
+
+### Example
+
+```fortran
+{!example/linalg/example_determinant2.f90!}
+```
diff --git a/example/linalg/CMakeLists.txt b/example/linalg/CMakeLists.txt
@@ -19,3 +19,5 @@ ADD_EXAMPLE(state2)
 ADD_EXAMPLE(blas_gemv)
 ADD_EXAMPLE(lapack_getrf)
 ADD_EXAMPLE(lstsq)
+ADD_EXAMPLE(determinant)
+ADD_EXAMPLE(determinant2)
diff --git a/example/linalg/example_determinant.f90 b/example/linalg/example_determinant.f90
@@ -0,0 +1,14 @@
+program example_determinant
+  use stdlib_kinds, only: dp
+  use stdlib_linalg, only: det, linalg_state_type
+  implicit none
+  type(linalg_state_type) :: err
+
+  real(dp) :: d
+
+  ! Compute determinate of a real matrix
+  d = det(reshape([real(dp)::1,2,3,4],[2,2]))
+
+  print *, d ! a*d-b*c = -2.0
+
+end program example_determinant
diff --git a/example/linalg/example_determinant2.f90 b/example/linalg/example_determinant2.f90
@@ -0,0 +1,13 @@
+program example_determinant2
+  use stdlib_kinds, only: dp
+  use stdlib_linalg, only: operator(.det.)
+  implicit none
+
+  real(dp) :: d
+
+  ! Compute determinate of a real matrix
+  d = .det.reshape([real(dp)::1,2,3,4],[2,2])
+
+  print *, d ! a*d-b*c = -2.0
+
+end program example_determinant2
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
@@ -25,6 +25,7 @@ set(fppFiles
     stdlib_linalg_outer_product.fypp
     stdlib_linalg_kronecker.fypp
     stdlib_linalg_cross_product.fypp
+    stdlib_linalg_determinant.fypp
     stdlib_linalg_state.fypp 
     stdlib_optval.fypp
     stdlib_selection.fypp
diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90
@@ -88,6 +88,7 @@ end function hasher_fun
 
         module procedure get_char_key,   &
                          get_int8_key,   &
+                         get_int32_key,   &
                          get_other
 
     end interface get
@@ -101,6 +102,7 @@ end function hasher_fun
 
         module procedure set_char_key,   &
                          set_int8_key,   &
+                         set_int32_key, &
                          set_other
 
     end interface set
@@ -277,6 +279,21 @@ subroutine get_int8_key( key, value )
     end subroutine get_int8_key
 
 
+    pure subroutine get_int32_key( key, value )
+!! Version: Experimental
+!!
+!! Gets the contents of the key as an INTEGER(INT32) vector
+!! Arguments:
+!!     key   - the input key
+!!     value - the contents of key mapped to an INTEGER(INT32) vector
+        type(key_type), intent(in)              :: key
+        integer(int32), allocatable, intent(out) :: value(:)
+        
+        value = transfer( key % value, value )
+        
+    end subroutine get_int32_key
+
+
     subroutine set_char_key( key, value )
 !! Version: Experimental
 !!
@@ -323,6 +340,21 @@ subroutine set_int8_key( key, value )
     end subroutine set_int8_key
 
 
+    pure subroutine set_int32_key( key, value )
+!! Version: Experimental
+!!
+!! Sets the contents of the key from an INTEGER(INT32) vector
+!! Arguments:
+!!     key   - the output key
+!!     value - the input INTEGER(INT32) vector
+        type(key_type), intent(out) :: key
+        integer(int32), intent(in)   :: value(:)
+                
+        key % value = transfer(value, key % value)
+                
+    end subroutine set_int32_key
+
+
     pure function fnv_1_hasher( key )
 !! Version: Experimental
 !!
diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp
@@ -16,6 +16,8 @@ module stdlib_linalg
   implicit none
   private
 
+  public :: det
+  public :: operator(.det.)
   public :: diag
   public :: eye
   public :: lstsq
@@ -30,6 +32,9 @@ module stdlib_linalg
   public :: is_hermitian
   public :: is_triangular
   public :: is_hessenberg
+  
+  ! Export linalg error handling
+  public :: linalg_state_type, linalg_error_handling
 
   interface diag
     !! version: experimental
@@ -263,6 +268,108 @@ module stdlib_linalg
     #:endfor
   end interface lstsq
 
+  interface det
+    !! version: experimental 
+    !!
+    !! Computes the determinant of a square matrix
+    !! ([Specification](../page/specs/stdlib_linalg.html#det-computes-the-determinant-of-a-square-matrix))
+    !! 
+    !!### Summary 
+    !! Interface for computing matrix determinant.
+    !!
+    !!### Description
+    !! 
+    !! This interface provides methods for computing the determinant of a matrix.
+    !! Supported data types include `real` and `complex`.
+    !! 
+    !!@note The provided functions are intended for square matrices only.          
+    !!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
+    !! 
+    !!### Example
+    !!
+    !!```fortran
+    !!
+    !!    real(sp) :: a(3,3), d
+    !!    type(linalg_state_type) :: state  
+    !!    a = reshape([1, 2, 3, 4, 5, 6, 7, 8, 9], [3, 3])
+    !!
+    !!    ! ...
+    !!    d = det(a,err=state)
+    !!    if (state%ok()) then 
+    !!       print *, 'Success! det=',d
+    !!    else
+    !!       print *, state%print()
+    !!    endif
+    !!    ! ...
+    !!```
+    !!     
+    #:for rk,rt in RC_KINDS_TYPES
+    #:if rk!="xdp" 
+    module procedure stdlib_linalg_${rt[0]}$${rk}$determinant
+    module procedure stdlib_linalg_pure_${rt[0]}$${rk}$determinant
+    #:endif
+    #:endfor
+  end interface det
+
+  interface operator(.det.)
+    !! version: experimental 
+    !!
+    !! Determinant operator of a square matrix
+    !! ([Specification](../page/specs/stdlib_linalg.html#det-determinant-operator-of-a-square-matrix))
+    !!
+    !!### Summary
+    !! Pure operator interface for computing matrix determinant.
+    !!
+    !!### Description
+    !! 
+    !! This pure operator interface provides a convenient way to compute the determinant of a matrix.
+    !! Supported data types include real and complex.
+    !!
+    !!@note The provided functions are intended for square matrices.
+    !!@note BLAS/LAPACK backends do not currently support extended precision (``xdp``).
+    !!
+    !!### Example
+    !!
+    !!```fortran
+    !!
+    !!    ! ...
+    !!    real(sp) :: matrix(3,3), d
+    !!    matrix = reshape([1, 2, 3, 4, 5, 6, 7, 8, 9], [3, 3])
+    !!    d = .det.matrix
+    !!    ! ...
+    !! 
+    !!```
+    !     
+    #:for rk,rt in RC_KINDS_TYPES
+    #:if rk!="xdp"
+    module procedure stdlib_linalg_pure_${rt[0]}$${rk}$determinant
+    #:endif
+    #:endfor        
+  end interface operator(.det.)
+
+  interface
+    #:for rk,rt in RC_KINDS_TYPES
+    #:if rk!="xdp" 
+    module function stdlib_linalg_${rt[0]}$${rk}$determinant(a,overwrite_a,err) result(det)
+        !> Input matrix a[m,n]
+        ${rt}$, intent(inout), target :: a(:,:)
+        !> [optional] Can A data be overwritten and destroyed?
+        logical(lk), optional, intent(in) :: overwrite_a
+        !> State return flag. 
+        type(linalg_state_type), intent(out) :: err
+        !> Matrix determinant
+        ${rt}$ :: det
+    end function stdlib_linalg_${rt[0]}$${rk}$determinant
+    pure module function stdlib_linalg_pure_${rt[0]}$${rk}$determinant(a) result(det)
+        !> Input matrix a[m,n]
+        ${rt}$, intent(in) :: a(:,:)
+        !> Matrix determinant
+        ${rt}$ :: det                
+    end function stdlib_linalg_pure_${rt[0]}$${rk}$determinant
+    #:endif
+    #:endfor
+  end interface  
+
 contains
 
 
diff --git a/src/stdlib_linalg_determinant.fypp b/src/stdlib_linalg_determinant.fypp
diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp
diff --git a/test/linalg/CMakeLists.txt b/test/linalg/CMakeLists.txt
diff --git a/test/linalg/test_linalg_determinant.fypp b/test/linalg/test_linalg_determinant.fypp
