diff src/DLD-FUNCTIONS/qr.cc @ 7553:56be6f31dd4e

implementation of QR factorization updating
author Jaroslav Hajek <highegg@gmail.com>
date Tue, 04 Mar 2008 21:47:11 -0500
parents f5005d9510f4
children 40574114c514
line wrap: on
line diff
--- a/src/DLD-FUNCTIONS/qr.cc	Tue Mar 04 17:01:05 2008 -0500
+++ b/src/DLD-FUNCTIONS/qr.cc	Tue Mar 04 21:47:11 2008 -0500
@@ -20,6 +20,10 @@
 
 */
 
+// The qrupdate, qrinsert, and qrdelete functions were written by
+// Jaroslav Hajek <highegg@gmail.com>, Copyright (C) 2008  VZLU
+// Prague, a.s., Czech Republic.
+
 #ifdef HAVE_CONFIG_H
 #include <config.h>
 #endif
@@ -179,7 +183,7 @@
 
   int nargin = args.length ();
 
-  if (nargin < 1 || nargin > (args(0).is_sparse_type() ? 3 : 2) || nargout > 3)
+  if (nargin < 1 || nargin > (args(0).is_sparse_type() ? 3 : 2))
     {
       print_usage ();
       return retval;
@@ -342,9 +346,7 @@
 	    }
 	}
       else
-	{
-	  gripe_wrong_type_arg ("qr", arg);
-	}
+	gripe_wrong_type_arg ("qr", arg);
     }
 
   return retval;
@@ -429,6 +431,470 @@
 
 */
 
+DEFUN_DLD (qrupdate, args, ,
+  "-*- texinfo -*-\n\
+@deftypefn{Loadable Function} {[@var{Q1}, @var{R1}]} = qrupdate (@var{Q}, @var{R}, @var{u}, @var{v})\n\
+Given a QR@tie{}factorization of a real or complex matrix\n\
+@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\
+@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\
+of @w{@var{A} + @var{u}*@var{v}'}, where @var{u} and @var{v} are\n\
+column vectors (rank-1 update).\n\
+\n\
+If the matrix @var{Q} is not square, the matrix @var{A} is updated by\n\
+Q*Q'*u*v' instead of u*v'.\n\
+@seealso{qr, qrinsert, qrdelete}\n\
+@end deftypefn")
+{
+  octave_idx_type nargin = args.length ();
+  octave_value_list retval;
+
+  octave_value argQ,argR,argu,argv;
+
+  if (nargin == 4
+      && (argQ = args(0),argQ.is_matrix_type ())
+      && (argR = args(1),argR.is_matrix_type ())
+      && (argu = args(2),argu.is_matrix_type ())
+      && (argv = args(3),argv.is_matrix_type ()))
+    {
+      octave_idx_type m = argQ.rows ();
+      octave_idx_type n = argR.columns ();
+      octave_idx_type k = argQ.columns ();
+
+      if (argR.rows () == k
+          && argu.rows () == m && argu.columns () == 1
+          && argv.rows () == n && argv.columns () == 1)
+        {
+          if (argQ.is_real_matrix () 
+	      && argR.is_real_matrix () 
+	      && argu.is_real_matrix () 
+	      && argv.is_real_matrix ())
+            {
+              // all real case
+              Matrix Q = argQ.matrix_value ();
+              Matrix R = argR.matrix_value ();
+              Matrix u = argu.matrix_value ();
+              Matrix v = argv.matrix_value ();
+
+              QR fact (Q, R);
+              fact.update (u, v);
+
+              retval(1) = fact.R ();
+              retval(0) = fact.Q ();
+            }
+          else
+            {
+              // complex case
+              ComplexMatrix Q = argQ.complex_matrix_value ();
+              ComplexMatrix R = argR.complex_matrix_value ();
+              ComplexMatrix u = argu.complex_matrix_value ();
+              ComplexMatrix v = argv.complex_matrix_value ();
+
+              ComplexQR fact (Q, R);
+              fact.update (u, v);
+              
+              retval(1) = fact.R ();
+              retval(0) = fact.Q ();
+            }
+        }
+      else
+	error ("qrupdate: dimensions mismatch");
+    }
+  else
+    print_usage ();
+
+  return retval;
+}
+/*
+%!test
+%! A = [0.091364  0.613038  0.999083;
+%!      0.594638  0.425302  0.603537;
+%!      0.383594  0.291238  0.085574;
+%!      0.265712  0.268003  0.238409;
+%!      0.669966  0.743851  0.445057 ];
+%!
+%! u = [0.85082;  
+%!      0.76426;  
+%!      0.42883;  
+%!      0.53010;  
+%!      0.80683 ];
+%!
+%! v = [0.98810;
+%!      0.24295;
+%!      0.43167 ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrupdate(Q,R,u,v);
+%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - A - u*v'),Inf) < norm(A)*1e1*eps)
+%! 
+%!test
+%! A = [0.620405 + 0.956953i  0.480013 + 0.048806i  0.402627 + 0.338171i;
+%!      0.589077 + 0.658457i  0.013205 + 0.279323i  0.229284 + 0.721929i;
+%!      0.092758 + 0.345687i  0.928679 + 0.241052i  0.764536 + 0.832406i;
+%!      0.912098 + 0.721024i  0.049018 + 0.269452i  0.730029 + 0.796517i;
+%!      0.112849 + 0.603871i  0.486352 + 0.142337i  0.355646 + 0.151496i ];
+%!
+%! u = [0.20351 + 0.05401i;
+%!      0.13141 + 0.43708i;
+%!      0.29808 + 0.08789i;
+%!      0.69821 + 0.38844i;
+%!      0.74871 + 0.25821i ];
+%!
+%! v = [0.85839 + 0.29468i;
+%!      0.20820 + 0.93090i;
+%!      0.86184 + 0.34689i ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrupdate(Q,R,u,v);
+%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - A - u*v'),Inf) < norm(A)*1e1*eps)
+*/
+
+DEFUN_DLD (qrinsert, args, ,
+  "-*- texinfo -*-\n\
+@deftypefn{Loadable Function} {[@var{Q1}, @var{R1}]} = qrinsert (@var{Q}, @var{R}, @var{j}, @var{x}, @var{orient})\n\
+Given a QR@tie{}factorization of a real or complex matrix\n\
+@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\
+@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\
+@w{[A(:,1:j-1) x A(:,j:n)]}, where @var{u} is a column vector to be\n\
+inserted into @var{A} (if @var{orient} is @code{\"col\"}), or the\n\
+QR@tie{}factorization of @w{[A(1:j-1,:);x;A(:,j:n)]}, where @var{x}\n\
+is a row vector to be inserted into @var{A} (if @var{orient} is\n\
+@code{\"row\"}).\n\
+\n\
+The default value of @var{orient} is @code{\"col\"}.\n\
+\n\
+If @var{orient} is @code{\"col\"} and the matrix @var{Q} is not square,\n\
+then what gets inserted is the projection of @var{u} onto the space\n\
+spanned by columns of @var{Q}, i.e. Q*Q'*u.\n\
+\n\
+If @var{orient} is @code{\"row\"}, @var{Q} must be square.\n\
+@seealso{qr, qrupdate, qrdelete}\n\
+@end deftypefn")
+{
+  octave_idx_type nargin = args.length ();
+  octave_value_list retval;
+
+  octave_value argQ,argR,argj,argx,argor;
+
+  if ((nargin == 4 || nargin == 5)
+      && (argQ = args(0), argQ.is_matrix_type ())
+      && (argR = args(1), argR.is_matrix_type ())
+      && (argj = args(2), argj.is_scalar_type ())
+      && (argx = args(3), argx.is_matrix_type ())
+      && (nargin < 5 || (argor = args (4), argor.is_string ())))
+    {
+      octave_idx_type m = argQ.rows ();
+      octave_idx_type n = argR.columns ();
+      octave_idx_type k = argQ.columns();
+
+      bool row = false;
+
+      std::string orient = (nargin < 5) ? "col" : argor.string_value ();
+
+      if (nargin < 5 || (row = orient == "row") || (orient == "col"))
+        if (argR.rows () == k 
+            && (! row || m == k)
+            && argx.rows () == (row ? 1 : m)
+            && argx.columns () == (row ? n : 1))
+          {
+            int j = argj.int_value ();
+
+            if (j >= 1 && j <= (row ? n : m)+1)
+              {
+                if (argQ.is_real_matrix () 
+		    && argR.is_real_matrix () 
+		    && argx.is_real_matrix ())
+                  {
+                    // real case
+                    Matrix Q = argQ.matrix_value ();
+                    Matrix R = argR.matrix_value ();
+                    Matrix x = argx.matrix_value ();
+
+                    QR fact (Q, R);
+
+                    if (row) 
+                      fact.insert_row(x, j);
+                    else 
+                      fact.insert_col(x, j);
+
+                    retval(1) = fact.R ();
+                    retval(0) = fact.Q ();
+                  }
+                else
+                  {
+                    // complex case
+                    ComplexMatrix Q = argQ.complex_matrix_value ();
+                    ComplexMatrix R = argR.complex_matrix_value ();
+                    ComplexMatrix x = argx.complex_matrix_value ();
+
+                    ComplexQR fact (Q, R);
+
+                    if (row) 
+                      fact.insert_row (x, j);
+                    else 
+                      fact.insert_col (x, j);
+
+                    retval(1) = fact.R ();
+                    retval(0) = fact.Q ();
+                  }
+
+              }
+            else
+              error ("qrinsert: index j out of range");
+          }
+        else
+          error ("qrinsert: dimension mismatch");
+
+      else
+        error ("qrinsert: orient must be \"col\" or \"row\"");
+    }
+  else
+    print_usage ();
+
+  return retval;
+}
+
+/*
+%!test
+%! A = [0.091364  0.613038  0.999083;
+%!      0.594638  0.425302  0.603537;
+%!      0.383594  0.291238  0.085574;
+%!      0.265712  0.268003  0.238409;
+%!      0.669966  0.743851  0.445057 ];
+%!
+%! x = [0.85082;  
+%!      0.76426;  
+%!      0.42883;  
+%!      0.53010;  
+%!      0.80683 ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrinsert(Q,R,3,x);
+%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(:,1:2) x A(:,3)]),Inf) < norm(A)*1e1*eps)
+%! 
+%!test
+%! A = [0.620405 + 0.956953i  0.480013 + 0.048806i  0.402627 + 0.338171i;
+%!      0.589077 + 0.658457i  0.013205 + 0.279323i  0.229284 + 0.721929i;
+%!      0.092758 + 0.345687i  0.928679 + 0.241052i  0.764536 + 0.832406i;
+%!      0.912098 + 0.721024i  0.049018 + 0.269452i  0.730029 + 0.796517i;
+%!      0.112849 + 0.603871i  0.486352 + 0.142337i  0.355646 + 0.151496i ];
+%!
+%! x = [0.20351 + 0.05401i;
+%!      0.13141 + 0.43708i;
+%!      0.29808 + 0.08789i;
+%!      0.69821 + 0.38844i;
+%!      0.74871 + 0.25821i ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrinsert(Q,R,3,x);
+%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(:,1:2) x A(:,3)]),Inf) < norm(A)*1e1*eps)
+%!
+%!test
+%! A = [0.091364  0.613038  0.999083;
+%!      0.594638  0.425302  0.603537;
+%!      0.383594  0.291238  0.085574;
+%!      0.265712  0.268003  0.238409;
+%!      0.669966  0.743851  0.445057 ];
+%!
+%! x = [0.85082  0.76426  0.42883 ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrinsert(Q,R,3,x,'row');
+%! assert(norm(vec(Q'*Q - eye(6)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(1:2,:);x;A(3:5,:)]),Inf) < norm(A)*1e1*eps)
+%! 
+%!test
+%! A = [0.620405 + 0.956953i  0.480013 + 0.048806i  0.402627 + 0.338171i;
+%!      0.589077 + 0.658457i  0.013205 + 0.279323i  0.229284 + 0.721929i;
+%!      0.092758 + 0.345687i  0.928679 + 0.241052i  0.764536 + 0.832406i;
+%!      0.912098 + 0.721024i  0.049018 + 0.269452i  0.730029 + 0.796517i;
+%!      0.112849 + 0.603871i  0.486352 + 0.142337i  0.355646 + 0.151496i ];
+%!
+%! x = [0.20351 + 0.05401i  0.13141 + 0.43708i  0.29808 + 0.08789i ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrinsert(Q,R,3,x,'row');
+%! assert(norm(vec(Q'*Q - eye(6)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(1:2,:);x;A(3:5,:)]),Inf) < norm(A)*1e1*eps)
+*/
+
+DEFUN_DLD (qrdelete, args, ,
+  "-*- texinfo -*-\n\
+@deftypefn{Loadable Function} {[@var{Q1}, @var{R1}]} = qrdelete (@var{Q}, @var{R}, @var{j}, @var{orient})\n\
+Given a QR@tie{}factorization of a real or complex matrix\n\
+@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\
+@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\
+@w{[A(:,1:j-1) A(:,j+1:n)]}, i.e. @var{A} with one column deleted\n\
+(if @var{orient} is \"col\"), or the QR@tie{}factorization of\n\
+@w{[A(1:j-1,:);A(:,j+1:n)]}, i.e. @var{A} with one row deleted (if\n\
+@var{orient} is \"row\").\n\
+\n\
+The default value of @var{orient} is \"col\".\n\
+\n\
+If @var{orient} is \"col\", the matrix @var{Q} is not required to\n\
+be square.\n\
+\n\
+For @sc{Matlab} compatibility, if @var{Q} is nonsquare on input, the\n\
+updated factorization is always stripped to the economical form, i.e.\n\
+@code{columns (Q) == rows (R) = columns (R)}.\n\
+\n\
+To get the less intelligent but more natural behaviour when @var{Q}\n\
+retains it shape and @var{R} loses one column, set @var{orient} to\n\
+\"col+\" instead.\n\
+\n\
+If @var{orient} is \"row\", @var{Q} must be square.\n\
+@seealso{qr, qrinsert, qrupdate}\n\
+@end deftypefn")
+{
+  int nargin = args.length ();
+  octave_value_list retval;
+
+  octave_value argQ,argR,argj,argor;
+
+  if ((nargin == 3 || nargin == 4)
+      && (argQ = args(0), argQ.is_matrix_type ())
+      && (argR = args(1), argR.is_matrix_type ())
+      && (argj = args(2), argj.is_scalar_type ())
+      && (nargin < 4 || (argor = args (3), argor.is_string ())))
+    {
+      octave_idx_type m = argQ.rows ();
+      octave_idx_type k = argQ.columns ();
+      octave_idx_type n = argR.columns ();
+
+      bool row = false;
+      bool colp = false;
+
+      std::string orient = (nargin < 4) ? "col" : argor.string_value ();
+
+      if (nargin < 4 || (row = orient == "row") 
+          || (orient == "col") || (colp = orient == "col+"))
+        if (argR.rows() == k)
+          {
+            int j = argj.scalar_value ();
+            if (j >= 1 && j <= (row ? n : m)+1)
+              {
+                if (argQ.is_real_matrix ()
+		    && argR.is_real_matrix ())
+                  {
+                    // real case
+                    Matrix Q = argQ.matrix_value ();
+                    Matrix R = argR.matrix_value ();
+
+                    QR fact (Q, R);
+
+                    if (row) 
+                      fact.delete_row (j);
+                    else 
+                      {
+                        fact.delete_col (j);
+
+                        if (! colp && k < m)
+                          fact.economize ();
+                      }
+
+                    retval(1) = fact.R ();
+                    retval(0) = fact.Q ();
+                  }
+                else
+                  {
+                    // complex case
+                    ComplexMatrix Q = argQ.complex_matrix_value ();
+                    ComplexMatrix R = argR.complex_matrix_value ();
+
+                    ComplexQR fact (Q, R);
+
+                    if (row) 
+                      fact.delete_row (j);
+                    else 
+                      {
+                        fact.delete_col (j);
+
+                        if (! colp && k < m)
+                          fact.economize ();
+                      }
+
+                    retval(1) = fact.R ();
+                    retval(0) = fact.Q ();
+                  }
+
+              }
+            else
+              error ("qrdelete: index j out of range");
+          }
+        else
+          error ("qrdelete: dimension mismatch");
+
+      else
+        error ("qrdelete: orient must be \"col\" or \"row\"");
+    }
+  else
+    print_usage ();
+
+  return retval;
+}
+ 
+/*
+%!test
+%! A = [0.091364  0.613038  0.027504  0.999083;
+%!      0.594638  0.425302  0.562834  0.603537;
+%!      0.383594  0.291238  0.742073  0.085574;
+%!      0.265712  0.268003  0.783553  0.238409;
+%!      0.669966  0.743851  0.457255  0.445057 ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrdelete(Q,R,3);
+%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(:,1:2) A(:,4)]),Inf) < norm(A)*1e1*eps)
+%! 
+%!test
+%! A = [0.364554 + 0.993117i  0.669818 + 0.510234i  0.426568 + 0.041337i  0.847051 + 0.233291i;
+%!      0.049600 + 0.242783i  0.448946 + 0.484022i  0.141155 + 0.074420i  0.446746 + 0.392706i;
+%!      0.581922 + 0.657416i  0.581460 + 0.030016i  0.219909 + 0.447288i  0.201144 + 0.069132i;
+%!      0.694986 + 0.000571i  0.682327 + 0.841712i  0.807537 + 0.166086i  0.192767 + 0.358098i;
+%!      0.945002 + 0.066788i  0.350492 + 0.642638i  0.579629 + 0.048102i  0.600170 + 0.636938i ] * I;
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrdelete(Q,R,3);
+%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(:,1:2) A(:,4)]),Inf) < norm(A)*1e1*eps)
+%!
+%!test
+%! A = [0.091364  0.613038  0.027504  0.999083;
+%!      0.594638  0.425302  0.562834  0.603537;
+%!      0.383594  0.291238  0.742073  0.085574;
+%!      0.265712  0.268003  0.783553  0.238409;
+%!      0.669966  0.743851  0.457255  0.445057 ];
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrdelete(Q,R,3,'row');
+%! assert(norm(vec(Q'*Q - eye(4)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(1:2,:);A(4:5,:)]),Inf) < norm(A)*1e1*eps)
+%! 
+%!test
+%! A = [0.364554 + 0.993117i  0.669818 + 0.510234i  0.426568 + 0.041337i  0.847051 + 0.233291i;
+%!      0.049600 + 0.242783i  0.448946 + 0.484022i  0.141155 + 0.074420i  0.446746 + 0.392706i;
+%!      0.581922 + 0.657416i  0.581460 + 0.030016i  0.219909 + 0.447288i  0.201144 + 0.069132i;
+%!      0.694986 + 0.000571i  0.682327 + 0.841712i  0.807537 + 0.166086i  0.192767 + 0.358098i;
+%!      0.945002 + 0.066788i  0.350492 + 0.642638i  0.579629 + 0.048102i  0.600170 + 0.636938i ] * I;
+%!
+%! [Q,R] = qr(A);
+%! [Q,R] = qrdelete(Q,R,3,'row');
+%! assert(norm(vec(Q'*Q - eye(4)),Inf) < 1e1*eps)
+%! assert(norm(vec(triu(R)-R),Inf) == 0)
+%! assert(norm(vec(Q*R - [A(1:2,:);A(4:5,:)]),Inf) < norm(A)*1e1*eps)
+*/
 
 /*
 ;;; Local Variables: ***