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