1 | /*************************************************************************
|
---|
2 | This file is a part of ALGLIB project.
|
---|
3 |
|
---|
4 | >>> SOURCE LICENSE >>>
|
---|
5 | This program is free software; you can redistribute it and/or modify
|
---|
6 | it under the terms of the GNU General Public License as published by
|
---|
7 | the Free Software Foundation (www.fsf.org); either version 2 of the
|
---|
8 | License, or (at your option) any later version.
|
---|
9 |
|
---|
10 | This program is distributed in the hope that it will be useful,
|
---|
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
13 | GNU General Public License for more details.
|
---|
14 |
|
---|
15 | A copy of the GNU General Public License is available at
|
---|
16 | http://www.fsf.org/licensing/licenses
|
---|
17 |
|
---|
18 | >>> END OF LICENSE >>>
|
---|
19 | *************************************************************************/
|
---|
20 |
|
---|
21 | using System;
|
---|
22 |
|
---|
23 | namespace alglib
|
---|
24 | {
|
---|
25 | public class ctrlinsolve
|
---|
26 | {
|
---|
27 | /*************************************************************************
|
---|
28 | Utility subroutine performing the "safe" solution of a system of linear
|
---|
29 | equations with triangular complex coefficient matrices.
|
---|
30 |
|
---|
31 | The feature of an algorithm is that it could not cause an overflow or a
|
---|
32 | division by zero regardless of the matrix used as the input. If an overflow
|
---|
33 | is possible, an error code is returned.
|
---|
34 |
|
---|
35 | The algorithm can solve systems of equations with upper/lower triangular
|
---|
36 | matrices, with/without unit diagonal, and systems of types A*x=b, A^T*x=b,
|
---|
37 | A^H*x=b.
|
---|
38 |
|
---|
39 | Input parameters:
|
---|
40 | A - system matrix.
|
---|
41 | Array whose indexes range within [1..N, 1..N].
|
---|
42 | N - size of matrix A.
|
---|
43 | X - right-hand member of a system.
|
---|
44 | Array whose index ranges within [1..N].
|
---|
45 | IsUpper - matrix type. If it is True, the system matrix is the upper
|
---|
46 | triangular matrix and is located in the corresponding part
|
---|
47 | of matrix A.
|
---|
48 | Trans - problem type.
|
---|
49 | If Trans is:
|
---|
50 | * 0, A*x=b
|
---|
51 | * 1, A^T*x=b
|
---|
52 | * 2, A^H*x=b
|
---|
53 | Isunit - matrix type. If it is True, the system matrix has a unit
|
---|
54 | diagonal (the elements on the main diagonal are not used
|
---|
55 | in the calculation process), otherwise the matrix is
|
---|
56 | considered to be a general triangular matrix.
|
---|
57 | CNORM - array which is stored in norms of rows and columns of the
|
---|
58 | matrix. If the array hasn't been filled up during previous
|
---|
59 | executions of an algorithm with the same matrix as the
|
---|
60 | input, it will be filled up by the subroutine. If the
|
---|
61 | array is filled up, the subroutine uses it without filling
|
---|
62 | it up again.
|
---|
63 | NORMIN - flag defining the state of column norms array. If True, the
|
---|
64 | array is filled up.
|
---|
65 | WORKA - working array whose index ranges within [1..N].
|
---|
66 | WORKX - working array whose index ranges within [1..N].
|
---|
67 |
|
---|
68 | Output parameters (if the result is True):
|
---|
69 | X - solution. Array whose index ranges within [1..N].
|
---|
70 | CNORM - array of column norms whose index ranges within [1..N].
|
---|
71 |
|
---|
72 | Result:
|
---|
73 | True, if the matrix is not singular and the algorithm finished its
|
---|
74 | work correctly without causing an overflow.
|
---|
75 | False, if the matrix is singular or the algorithm was cancelled
|
---|
76 | because of an overflow possibility.
|
---|
77 |
|
---|
78 | Note:
|
---|
79 | The disadvantage of an algorithm is that sometimes it overestimates
|
---|
80 | an overflow probability. This is not a problem when solving ordinary
|
---|
81 | systems. If the elements of the matrix used as the input are close to
|
---|
82 | MaxRealNumber, a false overflow detection is possible, but in practice
|
---|
83 | such matrices can rarely be found.
|
---|
84 | You can find more reliable subroutines in the LAPACK library
|
---|
85 | (xLATRS subroutine ).
|
---|
86 |
|
---|
87 | -- ALGLIB --
|
---|
88 | Copyright 31.03.2006 by Bochkanov Sergey
|
---|
89 | *************************************************************************/
|
---|
90 | public static bool complexsafesolvetriangular(ref AP.Complex[,] a,
|
---|
91 | int n,
|
---|
92 | ref AP.Complex[] x,
|
---|
93 | bool isupper,
|
---|
94 | int trans,
|
---|
95 | bool isunit,
|
---|
96 | ref AP.Complex[] worka,
|
---|
97 | ref AP.Complex[] workx)
|
---|
98 | {
|
---|
99 | bool result = new bool();
|
---|
100 | int i = 0;
|
---|
101 | int l = 0;
|
---|
102 | int j = 0;
|
---|
103 | bool dolswp = new bool();
|
---|
104 | double ma = 0;
|
---|
105 | double mx = 0;
|
---|
106 | double v = 0;
|
---|
107 | AP.Complex t = 0;
|
---|
108 | AP.Complex r = 0;
|
---|
109 | int i_ = 0;
|
---|
110 | int i1_ = 0;
|
---|
111 |
|
---|
112 | System.Diagnostics.Debug.Assert(trans>=0 & trans<=2, "ComplexSafeSolveTriangular: incorrect parameters!");
|
---|
113 | result = true;
|
---|
114 |
|
---|
115 | //
|
---|
116 | // Quick return if possible
|
---|
117 | //
|
---|
118 | if( n<=0 )
|
---|
119 | {
|
---|
120 | return result;
|
---|
121 | }
|
---|
122 |
|
---|
123 | //
|
---|
124 | // Main cycle
|
---|
125 | //
|
---|
126 | for(l=1; l<=n; l++)
|
---|
127 | {
|
---|
128 |
|
---|
129 | //
|
---|
130 | // Prepare subtask L
|
---|
131 | //
|
---|
132 | dolswp = false;
|
---|
133 | if( trans==0 )
|
---|
134 | {
|
---|
135 | if( isupper )
|
---|
136 | {
|
---|
137 | i = n+1-l;
|
---|
138 | i1_ = (i) - (1);
|
---|
139 | for(i_=1; i_<=l;i_++)
|
---|
140 | {
|
---|
141 | worka[i_] = a[i,i_+i1_];
|
---|
142 | }
|
---|
143 | i1_ = (i) - (1);
|
---|
144 | for(i_=1; i_<=l;i_++)
|
---|
145 | {
|
---|
146 | workx[i_] = x[i_+i1_];
|
---|
147 | }
|
---|
148 | dolswp = true;
|
---|
149 | }
|
---|
150 | if( !isupper )
|
---|
151 | {
|
---|
152 | i = l;
|
---|
153 | for(i_=1; i_<=l;i_++)
|
---|
154 | {
|
---|
155 | worka[i_] = a[i,i_];
|
---|
156 | }
|
---|
157 | for(i_=1; i_<=l;i_++)
|
---|
158 | {
|
---|
159 | workx[i_] = x[i_];
|
---|
160 | }
|
---|
161 | }
|
---|
162 | }
|
---|
163 | if( trans==1 )
|
---|
164 | {
|
---|
165 | if( isupper )
|
---|
166 | {
|
---|
167 | i = l;
|
---|
168 | for(i_=1; i_<=l;i_++)
|
---|
169 | {
|
---|
170 | worka[i_] = a[i_,i];
|
---|
171 | }
|
---|
172 | for(i_=1; i_<=l;i_++)
|
---|
173 | {
|
---|
174 | workx[i_] = x[i_];
|
---|
175 | }
|
---|
176 | }
|
---|
177 | if( !isupper )
|
---|
178 | {
|
---|
179 | i = n+1-l;
|
---|
180 | i1_ = (i) - (1);
|
---|
181 | for(i_=1; i_<=l;i_++)
|
---|
182 | {
|
---|
183 | worka[i_] = a[i_+i1_,i];
|
---|
184 | }
|
---|
185 | i1_ = (i) - (1);
|
---|
186 | for(i_=1; i_<=l;i_++)
|
---|
187 | {
|
---|
188 | workx[i_] = x[i_+i1_];
|
---|
189 | }
|
---|
190 | dolswp = true;
|
---|
191 | }
|
---|
192 | }
|
---|
193 | if( trans==2 )
|
---|
194 | {
|
---|
195 | if( isupper )
|
---|
196 | {
|
---|
197 | i = l;
|
---|
198 | for(i_=1; i_<=l;i_++)
|
---|
199 | {
|
---|
200 | worka[i_] = AP.Math.Conj(a[i_,i]);
|
---|
201 | }
|
---|
202 | for(i_=1; i_<=l;i_++)
|
---|
203 | {
|
---|
204 | workx[i_] = x[i_];
|
---|
205 | }
|
---|
206 | }
|
---|
207 | if( !isupper )
|
---|
208 | {
|
---|
209 | i = n+1-l;
|
---|
210 | i1_ = (i) - (1);
|
---|
211 | for(i_=1; i_<=l;i_++)
|
---|
212 | {
|
---|
213 | worka[i_] = AP.Math.Conj(a[i_+i1_,i]);
|
---|
214 | }
|
---|
215 | i1_ = (i) - (1);
|
---|
216 | for(i_=1; i_<=l;i_++)
|
---|
217 | {
|
---|
218 | workx[i_] = x[i_+i1_];
|
---|
219 | }
|
---|
220 | dolswp = true;
|
---|
221 | }
|
---|
222 | }
|
---|
223 | if( dolswp )
|
---|
224 | {
|
---|
225 | t = workx[l];
|
---|
226 | workx[l] = workx[1];
|
---|
227 | workx[1] = t;
|
---|
228 | t = worka[l];
|
---|
229 | worka[l] = worka[1];
|
---|
230 | worka[1] = t;
|
---|
231 | }
|
---|
232 | if( isunit )
|
---|
233 | {
|
---|
234 | worka[l] = 1;
|
---|
235 | }
|
---|
236 |
|
---|
237 | //
|
---|
238 | // Test if workA[L]=0
|
---|
239 | //
|
---|
240 | if( worka[l]==0 )
|
---|
241 | {
|
---|
242 | result = false;
|
---|
243 | return result;
|
---|
244 | }
|
---|
245 |
|
---|
246 | //
|
---|
247 | // Now we have:
|
---|
248 | //
|
---|
249 | // workA[1:L]*workX[1:L] = b[I]
|
---|
250 | //
|
---|
251 | // with known workA[1:L] and workX[1:L-1]
|
---|
252 | // and unknown workX[L]
|
---|
253 | //
|
---|
254 | t = 0;
|
---|
255 | if( l>=2 )
|
---|
256 | {
|
---|
257 | ma = 0;
|
---|
258 | for(j=1; j<=l-1; j++)
|
---|
259 | {
|
---|
260 | ma = Math.Max(ma, AP.Math.AbsComplex(worka[j]));
|
---|
261 | }
|
---|
262 | mx = 0;
|
---|
263 | for(j=1; j<=l-1; j++)
|
---|
264 | {
|
---|
265 | mx = Math.Max(mx, AP.Math.AbsComplex(workx[j]));
|
---|
266 | }
|
---|
267 | if( (double)(Math.Max(ma, mx))>(double)(1) )
|
---|
268 | {
|
---|
269 | v = AP.Math.MaxRealNumber/Math.Max(ma, mx);
|
---|
270 | v = v/(l-1);
|
---|
271 | if( (double)(v)<(double)(Math.Min(ma, mx)) )
|
---|
272 | {
|
---|
273 | result = false;
|
---|
274 | return result;
|
---|
275 | }
|
---|
276 | }
|
---|
277 | t = 0.0;
|
---|
278 | for(i_=1; i_<=l-1;i_++)
|
---|
279 | {
|
---|
280 | t += worka[i_]*workx[i_];
|
---|
281 | }
|
---|
282 | }
|
---|
283 |
|
---|
284 | //
|
---|
285 | // Now we have:
|
---|
286 | //
|
---|
287 | // workA[L]*workX[L] + T = b[I]
|
---|
288 | //
|
---|
289 | if( (double)(Math.Max(AP.Math.AbsComplex(t), AP.Math.AbsComplex(x[i])))>=(double)(0.5*AP.Math.MaxRealNumber) )
|
---|
290 | {
|
---|
291 | result = false;
|
---|
292 | return result;
|
---|
293 | }
|
---|
294 | r = x[i]-t;
|
---|
295 |
|
---|
296 | //
|
---|
297 | // Now we have:
|
---|
298 | //
|
---|
299 | // workA[L]*workX[L] = R
|
---|
300 | //
|
---|
301 | if( r!=0 )
|
---|
302 | {
|
---|
303 | if( (double)(Math.Log(AP.Math.AbsComplex(r))-Math.Log(AP.Math.AbsComplex(worka[l])))>=(double)(Math.Log(AP.Math.MaxRealNumber)) )
|
---|
304 | {
|
---|
305 | result = false;
|
---|
306 | return result;
|
---|
307 | }
|
---|
308 | }
|
---|
309 |
|
---|
310 | //
|
---|
311 | // X[I]
|
---|
312 | //
|
---|
313 | x[i] = r/worka[l];
|
---|
314 | }
|
---|
315 | return result;
|
---|
316 | }
|
---|
317 | }
|
---|
318 | }
|
---|