GNU Octave  4.4.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
colamd.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 2004-2018 David Bateman
4 Copyright (C) 1998-2004 Andy Adler
5 
6 This file is part of Octave.
7 
8 Octave is free software: you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
12 
13 Octave is distributed in the hope that it will be useful, but
14 WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
17 
18 You should have received a copy of the GNU General Public License
19 along with Octave; see the file COPYING. If not, see
20 <https://www.gnu.org/licenses/>.
21 
22 */
23 
24 // This is the octave interface to colamd, which bore the copyright given
25 // in the help of the functions.
26 
27 #if defined (HAVE_CONFIG_H)
28 # include "config.h"
29 #endif
30 
31 #include <cstdlib>
32 
33 #include <string>
34 
35 #include "CSparse.h"
36 #include "dNDArray.h"
37 #include "dSparse.h"
38 #include "oct-locbuf.h"
39 #include "oct-sparse.h"
40 
41 #include "defun-dld.h"
42 #include "error.h"
43 #include "errwarn.h"
44 #include "ovl.h"
45 #include "pager.h"
46 
47 // The symmetric column elimination tree code take from the Davis LDL code.
48 // Copyright given elsewhere in this file.
49 static void
50 symetree (const octave_idx_type *ridx, const octave_idx_type *cidx,
52 {
54  OCTAVE_LOCAL_BUFFER (octave_idx_type, Pinv, (P ? n : 0));
55  if (P)
56  // If P is present then compute Pinv, the inverse of P
57  for (octave_idx_type k = 0 ; k < n ; k++)
58  Pinv[P[k]] = k;
59 
60  for (octave_idx_type k = 0 ; k < n ; k++)
61  {
62  // L(k,:) pattern: all nodes reachable in etree from nz in A(0:k-1,k)
63  Parent[k] = n ; // parent of k is not yet known
64  Flag[k] = k ; // mark node k as visited
65  octave_idx_type kk = (P ? P[k] // kth original, or permuted, column
66  : (k));
67  octave_idx_type p2 = cidx[kk+1];
68  for (octave_idx_type p = cidx[kk] ; p < p2 ; p++)
69  {
70  // A (i,k) is nonzero (original or permuted A)
71  octave_idx_type i = (Pinv) ? (Pinv[ridx[p]]) : (ridx[p]);
72  if (i < k)
73  {
74  // follow path from i to root of etree, stop at flagged node
75  for ( ; Flag[i] != k ; i = Parent[i])
76  {
77  // find parent of i if not yet determined
78  if (Parent[i] == n)
79  Parent[i] = k;
80  Flag[i] = k ; // mark i as visited
81  }
82  }
83  }
84  }
85 }
86 
87 // The elimination tree post-ordering code below is taken from SuperLU
88 static inline octave_idx_type
90 {
91  pp[i] = i;
92  return i;
93 }
94 
95 static inline octave_idx_type
97 {
98  pp[s] = t;
99  return t;
100 }
101 
102 static inline octave_idx_type
104 {
105  octave_idx_type p = pp[i];
106  octave_idx_type gp = pp[p];
107 
108  while (gp != p)
109  {
110  pp[i] = gp;
111  i = gp;
112  p = pp[i];
113  gp = pp[p];
114  }
115 
116  return p;
117 }
118 
119 static octave_idx_type
121  octave_idx_type *next_kid, octave_idx_type *post,
122  octave_idx_type postnum)
123 {
124  for (octave_idx_type w = first_kid[v]; w != -1; w = next_kid[w])
125  postnum = etdfs (w, first_kid, next_kid, post, postnum);
126 
127  post[postnum++] = v;
128 
129  return postnum;
130 }
131 
132 static void
134  octave_idx_type *post)
135 {
136  // Allocate storage for working arrays and results
137  OCTAVE_LOCAL_BUFFER (octave_idx_type, first_kid, n+1);
138  OCTAVE_LOCAL_BUFFER (octave_idx_type, next_kid, n+1);
139 
140  // Set up structure describing children
141  for (octave_idx_type v = 0; v <= n; first_kid[v++] = -1)
142  ; // do nothing
143 
144  for (octave_idx_type v = n-1; v >= 0; v--)
145  {
146  octave_idx_type dad = parent[v];
147  next_kid[v] = first_kid[dad];
148  first_kid[dad] = v;
149  }
150 
151  // Depth-first search from dummy root vertex #n
152  etdfs (n, first_kid, next_kid, post, 0);
153 }
154 
155 static void
156 coletree (const octave_idx_type *ridx, const octave_idx_type *colbeg,
157  octave_idx_type *colend, octave_idx_type *parent,
159 {
162  OCTAVE_LOCAL_BUFFER (octave_idx_type, firstcol, nr);
163 
164  // Compute firstcol[row] = first nonzero column in row
165  for (octave_idx_type row = 0; row < nr; firstcol[row++] = nc)
166  ; // do nothing
167 
168  for (octave_idx_type col = 0; col < nc; col++)
169  for (octave_idx_type p = colbeg[col]; p < colend[col]; p++)
170  {
171  octave_idx_type row = ridx[p];
172  if (firstcol[row] > col)
173  firstcol[row] = col;
174  }
175 
176  // Compute etree by Liu's algorithm for symmetric matrices,
177  // except use (firstcol[r],c) in place of an edge (r,c) of A.
178  // Thus each row clique in A'*A is replaced by a star
179  // centered at its first vertex, which has the same fill.
180  for (octave_idx_type col = 0; col < nc; col++)
181  {
182  octave_idx_type cset = make_set (col, pp);
183  root[cset] = col;
184  parent[col] = nc;
185  for (octave_idx_type p = colbeg[col]; p < colend[col]; p++)
186  {
187  octave_idx_type row = firstcol[ridx[p]];
188  if (row >= col)
189  continue;
190  octave_idx_type rset = find (row, pp);
191  octave_idx_type rroot = root[rset];
192  if (rroot != col)
193  {
194  parent[rroot] = col;
195  cset = link (cset, rset, pp);
196  root[cset] = col;
197  }
198  }
199  }
200 }
201 
202 DEFUN_DLD (colamd, args, nargout,
203  doc: /* -*- texinfo -*-
204 @deftypefn {} {@var{p} =} colamd (@var{S})
205 @deftypefnx {} {@var{p} =} colamd (@var{S}, @var{knobs})
206 @deftypefnx {} {[@var{p}, @var{stats}] =} colamd (@var{S})
207 @deftypefnx {} {[@var{p}, @var{stats}] =} colamd (@var{S}, @var{knobs})
208 
209 Compute the column approximate minimum degree permutation.
210 
211 @code{@var{p} = colamd (@var{S})} returns the column approximate minimum
212 degree permutation vector for the sparse matrix @var{S}. For a
213 non-symmetric matrix @var{S}, @code{@var{S}(:,@var{p})} tends to have
214 sparser LU@tie{}factors than @var{S}. The Cholesky@tie{}factorization of
215 @code{@var{S}(:,@var{p})' * @var{S}(:,@var{p})} also tends to be sparser
216 than that of @code{@var{S}' * @var{S}}.
217 
218 @var{knobs} is an optional one- to three-element input vector. If @var{S}
219 is m-by-n, then rows with more than @code{max(16,@var{knobs}(1)*sqrt(n))}
220 entries are ignored. Columns with more than
221 @code{max (16,@var{knobs}(2)*sqrt(min(m,n)))} entries are removed prior to
222 ordering, and ordered last in the output permutation @var{p}. Only
223 completely dense rows or columns are removed if @code{@var{knobs}(1)} and
224 @code{@var{knobs}(2)} are < 0, respectively. If @code{@var{knobs}(3)} is
225 nonzero, @var{stats} and @var{knobs} are printed. The default is
226 @code{@var{knobs} = [10 10 0]}. Note that @var{knobs} differs from earlier
227 versions of colamd.
228 
229 @var{stats} is an optional 20-element output vector that provides data
230 about the ordering and the validity of the input matrix @var{S}. Ordering
231 statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1)} and
232 @code{@var{stats}(2)} are the number of dense or empty rows and columns
233 ignored by @sc{colamd} and @code{@var{stats}(3)} is the number of garbage
234 collections performed on the internal data structure used by @sc{colamd}
235 (roughly of size @code{2.2 * nnz(@var{S}) + 4 * @var{m} + 7 * @var{n}}
236 integers).
237 
238 Octave built-in functions are intended to generate valid sparse matrices,
239 with no duplicate entries, with ascending row indices of the nonzeros
240 in each column, with a non-negative number of entries in each column (!)
241 and so on. If a matrix is invalid, then @sc{colamd} may or may not be able
242 to continue. If there are duplicate entries (a row index appears two or
243 more times in the same column) or if the row indices in a column are out
244 of order, then @sc{colamd} can correct these errors by ignoring the
245 duplicate entries and sorting each column of its internal copy of the
246 matrix @var{S} (the input matrix @var{S} is not repaired, however). If a
247 matrix is invalid in other ways then @sc{colamd} cannot continue, an error
248 message is printed, and no output arguments (@var{p} or @var{stats}) are
249 returned.
250 @sc{colamd} is thus a simple way to check a sparse matrix to see if it's
251 valid.
252 
253 @code{@var{stats}(4:7)} provide information if @sc{colamd} was able to
254 continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if
255 invalid. @code{@var{stats}(5)} is the rightmost column index that is
256 unsorted or contains duplicate entries, or zero if no such column exists.
257 @code{@var{stats}(6)} is the last seen duplicate or out-of-order row
258 index in the column index given by @code{@var{stats}(5)}, or zero if no
259 such row index exists. @code{@var{stats}(7)} is the number of duplicate
260 or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in
261 the current version of @sc{colamd} (reserved for future use).
262 
263 The ordering is followed by a column elimination tree post-ordering.
264 
265 The authors of the code itself are @nospell{Stefan I. Larimore} and
266 @nospell{Timothy A. Davis}. The algorithm was developed in collaboration with
267 @nospell{John Gilbert}, Xerox PARC, and @nospell{Esmond Ng}, Oak Ridge National
268 Laboratory. (see @url{http://faculty.cse.tamu.edu/davis/suitesparse.html})
269 @seealso{colperm, symamd, ccolamd}
270 @end deftypefn */)
271 {
272 #if defined (HAVE_COLAMD)
273 
274  int nargin = args.length ();
275 
277  print_usage ();
278 
279  octave_value_list retval (nargout == 2 ? 2 : 1);
280  int spumoni = 0;
281 
282  // Get knobs
283  static_assert (COLAMD_KNOBS <= 40, "colamd: # of COLAMD_KNOBS exceeded. Please report this to bugs.octave.org");
284  double knob_storage[COLAMD_KNOBS];
285  double *knobs = &knob_storage[0];
286  COLAMD_NAME (_set_defaults) (knobs);
287 
288  // Check for user-passed knobs
289  if (nargin == 2)
290  {
291  NDArray User_knobs = args(1).array_value ();
292  int nel_User_knobs = User_knobs.numel ();
293 
294  if (nel_User_knobs > 0)
295  knobs[COLAMD_DENSE_ROW] = User_knobs(0);
296  if (nel_User_knobs > 1)
297  knobs[COLAMD_DENSE_COL] = User_knobs(1);
298  if (nel_User_knobs > 2)
299  spumoni = static_cast<int> (User_knobs(2));
300 
301  // print knob settings if spumoni is set
302  if (spumoni)
303  {
304 
305  octave_stdout << "\ncolamd version " << COLAMD_MAIN_VERSION
306  << '.' << COLAMD_SUB_VERSION
307  << ", " << COLAMD_DATE << ":\n";
308 
309  if (knobs[COLAMD_DENSE_ROW] >= 0)
310  octave_stdout << "knobs(1): " << User_knobs (0)
311  << ", rows with > max (16,"
312  << knobs[COLAMD_DENSE_ROW] << "*sqrt (size(A,2)))"
313  << " entries removed\n";
314  else
315  octave_stdout << "knobs(1): " << User_knobs (0)
316  << ", only completely dense rows removed\n";
317 
318  if (knobs[COLAMD_DENSE_COL] >= 0)
319  octave_stdout << "knobs(2): " << User_knobs (1)
320  << ", cols with > max (16,"
321  << knobs[COLAMD_DENSE_COL] << "*sqrt (size(A)))"
322  << " entries removed\n";
323  else
324  octave_stdout << "knobs(2): " << User_knobs (1)
325  << ", only completely dense columns removed\n";
326 
327  octave_stdout << "knobs(3): " << User_knobs (2)
328  << ", statistics and knobs printed\n";
329 
330  }
331  }
332 
333  octave_idx_type n_row, n_col, nnz;
334  octave_idx_type *ridx, *cidx;
336  SparseMatrix sm;
337 
338  if (args(0).issparse ())
339  {
340  if (args(0).iscomplex ())
341  {
342  scm = args(0).sparse_complex_matrix_value ();
343  n_row = scm.rows ();
344  n_col = scm.cols ();
345  nnz = scm.nnz ();
346  ridx = scm.xridx ();
347  cidx = scm.xcidx ();
348  }
349  else
350  {
351  sm = args(0).sparse_matrix_value ();
352 
353  n_row = sm.rows ();
354  n_col = sm.cols ();
355  nnz = sm.nnz ();
356  ridx = sm.xridx ();
357  cidx = sm.xcidx ();
358  }
359  }
360  else
361  {
362  if (args(0).iscomplex ())
363  sm = SparseMatrix (real (args(0).complex_matrix_value ()));
364  else
365  sm = SparseMatrix (args(0).matrix_value ());
366 
367  n_row = sm.rows ();
368  n_col = sm.cols ();
369  nnz = sm.nnz ();
370  ridx = sm.xridx ();
371  cidx = sm.xcidx ();
372  }
373 
374  // Allocate workspace for colamd
376  for (octave_idx_type i = 0; i < n_col+1; i++)
377  p[i] = cidx[i];
378 
379  octave_idx_type Alen = COLAMD_NAME (_recommended) (nnz, n_row, n_col);
381  for (octave_idx_type i = 0; i < nnz; i++)
382  A[i] = ridx[i];
383 
384  // Order the columns (destroys A)
385  static_assert (COLAMD_STATS <= 40, "colamd: # of COLAMD_STATS exceeded. Please report this to bugs.octave.org");
386  octave::suitesparse_integer stats_storage[COLAMD_STATS];
387  octave::suitesparse_integer *stats = &stats_storage[0];
388  if (! COLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats))
389  {
390  COLAMD_NAME (_report)(stats);
391 
392  error ("colamd: internal error!");
393  }
394 
395  // column elimination tree post-ordering (reuse variables)
396  OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col + 1);
397  OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col + 1);
398  OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1);
399 
400  for (octave_idx_type i = 0; i < n_col; i++)
401  {
402  colbeg[i] = cidx[p[i]];
403  colend[i] = cidx[p[i]+1];
404  }
405 
406  coletree (ridx, colbeg, colend, etree, n_row, n_col);
407 
408  // Calculate the tree post-ordering
409  tree_postorder (n_col, etree, colbeg);
410 
411  // return the permutation vector
412  NDArray out_perm (dim_vector (1, n_col));
413  for (octave_idx_type i = 0; i < n_col; i++)
414  out_perm(i) = p[colbeg[i]] + 1;
415 
416  retval(0) = out_perm;
417 
418  // print stats if spumoni > 0
419  if (spumoni > 0)
420  COLAMD_NAME (_report)(stats);
421 
422  // Return the stats vector
423  if (nargout == 2)
424  {
425  NDArray out_stats (dim_vector (1, COLAMD_STATS));
426  for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++)
427  out_stats(i) = stats[i];
428  retval(1) = out_stats;
429 
430  // fix stats (5) and (6), for 1-based information on
431  // jumbled matrix. note that this correction doesn't
432  // occur if symamd returns FALSE
433  out_stats(COLAMD_INFO1)++;
434  out_stats(COLAMD_INFO2)++;
435  }
436 
437  return retval;
438 
439 #else
440 
441  octave_unused_parameter (args);
442  octave_unused_parameter (nargout);
443 
444  err_disabled_feature ("colamd", "COLAMD");
445 
446 #endif
447 }
448 
449 DEFUN_DLD (symamd, args, nargout,
450  doc: /* -*- texinfo -*-
451 @deftypefn {} {@var{p} =} symamd (@var{S})
452 @deftypefnx {} {@var{p} =} symamd (@var{S}, @var{knobs})
453 @deftypefnx {} {[@var{p}, @var{stats}] =} symamd (@var{S})
454 @deftypefnx {} {[@var{p}, @var{stats}] =} symamd (@var{S}, @var{knobs})
455 
456 For a symmetric positive definite matrix @var{S}, returns the permutation
457 vector p such that @code{@var{S}(@var{p}, @var{p})} tends to have a
458 sparser Cholesky@tie{}factor than @var{S}.
459 
460 Sometimes @code{symamd} works well for symmetric indefinite matrices too.
461 The matrix @var{S} is assumed to be symmetric; only the strictly lower
462 triangular part is referenced. @var{S} must be square.
463 
464 @var{knobs} is an optional one- to two-element input vector. If @var{S} is
465 n-by-n, then rows and columns with more than
466 @code{max (16,@var{knobs}(1)*sqrt(n))} entries are removed prior to
467 ordering, and ordered last in the output permutation @var{p}. No
468 rows/columns are removed if @code{@var{knobs}(1) < 0}. If
469 @code{@var{knobs}(2)} is nonzero, @var{stats} and @var{knobs} are
470 printed. The default is @code{@var{knobs} = [10 0]}. Note that
471 @var{knobs} differs from earlier versions of @code{symamd}.
472 
473 @var{stats} is an optional 20-element output vector that provides data
474 about the ordering and the validity of the input matrix @var{S}. Ordering
475 statistics are in @code{@var{stats}(1:3)}.
476 @code{@var{stats}(1) = @var{stats}(2)} is the number of dense or empty rows
477 and columns ignored by SYMAMD and @code{@var{stats}(3)} is the number of
478 garbage collections performed on the internal data structure used by SYMAMD
479 (roughly of size @code{8.4 * nnz (tril (@var{S}, -1)) + 9 * @var{n}}
480 integers).
481 
482 Octave built-in functions are intended to generate valid sparse matrices,
483 with no duplicate entries, with ascending row indices of the nonzeros
484 in each column, with a non-negative number of entries in each column (!)
485 and so on. If a matrix is invalid, then SYMAMD may or may not be able
486 to continue. If there are duplicate entries (a row index appears two or
487 more times in the same column) or if the row indices in a column are out
488 of order, then SYMAMD can correct these errors by ignoring the duplicate
489 entries and sorting each column of its internal copy of the matrix S (the
490 input matrix S is not repaired, however). If a matrix is invalid in
491 other ways then SYMAMD cannot continue, an error message is printed, and
492 no output arguments (@var{p} or @var{stats}) are returned. SYMAMD is
493 thus a simple way to check a sparse matrix to see if it's valid.
494 
495 @code{@var{stats}(4:7)} provide information if SYMAMD was able to
496 continue. The matrix is OK if @code{@var{stats} (4)} is zero, or 1
497 if invalid. @code{@var{stats}(5)} is the rightmost column index that
498 is unsorted or contains duplicate entries, or zero if no such column
499 exists. @code{@var{stats}(6)} is the last seen duplicate or out-of-order
500 row index in the column index given by @code{@var{stats}(5)}, or zero
501 if no such row index exists. @code{@var{stats}(7)} is the number of
502 duplicate or out-of-order row indices. @code{@var{stats}(8:20)} is
503 always zero in the current version of SYMAMD (reserved for future use).
504 
505 The ordering is followed by a column elimination tree post-ordering.
506 
507 The authors of the code itself are @nospell{Stefan I. Larimore} and
508 @nospell{Timothy A. Davis}. The algorithm was developed in collaboration with
509 @nospell{John Gilbert}, Xerox PARC, and @nospell{Esmond Ng}, Oak Ridge National
510 Laboratory. (see @url{http://faculty.cse.tamu.edu/davis/suitesparse.html})
511 @seealso{colperm, colamd}
512 @end deftypefn */)
513 {
514 #if defined (HAVE_COLAMD)
515 
516  int nargin = args.length ();
517 
519  print_usage ();
520 
521  octave_value_list retval (nargin == 2 ? 2 : 1);
522  int spumoni = 0;
523 
524  // Get knobs
525  static_assert (COLAMD_KNOBS <= 40, "symamd: # of COLAMD_KNOBS exceeded. Please report this to bugs.octave.org");
526  double knob_storage[COLAMD_KNOBS];
527  double *knobs = &knob_storage[0];
528  COLAMD_NAME (_set_defaults) (knobs);
529 
530  // Check for user-passed knobs
531  if (nargin == 2)
532  {
533  NDArray User_knobs = args(1).array_value ();
534  int nel_User_knobs = User_knobs.numel ();
535 
536  if (nel_User_knobs > 0)
537  knobs[COLAMD_DENSE_ROW] = User_knobs(COLAMD_DENSE_ROW);
538  if (nel_User_knobs > 1)
539  spumoni = static_cast<int> (User_knobs (1));
540  }
541 
542  // print knob settings if spumoni is set
543  if (spumoni > 0)
544  octave_stdout << "symamd: dense row/col fraction: "
545  << knobs[COLAMD_DENSE_ROW] << std::endl;
546 
547  octave_idx_type n_row, n_col;
548  octave_idx_type *ridx, *cidx;
549  SparseMatrix sm;
551 
552  if (args(0).issparse ())
553  {
554  if (args(0).iscomplex ())
555  {
556  scm = args(0).sparse_complex_matrix_value ();
557  n_row = scm.rows ();
558  n_col = scm.cols ();
559  ridx = scm.xridx ();
560  cidx = scm.xcidx ();
561  }
562  else
563  {
564  sm = args(0).sparse_matrix_value ();
565  n_row = sm.rows ();
566  n_col = sm.cols ();
567  ridx = sm.xridx ();
568  cidx = sm.xcidx ();
569  }
570  }
571  else
572  {
573  if (args(0).iscomplex ())
574  sm = SparseMatrix (real (args(0).complex_matrix_value ()));
575  else
576  sm = SparseMatrix (args(0).matrix_value ());
577 
578  n_row = sm.rows ();
579  n_col = sm.cols ();
580  ridx = sm.xridx ();
581  cidx = sm.xcidx ();
582  }
583 
584  if (n_row != n_col)
585  err_square_matrix_required ("symamd", "S");
586 
587  // Allocate workspace for symamd
588  OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1);
589  static_assert (COLAMD_STATS <= 40, "symamd: # of COLAMD_STATS exceeded. Please report this to bugs.octave.org");
590  octave::suitesparse_integer stats_storage[COLAMD_STATS];
591  octave::suitesparse_integer *stats = &stats_storage[0];
592  if (! SYMAMD_NAME () (n_col, octave::to_suitesparse_intptr (ridx),
595  knobs, stats, &calloc, &free))
596  {
597  SYMAMD_NAME (_report)(stats);
598 
599  error ("symamd: internal error!");
600  }
601 
602  // column elimination tree post-ordering
603  OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1);
604  symetree (ridx, cidx, etree, perm, n_col);
605 
606  // Calculate the tree post-ordering
607  OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1);
608  tree_postorder (n_col, etree, post);
609 
610  // return the permutation vector
611  NDArray out_perm (dim_vector (1, n_col));
612  for (octave_idx_type i = 0; i < n_col; i++)
613  out_perm(i) = perm[post[i]] + 1;
614 
615  retval(0) = out_perm;
616 
617  // print stats if spumoni > 0
618  if (spumoni > 0)
619  SYMAMD_NAME (_report)(stats);
620 
621  // Return the stats vector
622  if (nargout == 2)
623  {
624  NDArray out_stats (dim_vector (1, COLAMD_STATS));
625  for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++)
626  out_stats(i) = stats[i];
627  retval(1) = out_stats;
628 
629  // fix stats (5) and (6), for 1-based information on
630  // jumbled matrix. note that this correction doesn't
631  // occur if symamd returns FALSE
632  out_stats(COLAMD_INFO1)++;
633  out_stats(COLAMD_INFO2)++;
634  }
635 
636  return retval;
637 
638 #else
639 
640  octave_unused_parameter (args);
641  octave_unused_parameter (nargout);
642 
643  err_disabled_feature ("symamd", "COLAMD");
644 
645 #endif
646 }
647 
648 DEFUN_DLD (etree, args, nargout,
649  doc: /* -*- texinfo -*-
650 @deftypefn {} {@var{p} =} etree (@var{S})
651 @deftypefnx {} {@var{p} =} etree (@var{S}, @var{typ})
652 @deftypefnx {} {[@var{p}, @var{q}] =} etree (@var{S}, @var{typ})
653 
654 Return the elimination tree for the matrix @var{S}.
655 
656 By default @var{S} is assumed to be symmetric and the symmetric elimination
657 tree is returned. The argument @var{typ} controls whether a symmetric or
658 column elimination tree is returned. Valid values of @var{typ} are
659 @qcode{"sym"} or @qcode{"col"}, for symmetric or column elimination tree
660 respectively.
661 
662 Called with a second argument, @code{etree} also returns the postorder
663 permutations on the tree.
664 @end deftypefn */)
665 {
666  int nargin = args.length ();
667 
669  print_usage ();
670 
671  octave_value_list retval (nargout == 2 ? 2 : 1);
672 
673  octave_idx_type n_row = 0;
674  octave_idx_type n_col = 0;
675  octave_idx_type *ridx = nullptr;
676  octave_idx_type *cidx = nullptr;
677 
678  if (args(0).issparse ())
679  error ("etree: S must be a sparse matrix");
680 
681  if (args(0).iscomplex ())
682  {
683  SparseComplexMatrix scm = args(0).sparse_complex_matrix_value ();
684 
685  n_row = scm.rows ();
686  n_col = scm.cols ();
687  ridx = scm.xridx ();
688  cidx = scm.xcidx ();
689  }
690  else
691  {
692  SparseMatrix sm = args(0).sparse_matrix_value ();
693 
694  n_row = sm.rows ();
695  n_col = sm.cols ();
696  ridx = sm.xridx ();
697  cidx = sm.xcidx ();
698  }
699 
700  bool is_sym = true;
701 
702  if (nargin == 2)
703  {
704  std::string str = args(1).xstring_value ("etree: TYP must be a string");
705  if (str.find ('C') == 0 || str.find ('c') == 0)
706  is_sym = false;
707  }
708 
709  // column elimination tree post-ordering (reuse variables)
710  OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1);
711 
712  if (is_sym)
713  {
714  if (n_row != n_col)
715  error ("etree: S is marked as symmetric, but is not square");
716 
717  symetree (ridx, cidx, etree, nullptr, n_col);
718  }
719  else
720  {
721  OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col);
722  OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col);
723 
724  for (octave_idx_type i = 0; i < n_col; i++)
725  {
726  colbeg[i] = cidx[i];
727  colend[i] = cidx[i+1];
728  }
729 
730  coletree (ridx, colbeg, colend, etree, n_row, n_col);
731  }
732 
733  NDArray tree (dim_vector (1, n_col));
734  for (octave_idx_type i = 0; i < n_col; i++)
735  // We flag a root with n_col while Matlab does it with zero
736  // Convert for matlab compatiable output
737  if (etree[i] == n_col)
738  tree(i) = 0;
739  else
740  tree(i) = etree[i] + 1;
741 
742  retval(0) = tree;
743 
744  if (nargout == 2)
745  {
746  // Calculate the tree post-ordering
747  OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1);
748  tree_postorder (n_col, etree, post);
749 
750  NDArray postorder (dim_vector (1, n_col));
751  for (octave_idx_type i = 0; i < n_col; i++)
752  postorder(i) = post[i] + 1;
753 
754  retval(1) = postorder;
755  }
756 
757  return retval;
758 }
OCTINTERP_API void print_usage(void)
Definition: defun.cc:54
for large enough k
Definition: lu.cc:617
void error(const char *fmt,...)
Definition: error.cc:578
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function t
Definition: ov-usr-fcn.cc:997
void err_square_matrix_required(const char *fcn, const char *name)
Definition: errwarn.cc:118
static void coletree(const octave_idx_type *ridx, const octave_idx_type *colbeg, octave_idx_type *colend, octave_idx_type *parent, octave_idx_type nr, octave_idx_type nc)
Definition: colamd.cc:156
s
Definition: file-io.cc:2729
static void tree_postorder(octave_idx_type n, octave_idx_type *parent, octave_idx_type *post)
Definition: colamd.cc:133
static octave_idx_type make_set(octave_idx_type i, octave_idx_type *pp)
Definition: colamd.cc:89
static octave_idx_type link(octave_idx_type s, octave_idx_type t, octave_idx_type *pp)
Definition: colamd.cc:96
octave_idx_type nnz(void) const
Actual number of nonzero terms.
Definition: Sparse.h:240
F77_RET_T const F77_INT F77_CMPLX * A
OCTAVE_EXPORT octave_value_list return the number of command line arguments passed to Octave If called with the optional argument the function xample nargout(@histc)
Definition: ov-usr-fcn.cc:997
int suitesparse_integer
Definition: oct-sparse.h:168
std::complex< double > w(std::complex< double > z, double relerr=0)
std::string str
Definition: hash.cc:118
octave_value retval
Definition: data.cc:6246
octave_idx_type * xridx(void)
Definition: Sparse.h:501
static octave_idx_type find(octave_idx_type i, octave_idx_type *pp)
Definition: colamd.cc:103
octave_idx_type cols(void) const
Definition: Sparse.h:259
#define octave_stdout
Definition: pager.h:174
p
Definition: lu.cc:138
#define OCTAVE_LOCAL_BUFFER(T, buf, size)
Definition: oct-locbuf.h:41
args.length() nargin
Definition: file-io.cc:589
for i
Definition: data.cc:5264
#define DEFUN_DLD(name, args_name, nargout_name, doc)
Macro to define an at run time dynamically loadable builtin function.
Definition: defun-dld.h:58
static void symetree(const octave_idx_type *ridx, const octave_idx_type *cidx, octave_idx_type *Parent, octave_idx_type *P, octave_idx_type n)
Definition: colamd.cc:50
octave_idx_type * xcidx(void)
Definition: Sparse.h:514
octave_idx_type numel(void) const
Number of elements in the array.
Definition: Array.h:366
ColumnVector real(const ComplexColumnVector &a)
Definition: dColVector.cc:135
static octave_idx_type etdfs(octave_idx_type v, octave_idx_type *first_kid, octave_idx_type *next_kid, octave_idx_type *post, octave_idx_type postnum)
Definition: colamd.cc:120
Vector representing the dimensions (size) of an Array.
Definition: dim-vector.h:87
void err_disabled_feature(const std::string &fcn, const std::string &feature, const std::string &pkg)
Definition: errwarn.cc:50
If this string is the system will ring the terminal sometimes it is useful to be able to print the original representation of the string
Definition: utils.cc:888
octave_idx_type rows(void) const
Definition: Sparse.h:258
where the brackets indicate optional arguments and and character or cell array For character arrays the conversion is repeated for every row
Definition: str2double.cc:342
suitesparse_integer * to_suitesparse_intptr(octave_idx_type *i)
Definition: oct-sparse.cc:48