7189
|
1 ## Copyright (C) 2007, Regents of the University of California |
|
2 ## |
|
3 ## This file is part of Octave. |
|
4 ## |
|
5 ## Octave is free software; you can redistribute it and/or modify it |
|
6 ## under the terms of the GNU General Public License as published by |
|
7 ## the Free Software Foundation; either version 3 of the License, or (at |
|
8 ## your option) any later version. |
|
9 ## |
|
10 ## Octave is distributed in the hope that it will be useful, but |
|
11 ## WITHOUT ANY WARRANTY; without even the implied warranty of |
|
12 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
13 ## General Public License for more details. |
|
14 ## |
|
15 ## You should have received a copy of the GNU General Public License |
|
16 ## along with Octave; see the file COPYING. If not, see |
|
17 ## <http://www.gnu.org/licenses/>. |
|
18 |
|
19 ## -*- texinfo -*- |
|
20 ## @deftypefn {Function File} {[@var{est}, @var{v}, @var{w}, @var{iter}] =} onenormest (@var{A}, @var{t}) |
|
21 ## @deftypefnx {Function File} {[@var{est}, @var{v}, @var{w}, @var{iter}] =} onenormest (@var{apply}, @var{apply_t}, @var{n}, @var{t}) |
|
22 ## |
|
23 ## Apply Higham and Tisseur's randomized block 1-norm estimator to |
|
24 ## matrix @var{A} using @var{t} test vectors. If @var{t} exceeds 5, then |
|
25 ## only 5 test vectors are used. |
|
26 ## |
|
27 ## If the matrix is not explicit, e.g. when estimating the norm of |
|
28 ## @code{inv (@var{A})} given an LU factorization, @code{onenormest} applies |
|
29 ## @var{A} and its conjugate transpose through a pair of functions |
|
30 ## @var{apply} and @var{apply_t}, respectively, to a dense matrix of size |
|
31 ## @var{n} by @var{t}. The implicit version requires an explicit dimension |
|
32 ## @var{n}. |
|
33 ## |
|
34 ## Returns the norm estimate @var{est}, two vectors @var{v} and |
|
35 ## @var{w} related by norm |
|
36 ## @code{(@var{w}, 1) = @var{est} * norm (@var{v}, 1)}, |
|
37 ## and the number of iterations @var{iter}. The number of |
|
38 ## iterations is limited to 10 and is at least 2. |
|
39 ## |
|
40 ## References: |
|
41 ## @itemize |
|
42 ## @item Nicholas J. Higham and Françoise Tisseur, "A Block Algorithm |
|
43 ## for Matrix 1-Norm Estimation, with an Application to 1-Norm |
|
44 ## Pseudospectra." SIMAX vol 21, no 4, pp 1185-1201. |
|
45 ## @url{http://dx.doi.org/10.1137/S0895479899356080} |
|
46 ## @item Nicholas J. Higham and Françoise Tisseur, "A Block Algorithm |
|
47 ## for Matrix 1-Norm Estimation, with an Application to 1-Norm |
|
48 ## Pseudospectra." @url{http://citeseer.ist.psu.edu/223007.html} |
|
49 ## @end itemize |
|
50 ## |
|
51 ## @seealso{condest, norm, cond} |
|
52 ## @end deftypefn |
|
53 |
|
54 ## Code originally licensed under |
|
55 ## |
|
56 ## Copyright (c) 2007, Regents of the University of California |
|
57 ## All rights reserved. |
|
58 ## Redistribution and use in source and binary forms, with or without |
|
59 ## modification, are permitted provided that the following conditions are met: |
|
60 ## |
|
61 ## * Redistributions of source code must retain the above copyright |
|
62 ## notice, this list of conditions and the following disclaimer. |
|
63 ## * Redistributions in binary form must reproduce the above copyright |
|
64 ## notice, this list of conditions and the following disclaimer in the |
|
65 ## documentation and/or other materials provided with the distribution. |
|
66 ## * Neither the name of the University of California, Berkeley nor the |
|
67 ## names of its contributors may be used to endorse or promote products |
|
68 ## derived from this software without specific prior written permission. |
|
69 ## |
|
70 ## THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY |
|
71 ## EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
|
72 ## WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE |
|
73 ## DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR |
|
74 ## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
75 ## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
|
76 ## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
|
77 ## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
78 ## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
79 ## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
|
80 ## SUCH DAMAGE. |
|
81 ## |
|
82 ## Relicensed to GPL for inclusion in Octave. |
|
83 |
|
84 ## Author: Jason Riedy <ejr@cs.berkeley.edu> |
|
85 ## Keywords: linear-algebra norm estimation |
|
86 ## Version: 0.2 |
|
87 |
|
88 function [est, v, w, iter] = onenormest (varargin) |
|
89 |
|
90 if (size (varargin, 2) < 1 || size (varargin, 2) > 4) |
|
91 print_usage (); |
|
92 endif |
|
93 |
|
94 default_t = 5; |
|
95 itmax = 10; |
|
96 |
|
97 if (ismatrix (varargin{1})) |
|
98 n = size (varargin{1}, 1); |
|
99 if n != size (varargin{1}, 2), |
|
100 error ("onenormest: matrix must be square."); |
|
101 endif |
|
102 apply = @(x) varargin{1} * x; |
|
103 apply_t = @(x) varargin{1}' * x; |
|
104 if (size (varargin) > 1) |
|
105 t = varargin{2}; |
|
106 else |
|
107 t = min (n, default_t); |
|
108 endif |
|
109 else |
|
110 if (size (varargin, 2) < 3) |
|
111 print_usage(); |
|
112 endif |
|
113 n = varargin{3}; |
|
114 apply = varargin{1}; |
|
115 apply_t = varargin{2}; |
|
116 if (size (varargin) > 3) |
|
117 t = varargin{4}; |
|
118 else |
|
119 t = default_t; |
|
120 endif |
|
121 endif |
|
122 |
|
123 ## Initial test vectors X. |
|
124 X = rand (n, t); |
|
125 X = X ./ (ones (n,1) * sum (abs (X), 1)); |
|
126 |
|
127 been_there = zeros (n, 1); # Track if a vertex has been visited. |
|
128 est_old = 0; # To check if the estimate has increased. |
|
129 S = zeros (n, t); # Normalized vector of signs. The normalization is |
|
130 |
|
131 for iter = 1 : itmax + 1 |
|
132 Y = feval (apply, X); |
|
133 |
|
134 ## Find the initial estimate as the largest A*x. |
|
135 [est, ind_best] = max (sum (abs (Y), 1)); |
|
136 if (est > est_old || iter == 2) |
|
137 w = Y(:,ind_best); |
|
138 endif |
|
139 if (iter >= 2 && est < est_old) |
|
140 ## No improvement, so stop. |
|
141 est = est_old; |
|
142 break; |
|
143 endif |
|
144 |
|
145 est_old = est; |
|
146 S_old = S; |
|
147 if (iter > itmax), |
|
148 ## Gone too far. Stop. |
|
149 break; |
|
150 endif |
|
151 |
|
152 S = sign (Y); |
|
153 |
|
154 ## Test if any of S are approximately parallel to previous S |
|
155 ## vectors or current S vectors. If everything is parallel, |
|
156 ## stop. Otherwise, replace any parallel vectors with |
|
157 ## rand{-1,+1}. |
|
158 partest = any (abs (S_old' * S - n) < 4*eps*n); |
|
159 if (all (partest)) |
|
160 ## All the current vectors are parallel to old vectors. |
|
161 ## We've hit a cycle, so stop. |
|
162 break; |
|
163 endif |
|
164 if (any (partest)) |
|
165 ## Some vectors are parallel to old ones and are cycling, |
|
166 ## but not all of them. Replace the parallel vectors with |
|
167 ## rand{-1,+1}. |
|
168 numpar = sum (partest); |
|
169 replacements = 2*(rand (n,numpar) < 0.5) - 1; |
|
170 S(:,partest) = replacements; |
|
171 endif |
|
172 ## Now test for parallel vectors within S. |
|
173 partest = any ( (S' * S - eye (t)) == n ); |
|
174 if (any (partest)) |
|
175 numpar = sum (partest); |
|
176 replacements = 2*(rand (n,numpar) < 0.5) - 1; |
|
177 S(:,partest) = replacements; |
|
178 endif |
|
179 |
|
180 Z = feval (apply_t, S); |
|
181 |
|
182 ## Now find the largest non-previously-visted index per |
|
183 ## vector. |
|
184 h = max (abs (Z),2); |
|
185 [mh, mhi] = max (h); |
|
186 if (iter >= 2 && mhi == ind_best) |
|
187 ## Hit a cycle, stop. |
|
188 break; |
|
189 endif |
|
190 [h, ind] = sort (h, 'descend'); |
|
191 if (t > 1) |
|
192 firstind = ind(1:t); |
|
193 if (all (been_there(firstind))) |
|
194 ## Visited all these before, so stop. |
|
195 break; |
|
196 endif |
|
197 ind = ind (!been_there (ind)); |
|
198 if (length (ind) < t) |
|
199 ## There aren't enough new vectors, so we're practically |
|
200 ## in a cycle. Stop. |
|
201 break; |
|
202 endif |
|
203 endif |
|
204 |
|
205 ## Visit the new indices. |
|
206 X = zeros (n, t); |
|
207 for zz = 1 : t |
|
208 X(ind(zz),zz) = 1; |
|
209 endfor |
|
210 been_there (ind (1 : t)) = 1; |
|
211 endfor |
|
212 |
|
213 ## The estimate est and vector w are set in the loop above. The |
|
214 ## vector v selects the ind_best column of A. |
|
215 v = zeros (n, 1); |
|
216 v(ind_best) = 1; |
|
217 endfunction |
|
218 |
|
219 %!demo |
|
220 %! N = 100; |
|
221 %! A = randn(N) + eye(N); |
|
222 %! [L,U,P] = lu(A); |
|
223 %! nm1inv = onenormest(@(x) U\(L\(P*x)), @(x) P'*(L'\(U'\x)), N, 30) |
|
224 %! norm(inv(A), 1) |
|
225 |
|
226 %!test |
|
227 %! N = 10; |
|
228 %! A = ones (N); |
|
229 %! [nm1, v1, w1] = onenormest (A); |
|
230 %! [nminf, vinf, winf] = onenormest (A', 6); |
|
231 %! assert (nm1, N, -2*eps); |
|
232 %! assert (nminf, N, -2*eps); |
|
233 %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) |
|
234 %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) |
|
235 |
|
236 %!test |
|
237 %! N = 10; |
|
238 %! A = ones (N); |
|
239 %! [nm1, v1, w1] = onenormest (@(x) A*x, @(x) A'*x, N, 3); |
|
240 %! [nminf, vinf, winf] = onenormest (@(x) A'*x, @(x) A*x, N, 3); |
|
241 %! assert (nm1, N, -2*eps); |
|
242 %! assert (nminf, N, -2*eps); |
|
243 %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) |
|
244 %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) |
|
245 |
|
246 %!test |
|
247 %! N = 5; |
|
248 %! A = hilb (N); |
|
249 %! [nm1, v1, w1] = onenormest (A); |
|
250 %! [nminf, vinf, winf] = onenormest (A', 6); |
|
251 %! assert (nm1, norm (A, 1), -2*eps); |
|
252 %! assert (nminf, norm (A, inf), -2*eps); |
|
253 %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) |
|
254 %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) |
|
255 |
|
256 ## Only likely to be within a factor of 10. |
|
257 %!test |
|
258 %! N = 100; |
|
259 %! A = rand (N); |
|
260 %! [nm1, v1, w1] = onenormest (A); |
|
261 %! [nminf, vinf, winf] = onenormest (A', 6); |
|
262 %! assert (nm1, norm (A, 1), -.1); |
|
263 %! assert (nminf, norm (A, inf), -.1); |
|
264 %! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) |
|
265 %! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) |