5506
|
1 /* |
|
2 |
7017
|
3 Copyright (C) 2005, 2006, 2007 David Bateman |
7016
|
4 Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Andy Adler |
|
5 |
|
6 This file is part of Octave. |
5506
|
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 the |
7016
|
10 Free Software Foundation; either version 3 of the License, or (at your |
|
11 option) any later version. |
5506
|
12 |
|
13 Octave is distributed in the hope that it will be useful, but WITHOUT |
|
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
16 for more details. |
|
17 |
|
18 You should have received a copy of the GNU General Public License |
7016
|
19 along with Octave; see the file COPYING. If not, see |
|
20 <http://www.gnu.org/licenses/>. |
5506
|
21 |
|
22 */ |
|
23 |
|
24 #ifdef HAVE_CONFIG_H |
|
25 #include <config.h> |
|
26 #endif |
|
27 |
|
28 #include "sparse-base-chol.h" |
|
29 #include "sparse-util.h" |
|
30 #include "lo-error.h" |
|
31 #include "oct-sparse.h" |
|
32 #include "oct-spparms.h" |
|
33 #include "quit.h" |
5785
|
34 #include "MatrixType.h" |
5506
|
35 |
5511
|
36 #ifdef HAVE_CHOLMOD |
5506
|
37 // Can't use CHOLMOD_NAME(drop)(0.0, S, cm). It doesn't treat complex matrices |
|
38 template <class chol_type, class chol_elt, class p_type> |
|
39 void |
|
40 sparse_base_chol<chol_type, chol_elt, p_type>::sparse_base_chol_rep::drop_zeros |
|
41 (const cholmod_sparse* S) |
|
42 { |
|
43 chol_elt sik; |
|
44 octave_idx_type *Sp, *Si; |
|
45 chol_elt *Sx; |
|
46 octave_idx_type pdest, k, ncol, p, pend; |
|
47 |
5518
|
48 if (! S) |
5506
|
49 return; |
|
50 |
|
51 Sp = static_cast<octave_idx_type *>(S->p); |
|
52 Si = static_cast<octave_idx_type *>(S->i); |
|
53 Sx = static_cast<chol_elt *>(S->x); |
|
54 pdest = 0; |
|
55 ncol = S->ncol; |
|
56 |
|
57 for (k = 0; k < ncol; k++) |
|
58 { |
|
59 p = Sp [k]; |
|
60 pend = Sp [k+1]; |
|
61 Sp [k] = pdest; |
|
62 for (; p < pend; p++) |
|
63 { |
|
64 sik = Sx [p]; |
|
65 if (CHOLMOD_IS_NONZERO (sik)) |
|
66 { |
|
67 if (p != pdest) |
|
68 { |
|
69 Si [pdest] = Si [p]; |
|
70 Sx [pdest] = sik; |
|
71 } |
|
72 pdest++; |
|
73 } |
|
74 } |
|
75 } |
|
76 Sp [ncol] = pdest; |
|
77 } |
5511
|
78 #endif |
5506
|
79 |
|
80 template <class chol_type, class chol_elt, class p_type> |
|
81 octave_idx_type |
|
82 sparse_base_chol<chol_type, chol_elt, p_type>::sparse_base_chol_rep::init |
|
83 (const chol_type& a, bool natural) |
|
84 { |
5648
|
85 volatile octave_idx_type info = 0; |
5506
|
86 #ifdef HAVE_CHOLMOD |
|
87 octave_idx_type a_nr = a.rows (); |
|
88 octave_idx_type a_nc = a.cols (); |
|
89 |
|
90 if (a_nr != a_nc) |
|
91 { |
|
92 (*current_liboctave_error_handler) |
|
93 ("SparseCHOL requires square matrix"); |
|
94 return -1; |
|
95 } |
|
96 |
|
97 cholmod_common *cm = &Common; |
|
98 |
|
99 // Setup initial parameters |
|
100 CHOLMOD_NAME(start) (cm); |
5518
|
101 cm->prefer_zomplex = false; |
5506
|
102 |
5893
|
103 double spu = octave_sparse_params::get_key ("spumoni"); |
5506
|
104 if (spu == 0.) |
|
105 { |
|
106 cm->print = -1; |
5518
|
107 cm->print_function = 0; |
5506
|
108 } |
|
109 else |
|
110 { |
5760
|
111 cm->print = static_cast<int> (spu) + 2; |
5506
|
112 cm->print_function =&SparseCholPrint; |
|
113 } |
|
114 |
|
115 cm->error_handler = &SparseCholError; |
|
116 cm->complex_divide = CHOLMOD_NAME(divcomplex); |
|
117 cm->hypotenuse = CHOLMOD_NAME(hypot); |
|
118 |
5518
|
119 cm->final_asis = false; |
|
120 cm->final_super = false; |
|
121 cm->final_ll = true; |
|
122 cm->final_pack = true; |
|
123 cm->final_monotonic = true; |
|
124 cm->final_resymbol = false; |
5506
|
125 |
|
126 cholmod_sparse A; |
|
127 cholmod_sparse *ac = &A; |
|
128 double dummy; |
|
129 ac->nrow = a_nr; |
|
130 ac->ncol = a_nc; |
|
131 |
|
132 ac->p = a.cidx(); |
|
133 ac->i = a.ridx(); |
5604
|
134 ac->nzmax = a.nnz(); |
5518
|
135 ac->packed = true; |
|
136 ac->sorted = true; |
|
137 ac->nz = 0; |
5506
|
138 #ifdef IDX_TYPE_LONG |
|
139 ac->itype = CHOLMOD_LONG; |
|
140 #else |
|
141 ac->itype = CHOLMOD_INT; |
|
142 #endif |
|
143 ac->dtype = CHOLMOD_DOUBLE; |
|
144 ac->stype = 1; |
|
145 #ifdef OCTAVE_CHOLMOD_TYPE |
|
146 ac->xtype = OCTAVE_CHOLMOD_TYPE; |
|
147 #else |
|
148 ac->xtype = CHOLMOD_REAL; |
|
149 #endif |
|
150 |
|
151 if (a_nr < 1) |
|
152 ac->x = &dummy; |
|
153 else |
|
154 ac->x = a.data(); |
|
155 |
|
156 // use natural ordering if no q output parameter |
|
157 if (natural) |
|
158 { |
|
159 cm->nmethods = 1 ; |
|
160 cm->method [0].ordering = CHOLMOD_NATURAL ; |
5518
|
161 cm->postorder = false ; |
5506
|
162 } |
|
163 |
|
164 cholmod_factor *Lfactor; |
|
165 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
166 Lfactor = CHOLMOD_NAME(analyze) (ac, cm); |
|
167 CHOLMOD_NAME(factorize) (ac, Lfactor, cm); |
|
168 cond = CHOLMOD_NAME(rcond) (Lfactor, cm); |
|
169 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
170 |
|
171 minor_p = Lfactor->minor; |
|
172 is_pd = cm->status == CHOLMOD_OK; |
|
173 info = (is_pd ? 0 : cm->status); |
|
174 |
|
175 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
176 Lsparse = CHOLMOD_NAME(factor_to_sparse) (Lfactor, cm); |
|
177 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
178 |
|
179 if (minor_p > 0 && minor_p < a_nr) |
|
180 { |
|
181 size_t n1 = a_nr + 1; |
|
182 Lsparse->p = CHOLMOD_NAME(realloc) (minor_p+1, sizeof(octave_idx_type), |
|
183 Lsparse->p, &n1, cm); |
|
184 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
185 CHOLMOD_NAME(reallocate_sparse) |
|
186 (static_cast<octave_idx_type *>(Lsparse->p)[minor_p], Lsparse, cm); |
|
187 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
188 Lsparse->ncol = minor_p; |
|
189 } |
|
190 |
|
191 drop_zeros (Lsparse); |
|
192 |
|
193 if (! natural) |
|
194 { |
|
195 perms.resize (a_nr); |
|
196 for (octave_idx_type i = 0; i < a_nr; i++) |
|
197 perms(i) = static_cast<octave_idx_type *>(Lfactor->Perm)[i]; |
|
198 } |
|
199 |
6482
|
200 static char tmp[] = " "; |
|
201 |
5506
|
202 BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
203 CHOLMOD_NAME(free_factor) (&Lfactor, cm); |
|
204 CHOLMOD_NAME(finish) (cm); |
6482
|
205 CHOLMOD_NAME(print_common) (tmp, cm); |
5506
|
206 END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; |
|
207 #else |
|
208 (*current_liboctave_error_handler) |
|
209 ("Missing CHOLMOD. Sparse cholesky factorization disabled"); |
|
210 #endif |
|
211 return info; |
|
212 } |
|
213 |
|
214 template <class chol_type, class chol_elt, class p_type> |
|
215 chol_type |
|
216 sparse_base_chol<chol_type, chol_elt, p_type>::L (void) const |
|
217 { |
|
218 #ifdef HAVE_CHOLMOD |
|
219 cholmod_sparse *m = rep->L(); |
|
220 octave_idx_type nc = m->ncol; |
|
221 octave_idx_type nnz = m->nzmax; |
|
222 chol_type ret (m->nrow, nc, nnz); |
|
223 for (octave_idx_type j = 0; j < nc+1; j++) |
|
224 ret.xcidx(j) = static_cast<octave_idx_type *>(m->p)[j]; |
|
225 for (octave_idx_type i = 0; i < nnz; i++) |
|
226 { |
|
227 ret.xridx(i) = static_cast<octave_idx_type *>(m->i)[i]; |
|
228 ret.xdata(i) = static_cast<chol_elt *>(m->x)[i]; |
|
229 } |
|
230 return ret; |
|
231 #else |
|
232 return chol_type(); |
|
233 #endif |
|
234 } |
|
235 |
|
236 template <class chol_type, class chol_elt, class p_type> |
|
237 p_type |
|
238 sparse_base_chol<chol_type, chol_elt, p_type>:: |
|
239 sparse_base_chol_rep::Q (void) const |
|
240 { |
|
241 #ifdef HAVE_CHOLMOD |
|
242 octave_idx_type n = Lsparse->nrow; |
|
243 p_type p (n, n, n); |
|
244 |
|
245 for (octave_idx_type i = 0; i < n; i++) |
|
246 { |
|
247 p.xcidx(i) = i; |
6148
|
248 p.xridx(i) = static_cast<octave_idx_type>(perms(i)); |
5506
|
249 p.xdata(i) = 1; |
|
250 } |
|
251 p.xcidx(n) = n; |
|
252 |
|
253 return p; |
|
254 #else |
|
255 return p_type(); |
|
256 #endif |
|
257 } |
|
258 |
|
259 template <class chol_type, class chol_elt, class p_type> |
|
260 chol_type |
|
261 sparse_base_chol<chol_type, chol_elt, p_type>::inverse (void) const |
|
262 { |
|
263 chol_type retval; |
|
264 #ifdef HAVE_CHOLMOD |
|
265 cholmod_sparse *m = rep->L(); |
|
266 octave_idx_type n = m->ncol; |
|
267 ColumnVector perms = rep->perm(); |
|
268 chol_type ret; |
|
269 double rcond2; |
|
270 octave_idx_type info; |
5785
|
271 MatrixType mattype (MatrixType::Upper); |
5506
|
272 chol_type linv = L().transpose().inverse(mattype, info, rcond2, 1, 0); |
|
273 |
|
274 if (perms.length() == n) |
|
275 { |
|
276 p_type Qc = Q(); |
|
277 retval = Qc * linv.transpose() * linv * Qc.transpose(); |
|
278 } |
|
279 else |
|
280 retval = linv.transpose() * linv; |
|
281 #endif |
|
282 return retval; |
|
283 } |
|
284 |
|
285 /* |
|
286 ;;; Local Variables: *** |
|
287 ;;; mode: C++ *** |
|
288 ;;; End: *** |
|
289 */ |