Macaulay2 Engine
Loading...
Searching...
No Matches

◆ QR() [2/2]

bool Lapack::QR ( const DMatRR * A,
DMatRR * Q,
DMatRR * R,
bool return_QR )
static

Definition at line 898 of file lapack.cpp.

899{
900 // sizes:
901 // input: A[m,n]
902 // output for returnQR==true:
903 // case m >= n: Q[m,n], R[n,n]
904 // case m < n: Q[m,m], R[m,n]
905 // output for returnQR==false:
906 // Q[m,n], R[1,min(m,n)]
907 bool ret = true;
908 int rows = static_cast<int>(A->numRows());
909 int cols = static_cast<int>(A->numColumns());
910 int info1 = 0, info2 = 0, info3 = 0, info4 = 0;
911 int min = (rows <= cols) ? rows : cols;
912
913 if (min == 0)
914 {
915 ERROR("expected a matrix with positive dimensions");
916 return false;
917 }
918
919 std::vector<double> copyA = make_lapack_array(*A);
920 std::vector<double> tau (min); // TODO: set to 0??
921 double workspace_size[1];
922 int work_size = -1;
923 // find optimal workspace
924 dgeqrf_(&rows, &cols, copyA.data(), &rows, tau.data(), workspace_size, &work_size, &info1);
925 work_size = static_cast<int>(workspace_size[0]);
926 // std::cout << "work size for QR: " << work_size << std::endl;
927 double *workspace = new double[work_size];
928
929 dgeqrf_(&rows, &cols, copyA.data(), &rows, tau.data(), workspace, &work_size, &info2);
930
931 if (info1 < 0 or info2 < 0)
932 {
933 ERROR("argument passed to dgeqrf had an illegal value");
934 ret = false;
935 }
936 if (info1 > 0 or info2 > 0)
937 {
938 ERROR("can this happen?");
939 ret = false;
940 }
941
942 if (ret)
943 {
944 if (return_QR)
945 {
946 Q->resize(rows, cols);
947 R->resize(cols, cols);
948 fill_from_lapack_upper(copyA, rows, cols, *R);
949
950 // Reset Q, R, with their values.
951 int orgqr_work_size = -1;
952 dorgqr_(&rows,
953 &cols,
954 &min,
955 copyA.data(),
956 &rows, // lda?
957 tau.data(),
958 workspace_size,
959 &orgqr_work_size,
960 &info3);
961 orgqr_work_size = static_cast<int>(workspace_size[0]);
962 if (orgqr_work_size > work_size)
963 {
964 delete[] workspace;
965 work_size = orgqr_work_size;
966 workspace = new double[work_size];
967 std::cout << "work size increased to: " << work_size << std::endl;
968 }
969 dorgqr_(&rows,
970 &cols,
971 &min,
972 copyA.data(),
973 &rows, // lda?
974 tau.data(),
975 workspace,
976 &work_size,
977 &info4);
978 if (info3 < 0 or info4 < 0)
979 {
980 ERROR("argument passed to dorgqr or dorgqr had an illegal value");
981 ret = false;
982 }
983 else if (info3 > 0 or info4 > 0)
984 {
985 ERROR("can this happen?");
986 ret = false;
987 }
988 else
989 {
990 fill_from_lapack_array(copyA, *Q);
991 }
992 }
993 else
994 {
995 // Return the raw values for QR: the "A" matrix encodes R and the
996 // Householders, and tau has the multipliers.
997 Q->resize(rows, cols);
998 R->resize(1, min);
999 fill_from_lapack_array(copyA, *Q);
1000 fill_from_lapack_array(tau, *R);
1001 }
1002 }
1003
1004 delete[] workspace;
1005
1006 return ret;
1007}
size_t numRows() const
Definition dmat.hpp:144
void resize(size_t new_nrows, size_t new_ncols)
Definition dmat.hpp:157
size_t numColumns() const
Definition dmat.hpp:145
std::vector< double > make_lapack_array(const DMatRR &mat)
Definition lapack.cpp:20
void fill_from_lapack_array(const std::vector< double > &doubles, DMatRR &mat)
Definition lapack.cpp:45
void fill_from_lapack_upper(const std::vector< double > &lapack_numbers, int numrows, int numcols, DMatRR &upper)
Definition lapack.cpp:74
int dgeqrf_(int *m, int *n, double *A, int *lda, double *tau, double *work, int *lwork, int *info)
int dorgqr_(int *m, int *n, int *k, double *A, int *lda, double *tau, double *work, int *lwork, int *info)
const int ERROR
Definition m2-mem.cpp:55
const mpreal min(const mpreal &x, const mpreal &y)
Definition mpreal.h:2792

References dgeqrf_(), dorgqr_(), ERROR, fill_from_lapack_array(), fill_from_lapack_upper(), make_lapack_array(), DMat< ACoeffRing >::numColumns(), DMat< ACoeffRing >::numRows(), and DMat< ACoeffRing >::resize().

Referenced by MatrixOps::QR(), and MatrixOps::QR().