linalg: QR factorization (#832)

doc/specs/stdlib_linalg.md

@@ -902,6 +902,83 @@ Exceptions trigger an `error stop`.
 {!example/linalg/example_determinant2.f90!}
 ```
 
+## `qr` - Compute the QR factorization of a matrix
+
+### Status
+
+Experimental
+
+### Description
+
+This subroutine computes the QR factorization of a `real` or `complex` matrix: \( A = Q R \) where \( Q \) 
+is orthonormal and \( R \) is upper-triangular. Matrix \( A \) has size `[m,n]`, with \( m \ge n \). 
+
+The results are returned in output matrices \( Q \) and \(R \), that have the same type and kind as \( A \). 
+Given `k = min(m,n)`, one can write \( A = \( Q_1  Q_2 \) \cdot \( \frac{R_1}{0}\) \). 
+Because the lower rows of \( R \) are zeros, a reduced problem \( A = Q_1 R_1 \) may be solved. The size of 
+the input arguments determines what problem is solved: on full matrices (`shape(Q)==[m,m]`, `shape(R)==[m,n]`), 
+the full problem is solved. On reduced matrices (`shape(Q)==[m,k]`, `shape(R)==[k,n]`), the reduced problem is solved.
+
+### Syntax
+
+`call ` [[stdlib_linalg(module):qr(interface)]] `(a, q, r, [, storage] [, overwrite_a] [, err])`
+
+### Arguments
+
+`a`: Shall be a rank-2 `real` or `complex` array containing the coefficient matrix of size `[m,n]`. It is an `intent(in)` argument, if `overwrite_a=.false.`. Otherwise, it is an `intent(inout)` argument, and is destroyed upon return.
+
+`q`: Shall be a rank-2 array of the same kind as `a`, containing the orthonormal matrix `q`. It is an `intent(out)` argument. It should have a shape equal to either `[m,m]` or `[m,k]`, whether the full or the reduced problem is sought for.
+
+`r`: Shall be a rank-2 array of the same kind as `a`, containing the upper triangular matrix `r`. It is an `intent(out)` argument. It should have a shape equal to either `[m,n]` or `[k,n]`, whether the full or the reduced problem is sought for.
+
+`storage` (optional): Shall be a rank-1 array of the same type and kind as `a`, providing working storage for the solver. Its minimum size can be determined with a call to [[stdlib_linalg(module):qr_space(interface)]]. It is an `intent(out)` argument.
+
+`overwrite_a` (optional): Shall be an input `logical` flag (default: `.false.`). If `.true.`, input matrix `a` will be used as temporary storage and overwritten. This avoids internal data allocation. It is an `intent(in)` argument.
+
+`err` (optional): Shall be a `type(linalg_state_type)` value. It is an `intent(out)` argument.
+
+### Return value
+
+Returns the QR factorization matrices into the \( Q \) and \( R \) arguments. 
+
+Raises `LINALG_VALUE_ERROR` if any of the matrices has invalid or unsuitable size for the full/reduced problem.
+Raises `LINALG_ERROR` on insufficient user storage space.
+If the state argument `err` is not present, exceptions trigger an `error stop`.
+
+### Example
+
+```fortran
+{!example/linalg/example_qr.f90!}
+```
+
+## `qr_space` - Compute internal working space requirements for the QR factorization.
+
+### Status
+
+Experimental
+
+### Description
+
+This subroutine computes the internal working space requirements for the QR factorization, [[stdlib_linalg(module):qr(interface)]] .
+
+### Syntax
+
+`call ` [[stdlib_linalg(module):qr_space(interface)]] `(a, lwork, [, err])`
+
+### Arguments
+
+`a`: Shall be a rank-2 `real` or `complex` array containing the coefficient matrix. It is an `intent(in)` argument.
+
+`lwork`: Shall be an `integer` scalar, that returns the minimum array size required for the working storage in [[stdlib_linalg(module):qr(interface)]] to factorize `a`.
+
+`err` (optional): Shall be a `type(linalg_state_type)` value. This is an `intent(out)` argument.
+
+### Example
+
+```fortran
+{!example/linalg/example_qr_space.f90!}
+```
+
 ## `eig` - Eigenvalues and Eigenvectors of a Square Matrix
 
 ### Status
@@ -1028,7 +1105,6 @@ Raises `LINALG_ERROR` if the calculation did not converge.
 Raises `LINALG_VALUE_ERROR` if any matrix or arrays have invalid/incompatible sizes.
 If `err` is not present, exceptions trigger an `error stop`.
 
-
 ### Example
 
 ```fortran
@@ -1096,6 +1172,7 @@ If requested, `vt` contains the right singular vectors, as rows of \( V^T \).
 `call ` [[stdlib_linalg(module):svd(interface)]] `(a, s, [, u, vt, overwrite_a, full_matrices, err])`
 
 ### Class
+
 Subroutine
 
 ### Arguments

example/linalg/CMakeLists.txt

@@ -35,5 +35,7 @@ ADD_EXAMPLE(svd)
 ADD_EXAMPLE(svdvals)
 ADD_EXAMPLE(determinant)
 ADD_EXAMPLE(determinant2)
+ADD_EXAMPLE(qr)
+ADD_EXAMPLE(qr_space)
 ADD_EXAMPLE(cholesky)
 ADD_EXAMPLE(chol)

example/linalg/example_qr.f90

@@ -0,0 +1,15 @@
+program example_qr  
+  use stdlib_linalg, only: qr
+  implicit none(type,external)
+  real :: A(104, 32), Q(104,32), R(32,32)
+
+  ! Create a random matrix
+  call random_number(A)
+
+  ! Compute its QR factorization (reduced)
+  call qr(A,Q,R)
+
+  ! Test factorization: Q*R = A 
+  print *, maxval(abs(matmul(Q,R)-A)) 
+
+end program example_qr

example/linalg/example_qr_space.f90

@@ -0,0 +1,25 @@
+! QR example with pre-allocated storage
+program example_qr_space
+  use stdlib_linalg_constants, only: ilp
+  use stdlib_linalg, only: qr, qr_space, linalg_state_type
+  implicit none(type,external)
+  real :: A(104, 32), Q(104,32), R(32,32)
+  real, allocatable :: work(:)
+  integer(ilp) :: lwork
+  type(linalg_state_type) :: err
+
+  ! Create a random matrix
+  call random_number(A)
+
+  ! Prepare QR workspace
+  call qr_space(A,lwork)
+  allocate(work(lwork))
+
+  ! Compute its QR factorization (reduced)
+  call qr(A,Q,R,storage=work,err=err)
+
+  ! Test factorization: Q*R = A 
+  print *, maxval(abs(matmul(Q,R)-A))
+  print *, err%print() 
+
+end program example_qr_space

src/CMakeLists.txt

@@ -30,6 +30,7 @@ set(fppFiles
     stdlib_linalg_eigenvalues.fypp
     stdlib_linalg_solve.fypp    
     stdlib_linalg_determinant.fypp
+    stdlib_linalg_qr.fypp
     stdlib_linalg_inverse.fypp
     stdlib_linalg_state.fypp
     stdlib_linalg_svd.fypp 

src/stdlib_linalg.fypp

@@ -40,6 +40,8 @@ module stdlib_linalg
   public :: outer_product
   public :: kronecker_product
   public :: cross_product
+  public :: qr
+  public :: qr_space
   public :: is_square
   public :: is_diagonal
   public :: is_symmetric
@@ -526,6 +528,75 @@ module stdlib_linalg
     #:endfor
   end interface lstsq_space
 
+  ! QR factorization of rank-2 array A
+  interface qr
+    !! version: experimental 
+    !!
+    !! Computes the QR factorization of matrix \( A = Q R \). 
+    !! ([Specification](../page/specs/stdlib_linalg.html#qr-compute-the-qr-factorization-of-a-matrix))
+    !! 
+    !!### Summary 
+    !! Compute the QR factorization of a `real` or `complex` matrix: \( A = Q R \), where \( Q \)  is orthonormal 
+    !! and \( R \) is upper-triangular. Matrix \( A \) has size `[m,n]`, with \( m\ge n \). 
+    !!
+    !!### Description
+    !! 
+    !! This interface provides methods for computing the QR factorization of a matrix. 
+    !! Supported data types include `real` and `complex`. If a pre-allocated work space 
+    !! is provided, no internal memory allocations take place when using this interface.
+    !!
+    !! Given `k = min(m,n)`, one can write \( A = \( Q_1  Q_2 \) \cdot \( \frac{R_1}{0}\) \). 
+    !! The user may want the full problem (provide `shape(Q)==[m,m]`, `shape(R)==[m,n]`) or the reduced  
+    !! problem only: \( A = Q_1 R_1 \) (provide `shape(Q)==[m,k]`, `shape(R)==[k,n]`).
+    !! 
+    !!@note The solution is based on LAPACK's QR factorization (`*GEQRF`) and ordered matrix output (`*ORGQR`, `*UNGQR`). 
+    !!     
+    #:for rk,rt,ri in RC_KINDS_TYPES
+      pure module subroutine stdlib_linalg_${ri}$_qr(a,q,r,overwrite_a,storage,err) 
+         !> Input matrix a[m,n]
+         ${rt}$, intent(inout), target :: a(:,:)
+         !> Orthogonal matrix Q ([m,m], or [m,k] if reduced)
+         ${rt}$, intent(out), contiguous, target :: q(:,:)
+         !> Upper triangular matrix R ([m,n], or [k,n] if reduced)
+         ${rt}$, intent(out), contiguous, target :: r(:,:)
+         !> [optional] Can A data be overwritten and destroyed?
+         logical(lk), optional, intent(in) :: overwrite_a
+         !> [optional] Provide pre-allocated workspace, size to be checked with qr_space
+         ${rt}$, intent(out), optional, target :: storage(:)
+         !> [optional] state return flag. On error if not requested, the code will stop
+         type(linalg_state_type), optional, intent(out) :: err
+      end subroutine stdlib_linalg_${ri}$_qr
+    #:endfor    
+  end interface qr
+
+  ! Return the working array space required by the QR factorization solver
+  interface qr_space
+    !! version: experimental 
+    !!
+    !! Computes the working array space required by the QR factorization solver
+    !! ([Specification](../page/specs/stdlib_linalg.html#qr-space-compute-internal-working-space-requirements-for-the-qr-factorization))
+    !! 
+    !!### Description
+    !! 
+    !! This interface returns the size of the `real` or `complex` working storage required by the 
+    !! QR factorization solver. The working size only depends on the kind (`real` or `complex`) and size of
+    !! the matrix being factorized. Storage size can be used to pre-allocate a working array in case several 
+    !! repeated QR factorizations to a same-size matrix are sought. If pre-allocated working arrays 
+    !! are provided, no internal allocations will take place during the factorization.
+    !!     
+    #:for rk,rt,ri in RC_KINDS_TYPES
+      pure module subroutine get_qr_${ri}$_workspace(a,lwork,err)
+         !> Input matrix a[m,n]
+         ${rt}$, intent(in), target :: a(:,:)
+         !> Minimum workspace size for both operations
+         integer(ilp), intent(out) :: lwork
+         !> State return flag. Returns an error if the query failed
+         type(linalg_state_type), optional, intent(out) :: err
+      end subroutine get_qr_${ri}$_workspace
+    #:endfor
+  end interface qr_space
+ 
+
   interface det
     !! version: experimental 
     !!