```// Copyright (C) 2009  Davis E. King (davis@dlib.net)
// License: Boost Software License   See LICENSE.txt for the full license.
// This code was adapted from code from the JAMA part of NIST's TNT library.
//    See: http://math.nist.gov/tnt/
#ifndef DLIB_MATRIX_QR_DECOMPOSITION_H
#define DLIB_MATRIX_QR_DECOMPOSITION_H

#include "matrix.h"
#include "matrix_utilities.h"
#include "matrix_subexp.h"

#ifdef DLIB_USE_LAPACK
#include "lapack/geqrf.h"
#include "lapack/ormqr.h"
#endif

#include "matrix_trsm.h"

namespace dlib
{

template <
typename matrix_exp_type
>
class qr_decomposition
{

public:

const static long NR = matrix_exp_type::NR;
const static long NC = matrix_exp_type::NC;
typedef typename matrix_exp_type::type type;
typedef typename matrix_exp_type::mem_manager_type mem_manager_type;
typedef typename matrix_exp_type::layout_type layout_type;

typedef matrix<type,0,0,mem_manager_type,layout_type>  matrix_type;

// You have supplied an invalid type of matrix_exp_type.  You have
// to use this object with matrices that contain float or double type data.
COMPILE_TIME_ASSERT((is_same_type<float, type>::value ||
is_same_type<double, type>::value ));

template <typename EXP>
qr_decomposition(
const matrix_exp<EXP>& A
);

bool is_full_rank(
) const;

long nr(
) const;

long nc(
) const;

const matrix_type get_r (
) const;

const matrix_type get_q (
) const;

template <typename T, long R, long C, typename MM, typename L>
void get_q (
matrix<T,R,C,MM,L>& Q
) const;

template <typename EXP>
const matrix_type solve (
const matrix_exp<EXP>& B
) const;

private:

#ifndef DLIB_USE_LAPACK
template <typename EXP>
const matrix_type solve_mat (
const matrix_exp<EXP>& B
) const;

template <typename EXP>
const matrix_type solve_vect (
const matrix_exp<EXP>& B
) const;
#endif

/** Array for internal storage of decomposition.
@serial internal array storage.
*/
matrix<type,0,0,mem_manager_type,column_major_layout> QR_;

/** Row and column dimensions.
@serial column dimension.
@serial row dimension.
*/
long m, n;

/** Array for internal storage of diagonal of R.
@serial diagonal of R.
*/
typedef matrix<type,0,1,mem_manager_type,column_major_layout> column_vector_type;
column_vector_type tau;
column_vector_type Rdiag;

};

// ----------------------------------------------------------------------------------------
// ----------------------------------------------------------------------------------------
//                                      Member functions
// ----------------------------------------------------------------------------------------
// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
template <typename EXP>
qr_decomposition<matrix_exp_type>::
qr_decomposition(
const matrix_exp<EXP>& A
)
{
COMPILE_TIME_ASSERT((is_same_type<type, typename EXP::type>::value));

// make sure requires clause is not broken
DLIB_ASSERT(A.nr() >= A.nc() && A.size() > 0,
"\tqr_decomposition::qr_decomposition(A)"
<< "\n\tInvalid inputs were given to this function"
<< "\n\tA.nr():   " << A.nr()
<< "\n\tA.nc():   " << A.nc()
<< "\n\tA.size(): " << A.size()
<< "\n\tthis:     " << this
);

QR_ = A;
m = A.nr();
n = A.nc();

#ifdef DLIB_USE_LAPACK

lapack::geqrf(QR_, tau);
Rdiag = diag(QR_);

#else
Rdiag.set_size(n);
long i=0, j=0, k=0;

// Main loop.
for (k = 0; k < n; k++)
{
// Compute 2-norm of k-th column without under/overflow.
type nrm = 0;
for (i = k; i < m; i++)
{
nrm = hypot(nrm,QR_(i,k));
}

if (nrm != 0.0)
{
// Form k-th Householder vector.
if (QR_(k,k) < 0)
{
nrm = -nrm;
}
for (i = k; i < m; i++)
{
QR_(i,k) /= nrm;
}
QR_(k,k) += 1.0;

// Apply transformation to remaining columns.
for (j = k+1; j < n; j++)
{
type s = 0.0;
for (i = k; i < m; i++)
{
s += QR_(i,k)*QR_(i,j);
}
s = -s/QR_(k,k);
for (i = k; i < m; i++)
{
QR_(i,j) += s*QR_(i,k);
}
}
}
Rdiag(k) = -nrm;
}
#endif
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
long qr_decomposition<matrix_exp_type>::
nr (
) const
{
return m;
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
long qr_decomposition<matrix_exp_type>::
nc (
) const
{
return n;
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
bool qr_decomposition<matrix_exp_type>::
is_full_rank(
) const
{
type eps = max(abs(Rdiag));
if (eps != 0)
eps *= std::sqrt(std::numeric_limits<type>::epsilon())/100;
else
eps = 1;  // there is no max so just use 1

// check if any of the elements of Rdiag are effectively 0
return min(abs(Rdiag)) > eps;
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
const typename qr_decomposition<matrix_exp_type>::matrix_type qr_decomposition<matrix_exp_type>::
get_r(
) const
{
matrix_type R(n,n);
for (long i = 0; i < n; i++)
{
for (long j = 0; j < n; j++)
{
if (i < j)
{
R(i,j) = QR_(i,j);
}
else if (i == j)
{
R(i,j) = Rdiag(i);
}
else
{
R(i,j) = 0.0;
}
}
}
return R;
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
const typename qr_decomposition<matrix_exp_type>::matrix_type qr_decomposition<matrix_exp_type>::
get_q(
) const
{
matrix_type Q;
get_q(Q);
return Q;
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
template <typename T, long R, long C, typename MM, typename L>
void qr_decomposition<matrix_exp_type>::
get_q(
matrix<T,R,C,MM,L>& X
) const
{
#ifdef DLIB_USE_LAPACK
// Take only the first n columns of an identity matrix.  This way
// X ends up being an m by n matrix.
X = colm(identity_matrix<type>(m), range(0,n-1));

// Compute Y = Q*X
lapack::ormqr('L','N', QR_, tau, X);

#else
long i=0, j=0, k=0;

X.set_size(m,n);
for (k = n-1; k >= 0; k--)
{
for (i = 0; i < m; i++)
{
X(i,k) = 0.0;
}
X(k,k) = 1.0;
for (j = k; j < n; j++)
{
if (QR_(k,k) != 0)
{
type s = 0.0;
for (i = k; i < m; i++)
{
s += QR_(i,k)*X(i,j);
}
s = -s/QR_(k,k);
for (i = k; i < m; i++)
{
X(i,j) += s*QR_(i,k);
}
}
}
}
#endif
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
template <typename EXP>
const typename qr_decomposition<matrix_exp_type>::matrix_type qr_decomposition<matrix_exp_type>::
solve(
const matrix_exp<EXP>& B
) const
{
COMPILE_TIME_ASSERT((is_same_type<type, typename EXP::type>::value));

// make sure requires clause is not broken
DLIB_ASSERT(B.nr() == nr(),
"\tconst matrix_type qr_decomposition::solve(B)"
<< "\n\tInvalid inputs were given to this function"
<< "\n\tB.nr():         " << B.nr()
<< "\n\tnr():           " << nr()
<< "\n\tthis:           " << this
);

#ifdef DLIB_USE_LAPACK

using namespace blas_bindings;
matrix<type,0,0,mem_manager_type,column_major_layout> X(B);
// Compute Y = transpose(Q)*B
lapack::ormqr('L','T',QR_, tau, X);
// Solve R*X = Y;
triangular_solver(CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, QR_, X, n);

/* return n x nx portion of X */
return subm(X,0,0,n,B.nc());

#else
// just call the right version of the solve function
if (B.nc() == 1)
return solve_vect(B);
else
return solve_mat(B);
#endif
}

// ----------------------------------------------------------------------------------------
// ----------------------------------------------------------------------------------------
//                           Private member functions
// ----------------------------------------------------------------------------------------
// ----------------------------------------------------------------------------------------

#ifndef DLIB_USE_LAPACK

template <typename matrix_exp_type>
template <typename EXP>
const typename qr_decomposition<matrix_exp_type>::matrix_type qr_decomposition<matrix_exp_type>::
solve_vect(
const matrix_exp<EXP>& B
) const
{

column_vector_type x(B);

// Compute Y = transpose(Q)*B
for (long k = 0; k < n; k++)
{
type s = 0.0;
for (long i = k; i < m; i++)
{
s += QR_(i,k)*x(i);
}
s = -s/QR_(k,k);
for (long i = k; i < m; i++)
{
x(i) += s*QR_(i,k);
}
}
// Solve R*X = Y;
for (long k = n-1; k >= 0; k--)
{
x(k) /= Rdiag(k);
for (long i = 0; i < k; i++)
{
x(i) -= x(k)*QR_(i,k);
}
}

/* return n x 1 portion of x */
return colm(x,0,n);
}

// ----------------------------------------------------------------------------------------

template <typename matrix_exp_type>
template <typename EXP>
const typename qr_decomposition<matrix_exp_type>::matrix_type qr_decomposition<matrix_exp_type>::
solve_mat(
const matrix_exp<EXP>& B
) const
{
const long nx = B.nc();
matrix_type X(B);
long i=0, j=0, k=0;

// Compute Y = transpose(Q)*B
for (k = 0; k < n; k++)
{
for (j = 0; j < nx; j++)
{
type s = 0.0;
for (i = k; i < m; i++)
{
s += QR_(i,k)*X(i,j);
}
s = -s/QR_(k,k);
for (i = k; i < m; i++)
{
X(i,j) += s*QR_(i,k);
}
}
}
// Solve R*X = Y;
for (k = n-1; k >= 0; k--)
{
for (j = 0; j < nx; j++)
{
X(k,j) /= Rdiag(k);
}
for (i = 0; i < k; i++)
{
for (j = 0; j < nx; j++)
{
X(i,j) -= X(k,j)*QR_(i,k);
}
}
}

/* return n x nx portion of X */
return subm(X,0,0,n,nx);
}

// ----------------------------------------------------------------------------------------

#endif // DLIB_USE_LAPACK not defined

}

#endif // DLIB_MATRIX_QR_DECOMPOSITION_H

```