diff liboctave/dbleQRP.cc @ 8597:c86718093c1b

improve & fix QR classes
author Jaroslav Hajek <highegg@gmail.com>
date Tue, 27 Jan 2009 12:40:06 +0100
parents e3c9102431a9
children 20dfb885f877
line wrap: on
line diff
--- a/liboctave/dbleQRP.cc	Tue Jan 27 08:15:08 2009 +0100
+++ b/liboctave/dbleQRP.cc	Tue Jan 27 12:40:06 2009 +0100
@@ -30,6 +30,7 @@
 #include "dbleQRP.h"
 #include "f77-fcn.h"
 #include "lo-error.h"
+#include "oct-locbuf.h"
 
 extern "C"
 {
@@ -37,11 +38,6 @@
   F77_FUNC (dgeqp3, DGEQP3) (const octave_idx_type&, const octave_idx_type&, double*,
 			     const octave_idx_type&, octave_idx_type*, double*, double*,
                              const octave_idx_type&, octave_idx_type&);
-
-  F77_RET_T
-  F77_FUNC (dorgqr, DORGQR) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&,
-			     double*, const octave_idx_type&, double*, double*,
-			     const octave_idx_type&, octave_idx_type&);
 }
 
 // It would be best to share some of this code with QR class...
@@ -60,38 +56,32 @@
   octave_idx_type m = a.rows ();
   octave_idx_type n = a.cols ();
 
-  if (m == 0 || n == 0)
-    {
-      (*current_liboctave_error_handler) ("QR must have non-empty matrix");
-      return;
-    }
-
   octave_idx_type min_mn = m < n ? m : n;
-  Array<double> tau (min_mn);
-  double *ptau = tau.fortran_vec ();
+  OCTAVE_LOCAL_BUFFER (double, tau, min_mn);
 
   octave_idx_type info = 0;
 
-  Matrix A_fact = a;
-  if (m > n && qr_type != QR::economy)
-    A_fact.resize (m, m, 0.0);
-
-  double *tmp_data = A_fact.fortran_vec ();
+  Matrix afact = a;
+  if (m > n && qr_type == QR::std)
+    afact.resize (m, m);
 
   MArray<octave_idx_type> jpvt (n, 0);
-  octave_idx_type *pjpvt = jpvt.fortran_vec ();
 
-  double rlwork = 0;
-  // Workspace query...
-  F77_XFCN (dgeqp3, DGEQP3, (m, n, tmp_data, m, pjpvt, ptau, &rlwork, -1, info));
+  if (m > 0)
+    {
+      // workspace query.
+      double rlwork;
+      F77_XFCN (dgeqp3, DGEQP3, (m, n, afact.fortran_vec (), m, jpvt.fortran_vec (),
+                                 tau, &rlwork, -1, info));
 
-  octave_idx_type lwork = rlwork;
-  Array<double> work (lwork);
-  double *pwork = work.fortran_vec ();
-
-  // Code to enforce a certain permutation could go here...
-
-  F77_XFCN (dgeqp3, DGEQP3, (m, n, tmp_data, m, pjpvt, ptau, pwork, lwork, info));
+      // allocate buffer and do the job.
+      octave_idx_type lwork = rlwork; lwork = std::max (lwork, 1);
+      OCTAVE_LOCAL_BUFFER (double, work, lwork);
+      F77_XFCN (dgeqp3, DGEQP3, (m, n, afact.fortran_vec (), m, jpvt.fortran_vec (),
+                                 tau, work, lwork, info));
+    }
+  else
+    for (octave_idx_type i = 0; i < n; i++) jpvt(i) = i+1;
 
   // Form Permutation matrix (if economy is requested, return the
   // indices only!)
@@ -99,25 +89,8 @@
   jpvt -= 1;
   p = PermMatrix (jpvt, true);
 
-  octave_idx_type n2 = (qr_type == QR::economy) ? min_mn : m;
 
-  if (qr_type == QR::economy && m > n)
-    r.resize (n, n, 0.0);
-  else
-    r.resize (m, n, 0.0);
-
-  for (octave_idx_type j = 0; j < n; j++)
-    {
-      octave_idx_type limit = j < min_mn-1 ? j : min_mn-1;
-      for (octave_idx_type i = 0; i <= limit; i++)
-	r.elem (i, j) = A_fact.elem (i, j);
-    }
-
-  F77_XFCN (dorgqr, DORGQR, (m, n2, min_mn, tmp_data, m, ptau,
-			     pwork, lwork, info));
-
-  q = A_fact;
-  q.resize (m, n2);
+  form (n, afact, tau, qr_type);
 }
 
 ColumnVector