diff src/DLD-FUNCTIONS/splu.cc @ 5164:57077d0ddc8e

[project @ 2005-02-25 19:55:24 by jwe]
author jwe
date Fri, 25 Feb 2005 19:55:28 +0000
parents
children 5bdc3f24cd5f
line wrap: on
line diff
new file mode 100644
--- /dev/null
+++ b/src/DLD-FUNCTIONS/splu.cc
@@ -0,0 +1,400 @@
+/*
+
+Copyright (C) 2004 David Bateman
+Copyright (C) 1998-2004 Andy Adler
+
+Octave is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+Octave is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include "defun-dld.h"
+#include "error.h"
+#include "gripes.h"
+#include "oct-obj.h"
+#include "utils.h"
+
+#include "SparseCmplxLU.h"
+#include "SparsedbleLU.h"
+#include "ov-re-sparse.h"
+#include "ov-cx-sparse.h"
+
+// PKG_ADD: dispatch ("lu", "splu", "sparse matrix")
+// PKG_ADD: dispatch ("lu", "splu", "sparse complex matrix")
+// PKG_ADD: dispatch ("lu", "splu", "sparse bool matrix")
+DEFUN_DLD (splu, args, nargout,
+  "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {[@var{l}, @var{u}] =} splu (@var{a})\n\
+@deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}] =} splu (@var{a})\n\
+@deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}, @var{Q}] =} splu (@var{a})\n\
+@deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}, @var{Q}] =} splu (@dots{}, @var{thres})\n\
+@deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}] =} splu (@dots{}, @var{Q})\n\
+@cindex LU decomposition\n\
+Compute the LU decomposition of the sparse matrix @var{a}, using\n\
+subroutines from UMFPACK.  The result is returned in a permuted\n\
+form, according to the optional return values @var{P} and @var{Q}.\n\
+\n\
+Called with two or three output arguments and a single input argument,\n\
+@dfn{splu} is a replacement for @dfn{lu}, and therefore the sparsity\n\
+preserving column permutations @var{Q} are not performed. Called with\n\
+a fourth output argument, the sparsity preserving column transformation\n\
+@var{Q} is returned, such that @code{@var{P} * @var{a} * @var{Q} =\n\
+@var{l} * @var{u}}.\n\
+\n\
+An additional input argument @var{thres}, that defines the pivoting\n\
+threshold can be given. Alternatively, the desired sparsity preserving\n\
+column permutations @var{Q} can be passed. Note that @var{Q} is assumed\n\
+to be fixed if three are fewer than four output arguments. Otherwise,\n\
+the updated column permutations are returned as the fourth argument.\n\
+\n\
+With two output arguments, returns the permuted forms of the upper and\n\
+lower triangular matrices, such that @code{@var{a} = @var{l} * @var{u}}.\n\
+With two or three output arguments, if a user-defined @var{Q} is given,\n\
+then @code{@var{u} * @var{Q}'} is returned. The matrix is not required to\n\
+be square.\n\
+@end deftypefn\n\
+@seealso{sparse, spinv, colamd, symamd}")
+{
+  octave_value_list retval;
+
+  int nargin = args.length ();
+
+  if (nargin < 1 || nargin > 3 || nargout > 4)
+    {
+      print_usage ("splu");
+      return retval;
+    }
+
+  octave_value arg = args(0);
+
+  int nr = arg.rows ();
+  int nc = arg.columns ();
+
+  int arg_is_empty = empty_arg ("splu", nr, nc);
+
+  if (arg_is_empty < 0)
+    return retval;
+  else if (arg_is_empty > 0)
+    return octave_value_list (3, SparseMatrix ());
+
+  ColumnVector Qinit;
+  bool have_Qinit = false;
+  double thres = -1.;
+
+  for (int k = 1; k < nargin; k++)
+    {
+      if (args(k).class_name () == "sparse") 
+	{
+	  SparseMatrix tmp = args (k).sparse_matrix_value ();
+	  
+	  if (error_state)
+	    {
+	      error ("splu: Not a valid permutation/threshold");
+	      return retval;
+	    }
+
+	  dim_vector dv = tmp.dims ();
+
+	  if (dv(0) == 1 && dv(1) == 1)
+	    thres = tmp (0);
+	  else if (dv(0) == 1 || dv(1) == 1)
+	    {
+	      int nel = tmp.numel ();
+	      Qinit.resize (nel);
+	      for (int i = 0; i < nel; i++)
+		Qinit (i) = tmp (i) - 1;
+	      have_Qinit = true;
+	    }
+	  else
+	    {
+	      int t_nc = tmp.cols ();
+	      
+	      if (tmp.nnz () != t_nc)
+		error ("splu: Not a valid permutation matrix");
+	      else
+		{
+		  for (int i = 0; i < t_nc + 1; i++)
+		    if (tmp.cidx(i) != i)
+		      {
+			error ("splu: Not a valid permutation matrix");
+			break;
+		      }
+		}
+		  
+	      if (!error_state)
+		{
+		  for (int i = 0; i < t_nc; i++)
+		    if (tmp.data (i) != 1.)
+		      {
+			error ("splu: Not a valid permutation matrix");
+			break;
+		      }
+		    else
+		      Qinit (i) = tmp.ridx (i) - 1; 
+		}
+	      
+	      if (! error_state)
+		have_Qinit = true;
+	    }
+	}
+      else
+	{
+	  NDArray tmp = args(k).array_value ();
+
+	  if (error_state)
+	    return retval;
+
+	  dim_vector dv = tmp.dims ();
+	  if (dv.length () > 2)
+	    {
+	      error ("splu: second argument must be a vector/matrix or a scalar");
+	    }
+	  else if (dv(0) == 1 && dv(1) == 1)
+	    thres = tmp (0);
+	  else if (dv(0) == 1 || dv(1) == 1)
+	    {
+	      int nel = tmp.numel ();
+	      Qinit.resize (nel);
+	      for (int i = 0; i < nel; i++)
+		Qinit (i) = tmp (i) - 1;
+	      have_Qinit = true;
+	    }
+	  else
+	    {
+	      SparseMatrix tmp2 (tmp);
+
+	      int t_nc = tmp2.cols ();
+	      
+	      if (tmp2.nnz () != t_nc)
+		error ("splu: Not a valid permutation matrix");
+	      else
+		{
+		  for (int i = 0; i < t_nc + 1; i++)
+		    if (tmp2.cidx(i) != i)
+		      {
+			error ("splu: Not a valid permutation matrix");
+			break;
+		      }
+		}
+		  
+	      if (!error_state)
+		{
+		  for (int i = 0; i < t_nc; i++)
+		    if (tmp2.data (i) != 1.)
+		      {
+			error ("splu: Not a valid permutation matrix");
+			break;
+		      }
+		    else
+		      Qinit (i) = tmp2.ridx (i) - 1; 
+		}
+	      
+	      if (! error_state)
+		have_Qinit = true;
+	    }
+	}
+    }
+
+  if (error_state)
+    return retval;
+
+  if (arg.is_real_type ())
+    {
+      SparseMatrix m = arg.sparse_matrix_value ();
+
+      if (nargout < 4 && ! have_Qinit)
+	{
+	  int m_nc = m.cols ();
+	  Qinit.resize (m_nc);
+	  for (int i = 0; i < m_nc; i++)
+	    Qinit (i) = i;
+	}
+
+      if (! error_state)
+	{
+	  switch (nargout)
+	    {
+	    case 0:
+	    case 1:
+	    case 2:
+	      {
+		SparseLU fact (m, Qinit, thres, true);
+
+		SparseMatrix P = fact.Pr ();
+		SparseMatrix L = P.transpose () * fact.L ();
+		if (have_Qinit)
+		  retval(1) = fact.U () * fact.Pc ().transpose ();
+		else
+		  retval(1) = fact.U ();
+
+		retval(0) = L;
+	      }
+	      break;
+
+	    case 3:
+	      {
+		SparseLU fact (m, Qinit, thres, true);
+
+		retval(2) = fact.Pr ();
+		if (have_Qinit)
+		  retval(1) = fact.U () * fact.Pc ().transpose ();
+		else
+		  retval(1) = fact.U ();
+		retval(0) = fact.L ();
+	      }
+	      break;
+
+	    case 4:
+	    default:
+	      {
+		if (have_Qinit)
+		  {
+		    SparseLU fact (m, Qinit, thres, false);
+
+		    retval(3) = fact.Pc ();
+		    retval(2) = fact.Pr ();
+		    retval(1) = fact.U ();
+		    retval(0) = fact.L ();
+		  }
+		else
+		  {
+		    SparseLU fact (m, thres);
+
+		    retval(3) = fact.Pc ();
+		    retval(2) = fact.Pr ();
+		    retval(1) = fact.U ();
+		    retval(0) = fact.L ();
+		  }
+	      }
+	      break;
+	    }
+	}
+    }
+  else if (arg.is_complex_type ())
+    {
+      SparseComplexMatrix m = arg.sparse_complex_matrix_value ();
+
+      if (nargout < 4 && ! have_Qinit)
+	{
+	  int m_nc = m.cols ();
+	  Qinit.resize (m_nc);
+	  for (int i = 0; i < m_nc; i++)
+	    Qinit (i) = i;
+	}
+
+      if (! error_state)
+	{
+	  switch (nargout)
+	    {
+	    case 0:
+	    case 1:
+	    case 2:
+	      {
+		SparseComplexLU fact (m, Qinit, thres, true);
+
+		SparseMatrix P = fact.Pr ();
+		SparseComplexMatrix L = P.transpose () * fact.L ();
+
+		if (have_Qinit)
+		  retval(1) = fact.U () * fact.Pc ().transpose ();
+		else
+		  retval(1) = fact.U ();
+		retval(0) = L;
+	      }
+	      break;
+
+	    case 3:
+	      {
+		SparseComplexLU fact (m, Qinit, thres, true);
+
+		retval(2) = fact.Pr ();
+		if (have_Qinit)
+		  retval(1) = fact.U () * fact.Pc ().transpose ();
+		else
+		  retval(1) = fact.U ();
+		retval(0) = fact.L ();
+	      }
+	      break;
+
+	    case 4:
+	    default:
+	      {
+		if (have_Qinit)
+		  {
+		    SparseComplexLU fact (m, Qinit, thres, false);
+
+		    retval(3) = fact.Pc ();
+		    retval(2) = fact.Pr ();
+		    retval(1) = fact.U ();
+		    retval(0) = fact.L ();
+		  }
+		else
+		  {
+		    SparseComplexLU fact (m, thres);
+
+		    retval(3) = fact.Pc ();
+		    retval(2) = fact.Pr ();
+		    retval(1) = fact.U ();
+		    retval(0) = fact.L ();
+		  }
+	      }
+	      break;
+	    }
+	}
+    }
+  else
+    {
+      gripe_wrong_type_arg ("splu", arg);
+    }
+
+  return retval;
+}
+
+// PKG_ADD: dispatch ("inv", "spinv", "sparse matrix")
+// PKG_ADD: dispatch ("inv", "spinv", "sparse complex matrix")
+// PKG_ADD: dispatch ("inv", "spinv", "sparse bool matrix")
+// PKG_ADD: dispatch ("inverse", "spinv", "sparse matrix")
+// PKG_ADD: dispatch ("inverse", "spinv", "sparse complex matrix")
+// PKG_ADD: dispatch ("inverse", "spinv", "sparse bool matrix")
+DEFUN_DLD (spinv, args, nargout,
+  "-*- texinfo -*-\n\
+@deftypefn {Loadable Function} {[@var{x}, @var{rcond}] = } spinv (@var{a}, @var{Q})\n\
+@deftypefnx {Loadable Function} {[@var{x}, @var{rcond}, @var{Q}] = } spinv (@var{a}, @var{Q})\n\
+Compute the inverse of the square matrix @var{a}.  Return an estimate\n\
+of the reciprocal condition number if requested, otherwise warn of an\n\
+ill-conditioned matrix if the reciprocal condition number is small.\n\
+\n\
+An optional second input argument @var{Q} is the optional pre-ordering of\n\
+the matrix, such that @code{@var{x} = inv (@var{a} (:, @var{Q}))}. @var{Q}\n\
+can equally be a matrix, in which case @code{@var{x} = inv (@var{a} *\n\
+@var{Q}))}.\n\
+\n\
+If a third output argument is given then the permuations to achieve a sparse\n\
+inverse are returned. It is not required that the return column permutations\n\
+@var{Q} and the same as the user supplied permutations\n\
+@end deftypefn")
+{
+  error ("spinv: not implemented yet");
+  return octave_value ();
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/