lstsq Interface

public interface lstsq

Computes the squares solution to system . (Specification)

Summary

Interface for computing least squares, i.e. the 2-norm minimizing solution.

Description

This interface provides methods for computing the least squares of a linear matrix system. Supported data types include real and complex.

Note

The solution is based on LAPACK's singular value decomposition *GELSD methods.


Functions

private module function stdlib_linalg_c_lstsq_many(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
complex(kind=sp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

complex(kind=sp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=sp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value complex(kind=sp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_c_lstsq_one(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
complex(kind=sp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

complex(kind=sp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=sp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value complex(kind=sp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_d_lstsq_many(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

real(kind=dp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=dp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value real(kind=dp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_d_lstsq_one(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

real(kind=dp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=dp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value real(kind=dp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_s_lstsq_many(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
real(kind=sp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

real(kind=sp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=sp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value real(kind=sp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_s_lstsq_one(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
real(kind=sp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

real(kind=sp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=sp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value real(kind=sp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_z_lstsq_many(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
complex(kind=dp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

complex(kind=dp), intent(in) :: b(:,:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=dp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value complex(kind=dp), allocatable, target, (:,:)

Result array/matrix x[n] or x[n,nrhs]

private module function stdlib_linalg_z_lstsq_one(a, b, cond, overwrite_a, rank, err) result(x)

Arguments

Type IntentOptional Attributes Name
complex(kind=dp), intent(inout), target :: a(:,:)

Input matrix a[n,n]

complex(kind=dp), intent(in) :: b(:)

Right hand side vector or array, b[n] or b[n,nrhs]

real(kind=dp), intent(in), optional :: cond

[optional] cutoff for rank evaluation: singular values s(i)<=cond*maxval(s) are considered 0.

logical(kind=lk), intent(in), optional :: overwrite_a

[optional] Can A,b data be overwritten and destroyed?

integer(kind=ilp), intent(out), optional :: rank

[optional] Return rank of A

type(linalg_state_type), intent(out), optional :: err

[optional] state return flag. On error if not requested, the code will stop

Return Value complex(kind=dp), allocatable, target, (:)

Result array/matrix x[n] or x[n,nrhs]