]> Creatis software - CreaPhase.git/blob - octave_packages/optim-1.2.0/polyfitinf.m
Add a useful package (from Source forge) for octave
[CreaPhase.git] / octave_packages / optim-1.2.0 / polyfitinf.m
1 ## Copyright (c) 1998-2011 Andrew V. Knyazev <andrew.knyazev@ucdenver.edu>
2 ## All rights reserved.
3 ##
4 ## Redistribution and use in source and binary forms, with or without",
5 ## modification, are permitted provided that the following conditions are met:
6 ##
7 ##     1 Redistributions of source code must retain the above copyright notice,
8 ##       this list of conditions and the following disclaimer.
9 ##     2 Redistributions in binary form must reproduce the above copyright
10 ##       notice, this list of conditions and the following disclaimer in the
11 ##       documentation and/or other materials provided with the distribution.
12 ##     3 Neither the name of the author nor the names of its contributors may be
13 ##       used to endorse or promote products derived from this software without
14 ##       specific prior written permission.
15 ##
16 ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS''
17 ## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18 ## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 ## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR
20 ## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21 ## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
22 ## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
23 ## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
24 ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
25 ## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26
27 % function [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT,REF0)
28 %
29 %   Best polynomial approximation in discrete uniform norm
30 %
31 %   INPUT VARIABLES:
32 %
33 %   M       : degree of the fitting polynomial
34 %   N       : number of data points
35 %   X(N)    : x-coordinates of data points
36 %   Y(N)    : y-coordinates of data points
37 %   K       : character of the polynomial:
38 %                   K = 0 : mixed parity polynomial
39 %                   K = 1 : odd polynomial  ( X(1) must be >  0 )
40 %                   K = 2 : even polynomial ( X(1) must be >= 0 )
41 %   EPSH    : tolerance for leveling. A useful value for 24-bit
42 %             mantissa is EPSH = 2.0E-7
43 %   MAXIT   : upper limit for number of exchange steps
44 %   REF0(M2): initial alternating set ( N-vector ). This is an
45 %             OPTIONAL argument. The length M2 is given by:
46 %                   M2 = M + 2                      , if K = 0
47 %                   M2 = integer part of (M+3)/2    , if K = 1
48 %                   M2 = 2 + M/2 (M must be even)   , if K = 2
49 %
50 %   OUTPUT VARIABLES:
51 %
52 %   A       : polynomial coefficients of the best approximation
53 %             in order of increasing powers:
54 %                   p*(x) = A(1) + A(2)*x + A(3)*x^2 + ...
55 %   REF     : selected alternating set of points
56 %   HMAX    : maximum deviation ( uniform norm of p* - f )
57 %   H       : pointwise approximation errors
58 %       R               : total number of iterations
59 %   EQUAL   : success of failure of algorithm
60 %                   EQUAL=1 :  succesful
61 %                   EQUAL=0 :  convergence not acheived
62 %                   EQUAL=-1:  input error
63 %                   EQUAL=-2:  algorithm failure
64 %
65 %   Relies on function EXCH, provided below.
66 %
67 %   Example: 
68 %   M = 5; N = 10000; K = 0; EPSH = 10^-12; MAXIT = 10;
69 %   X = linspace(-1,1,N);   % uniformly spaced nodes on [-1,1]
70 %   k=1; Y = abs(X).^k;     % the function Y to approximate
71 %   [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT);
72 %   p = polyval(A,X); plot(X,Y,X,p) % p is the best approximation
73 %
74 %   Note: using an even value of M, e.g., M=2, in the example above, makes
75 %   the algorithm to fail with EQUAL=-2, because of collocation, which
76 %   appears because both the appriximating function and the polynomial are
77 %   even functions. The way aroung it is to approximate only the right half
78 %   of the function, setting K = 2 : even polynomial. For example: 
79 %
80 % N = 10000; K = 2; EPSH = 10^-12; MAXIT = 10;  X = linspace(0,1,N);
81 % for i = 1:2
82 %     k = 2*i-1; Y = abs(X).^k;
83 %     for j = 1:4
84 %         M = 2^j;
85 %         [~,~,HMAX] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT);
86 %         approxerror(i,j) = HMAX;
87 %     end
88 % end
89 % disp('Table 3.1 from Approximation theory and methods, M.J.D.POWELL, p. 27');
90 % disp(' ');
91 % disp('            n          K=1          K=3'); 
92 % disp(' '); format short g;
93 % disp([(2.^(1:4))' approxerror']);
94 %
95 %   ALGORITHM:
96 %
97 %   Computation of the polynomial that best approximates the data (X,Y)
98 %   in the discrete uniform norm, i.e. the polynomial with the  minimum
99 %   value of max{ | p(x_i) - y_i | , x_i in X } . That polynomial, also
100 %   known as minimax polynomial, is obtained by the exchange algorithm,
101 %   a finite iterative process requiring, at most,
102 %      n
103 %    (   ) iterations ( usually p = M + 2. See also function EXCH ).
104 %      p
105 %   since this number can be very large , the routine  may not converge
106 %   within MAXIT iterations . The  other possibility of  failure occurs
107 %   when there is insufficient floating point precision  for  the input
108 %   data chosen.
109 %
110 %   CREDITS: This routine was developed and modified as 
111 %   computer assignments in Approximation Theory courses by 
112 %   Prof. Andrew Knyazev, University of Colorado Denver, USA.
113 %
114 %   Team Fall 98 (Revision 1.0):
115 %           Chanchai Aniwathananon
116 %           Crhistopher Mehl
117 %           David A. Duran
118 %           Saulo P. Oliveira
119 %
120 %   Team Spring 11 (Revision 1.1): Manuchehr Aminian
121 %
122 %   The algorithm and the comments are based on a FORTRAN code written
123 %   by Joseph C. Simpson. The code is available on Netlib repository:
124 %   http://www.netlib.org/toms/501
125 %   See also: Communications of the ACM, V14, pp.355-356(1971)
126 %
127 %   NOTES:
128 %
129 %   1) A may contain the collocation polynomial
130 %   2) If MAXIT is exceeded, REF contains a new reference set
131 %   3) M, EPSH and REF can be altered during the execution
132 %   4) To keep consistency to the original code , EPSH can be
133 %   negative. However, the use of REF0 is *NOT* determined by
134 %   EPSH< 0, but only by its inclusion as an input parameter.
135 %
136 %   Some parts of the code can still take advantage of vectorization.  
137 %
138 %   Revision 1.0 from 1998 is a direct human translation of 
139 %   the FORTRAN code http://www.netlib.org/toms/501
140 %   Revision 1.1 is a clean-up and technical update.  
141 %   Tested on MATLAB Version 7.11.0.584 (R2010b) and 
142 %   GNU Octave Version 3.2.4
143
144 %   $Revision: 1.1 $  $Date: 2011/08/3 $
145
146 %       ************************************ beginning of POLYFITINF
147 function [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT,REF0)
148
149     % Preassign output variables A,REF,HMAX,H,R,EQUAL in case of error return
150     A = []; REF = []; HMAX = []; H = []; R = 0; EQUAL = -2;
151     %%%% end preassignment
152
153     %       Setting M with respect to K
154     MOLD = M;
155
156     switch K
157         case 1
158             K0 = 0;
159             K1 = 1;
160             Q1 = 1;
161             Q2 = 2;
162             M =  (M-Q1)/2;
163         case 2
164             K0 = 0;
165             K1 = 0;
166             Q1 = 0;
167             Q2 = 2;
168             
169             % If the user has input odd M, but wants an even polynomial,
170             % subtract 1 from M to prevent errors later. The outputs should be
171             % mathematically equivalent.
172             if mod(M,2) == 1
173                 M = M-1;
174             end
175             
176             M =  (M-Q1)/2;
177         otherwise
178             if (K ~= 0)
179                 warning('polyfitinf:MixedParity','Using mixed parity polynomial...');
180             end
181             K0 = 1;
182             K1 = 0;
183             Q1 = 0;
184             Q2 = 1;
185     end
186
187     P = M + 2;
188
189     %       Check input data consistency
190
191     if ( (length(X) ~= N) || (length(Y) ~= N) )
192         error('Input Error: check data lengths');
193     end
194
195     if (P > N)
196         error('Input Error: insufficient data points');
197     end
198
199     if (M < 0)
200         error('Input Error: insufficient degree');
201     end
202
203     if ( (K == 2) && (X(1) < 0) ) || ( (K == 1) && (X(1) <= 0) )
204         error('Input Error: X(1) inconsistent with parity');
205     end
206
207     if any(diff(X)<0)
208         error('Input Error: Abscissae out of order');
209     end
210
211     ITEMP = MOLD + 1;
212
213     A = zeros(1,ITEMP);
214
215
216     ITEMP = P + 2;
217     Z = zeros(1,ITEMP);
218     Z(1) = 0;
219     Z(ITEMP) = N + 1;
220
221     EPSH = abs(EPSH);
222
223     %       Read initial reference set into Z, if available.
224
225     if (nargin == 8)
226         J = 0;
227         
228         Z(2:(P+1))= REF0(1:P);
229         
230         %       Check if REF is monotonically increasing
231         if ( any(diff(REF0) < 0) || any(REF0 > J) )
232             error('Input Error : Bad initial reference set');
233         end
234         
235     else
236         
237         %          Loads Z with the points closest to the Chebychev abscissas
238         
239         X1 = X(1);
240         XE = X(N);
241         
242         %          Setting parity-dependent parameters
243         
244         if (K0 == 1)
245             XA = XE + X1;
246             XE = XE - X1;
247             Q = pi/(M + 1.0);
248         else
249             XA = 0.;
250             XE = XE + XE;
251             ITEMP = 2*(M+1) + Q1;
252             Q = pi/(ITEMP);
253         end
254         
255         %          Calculate the J-th Chebyshev abcissa and load Z(J+1)
256         %          with the appropriate index from the data abcissas
257         
258         for JJ = 1:P
259             J = P + 1 - JJ;
260             X1 = XA + XE*( cos(Q*(P-J)) );
261             ITEMP = J + 2;
262             R = Z(ITEMP);
263             HIGH = R - 1;
264             FLAG = 1;
265             if (HIGH >= 2)
266                 II = 2;
267                 while ( (II <= HIGH) && (FLAG == 1) )
268                     I = HIGH + 2 - II;
269                     ITEMP = I - 1;
270                     
271                     %                   If the Chebyschev abscissa is bracketed by
272                     %                two input abcissas, get out of the while loop
273                     
274                     if (X(I)+X(ITEMP) <= X1)
275                         FLAG = 0;
276                     end
277                     II = II + 1;
278                 end
279             end
280             
281             if (FLAG == 1)
282                 I = 1;
283             end
284             ITEMP = J + 1;
285             
286             if (I < R)
287                 Z(ITEMP) = I;
288             else
289                 Z(ITEMP) = R - 1;
290             end
291         end
292         
293         %          If the lower Chebyshev abcissas are less than X(1),
294         %          load the lower elements of Z with the lowest points
295
296         IND = find(Z(2:end) >= (1:(length(Z)-1)));
297         
298         try TEMP = IND(1);      % If IND is empty, do nothing.
299         catch exception % The catch will be that IND is an empty array.
300             
301             if strcmpi(exception.identifier,'MATLAB:badsubscript')
302                 % This will be the exception. Do nothing.
303             end
304         end
305         
306         if TEMP~=1
307             Z(2:TEMP) = (1:(TEMP-1))';
308         end
309         
310         
311     end
312
313     %       M1 entry. Initialize variables to prepare for exchange iteration
314
315     ITEMP = M + 1;
316
317
318     %       Zero the AA array
319
320
321     AA = zeros(1,ITEMP);
322
323
324     %       Load H with the ordinates and XX(I) with the abscissas if the
325     %       polynomial is mixed . If it is even or odd , load XX with the
326     %       squares of the abscissas.
327
328     H(1:N) = Y(1:N);
329     if (K0 <=0)
330         XX(1:N) = X(1:N).^2;
331     else
332         XX(1:N) = X(1:N);
333     end
334
335     B1 = 0;
336     B2 = 0;
337     B3 = 0;
338     R = -1;
339     T = 0.;
340
341     %       Iteration entry. R is the iteration index
342
343     C = zeros(1,P);
344     D = zeros(1,P);
345     DAA = zeros(1,M+1);
346
347     FLAG = 1;
348     while ( (R < MAXIT) && (FLAG == 1) )
349         
350         R = R + 1;   % LABEL 350
351         %S = 1.;
352         
353         %          Computation of div. differences schemes
354         
355         if (K1 > 0)
356             
357             %               If the polynomial is mixed or even:
358             %for I = 1:P
359             %    S = -S;
360             %    ITEMP = I + 1;
361             %    J = Z(ITEMP);
362             %    Q = X(J);
363             %    C(I) = (H(J) + S*T)/Q;
364             %    D(I) = S/Q;
365             %end
366
367             I = (1:P);
368         S = (-1).^I;
369             ITEMP = I+1;
370             J = Z(ITEMP);
371             C(I) = (H(J) + S*T)./X(J);
372             D(I) = S./Q;
373             clear I ITEMP S J
374         
375         else
376             
377             %               If the polynomial is odd:
378             %for I = 1:P
379             %    S = -S;
380             %    ITEMP = I + 1;
381             %    ITEMP = Z(ITEMP);
382             %    C(I) = H(ITEMP) + S*T;
383             %    D(I) = S;
384             %end
385
386             I = (1:P);
387         S = (-1).^I;
388             ITEMP = I+1;
389             C(I) = H( Z(ITEMP) ) + S.*T;
390             D(I) = S;
391         clear I ITEMP S
392             
393         end
394         
395         for I = 2:P
396             for JJ = I:P
397                 J = P + I - JJ;
398                 ITEMP = J + 1;
399                 ITEMP = Z(ITEMP);
400                 QD = XX(ITEMP);
401                 ITEMP = 2 + J - I;
402                 ITEMP = Z(ITEMP);
403                 QD = QD - XX(ITEMP);
404                 ITEMP = J - 1;
405                 C(J) = (C(J)-C(ITEMP))/QD;
406                 D(J) = (D(J)-D(ITEMP))/QD;
407             end
408         end
409         
410         DT = -C(P)/D(P);
411         T = T + DT;
412         
413         %           Computation of polynomial coefficients
414         
415         HIGH = M + 1;
416         for II = 1:HIGH
417             I = HIGH - II;
418             ITEMP = I + 1;
419             DAA(ITEMP) = C(ITEMP) + DT*D(ITEMP);
420             ITEMP = I + 2;
421             ITEMP = Z(ITEMP);
422             QD = XX(ITEMP);
423             LOW = I + 1;
424             if (M >= LOW)
425                 DAA(LOW:M) = DAA(LOW:M) - QD*DAA(((LOW:M)+1));
426             end
427         end
428         
429         AA(1:HIGH) = AA(1:HIGH) + DAA(1:HIGH);
430         
431         %          Evaluation of the polynomial to get the approximation errors
432         
433         MAXX = 0.;
434         H = zeros(1,N);
435         for I = 1:N
436             SD = AA(HIGH);
437             QD = XX(I);
438             if (M > 0)
439                 for J = M:-1:1
440                     SD = SD*QD + AA(J);
441                 end
442             end
443             if (K1 > 0)
444                 %                  If the polynomial is odd, multiply SD by X(I)
445                 SD = SD*X(I);
446             end
447             
448             QD = Y(I) - SD;
449             H(I) = Y(I) - SD;
450             
451             if  (abs(QD) > MAXX)
452                 %                  Load MAXX with the largest magnitude
453                 %                  of the approximation array
454                 MAXX = abs(QD);
455             end
456         end
457         
458         %          Test for alternating signs
459         
460         ITEMP = Z(2);
461         
462         if (H(ITEMP) == 0.)
463             
464             %               This represents a case where the polynomial
465             %               exactly predicts a data point
466           
467             warning('polyfitinf:Collocation','Collocation has occured.');
468             if (B3 > 0)
469                 B3 = -1;
470                 FLAG = 0;
471             else
472                 B3 = 1;
473                 if (EPSH < MAXX)
474                     warning('polyfitinf:AnotherTry','1 more attempt with middle points');
475                     LOW = (N+1)/2 - (P+1)/2 + 1;
476                     HIGH = LOW + P;
477                     Z(LOW:HIGH) = ( (LOW:HIGH) -1);
478                     
479                 else
480                     disp('Normal Exit.');
481                     FLAG = 0;
482                 end
483             end
484         else
485             
486             if (H(ITEMP) > 0.)
487                 J = -1;
488             else
489                 J =  1;
490             end
491             
492             I = 2;
493             FLAG2 = 1;
494             while ( (I <= P) && (FLAG2 == 1) )
495                 ITEMP = I + 1;
496                 ITEMP = Z(ITEMP);
497                 if (H(ITEMP) == 0.)
498                     J = 0;
499                     warning('polyfitinf:Collocation','Collocation has occured.');
500                     if (B3 > 0)
501                         B3 = -1;
502                         FLAG = 0;
503                     else
504                         B3 = 1;
505                         if (EPSH < MAXX)
506                             warning('polyfitinf:AnotherTry','1 more attempt with middle points');
507                             LOW = (N+1)/2 - (P+1)/2 + 1;
508                             HIGH = LOW + P;
509                             Z(LOW:HIGH) = ( (LOW:HIGH) -1);
510                         else
511                             disp('Normal Exit.');
512                             FLAG = 0;
513                         end
514                     end
515                     FLAG2 = 0;
516                 else
517                     if (H(ITEMP) < 0)
518                         JJ = -1;
519                     else
520                         JJ = 1;
521                     end
522                     if (J~=JJ)
523                         
524                         %                          Error entry: bad accuracy for calculation
525                         
526                         B1 = 1;
527                         FLAG2 = 0;
528                         FLAG = 0;
529                     else
530                         J = -J;
531                     end
532                 end
533                 
534                 I = I + 1;
535                 
536             end % end of while
537             
538             %                  Search for another reference
539             
540             if (FLAG2*FLAG == 1)
541                 
542                 [H,Z,EQUAL] = exch(N, P, EPSH, H, Z);
543                 if (EQUAL > 0)
544                     FLAG = 0;
545                 else
546                     if (R >= MAXIT)
547                         B2 = 1;
548                         FLAG = 0;
549                     end
550                 end
551                 
552             end
553             
554         end       % end of if over H(ITEMP)
555         
556     end;      % end of iteration loop
557
558     %       M2 entry; load output variables and return
559
560     HIGH = M + 1;
561
562     %       Load the coefficients into A array
563
564     A(Q1 + Q2*(((1:HIGH)-1)) + 1) = AA(1:HIGH);
565
566     %       Load REF with the final reference points
567
568     REF(1:P) = Z((1:P) + 1);
569
570     HMAX = MAXX;
571
572     if (B3 < 0)
573         EQUAL = -2;
574         warning('polyfitinf:Collocation','polyfitinf terminates');
575     end
576     if (B1 > 0)
577         EQUAL = -2;
578         warning('polyfitinf:NoAlternatingSigns','Alternating signs not observed');
579     end
580     if (B2 > 0)
581         EQUAL = 0;
582         warning('polyfitinf:MaxIterationsReached','MAXIT was reached, current ref. set saved in REF.');
583     end
584
585     % Reverse the order of A to make it compatible with MATLAB'S polyval() function.
586     A = A(end:-1:1);
587
588
589 endfunction
590 %       ****************************************** end of POLYFITINF
591
592 function [H,Z,EQUAL] = exch(N, P, EPSH, H, Z)
593 % function [H,Z,EQUAL] = exch(N, P, EPSH, H, Z)
594 %
595 %   EXCH: exchange algorithm
596 %
597 %   INPUT VARIABLES:
598 %   N       : number of data points
599 %   P   : number of reference points
600 %   EPSH    : tolerance for leveling.
601 %   Z   : old reference indices
602 %
603 %   OUTPUT VARIABLES:
604 %   H       : pointwise approximation errors
605 %   Z   : new reference indices
606 %   EQUAL   :   EQUAL=1 :  normal exchange
607 %                   EQUAL=0 :  old and new references are equal
608 %
609 %   CREDITS: This routine was developed and modified as 
610 %   computer assignments in Approximation Theory courses by 
611 %   Prof. Andrew Knyazev, University of Colorado Denver, USA.
612 %
613 %   Team Fall 98 (Revision 1.0):
614 %           Chanchai Aniwathananon
615 %           Crhistopher Mehl
616 %           David A. Duran
617 %           Saulo P. Oliveira
618 %
619 %   Team Spring 11 (Revision 1.1): Manuchehr Aminian
620 %
621 %   The algorithm and the comments are based on a FORTRAN code written
622 %   by Joseph C. Simpson. The code is available on Netlib repository:
623 %   http://www.netlib.org/toms/501
624 %   See also: Communications of the ACM, V14, pp.355-356(1971)
625 %
626 %   Revision 1.0 from 1998 is a direct human translation of 
627 %   the FORTRAN code http://www.netlib.org/toms/501
628 %   Revision 1.1 is a clean-up and technical update.  
629 %   Tested on MATLAB Version 7.11.0.584 (R2010b) and 
630 %   GNU Octave Version 3.2.4
631
632 %   License: BSD
633 %   Copyright 1998-2011 Andrew V. Knyazev
634 %   $Revision: 1.1 $  $Date: 2011/05/17 $
635
636 %       ************************************ beginning of exch
637
638     EQUAL = 0;
639     L = 0;
640     ITEMP =  Z(2);
641
642     %   SIG is arbitrarily chosen equal to the sign of the input
643     %   point. This will be adjusted later if necessary.
644
645     if (H(ITEMP) <= 0)
646         SIG = 1.;
647     else
648         SIG = -1.;
649     end
650
651     %   The next loop prescans Z to insure it is a proper choice, i.e
652     %   resets Z if necessary so that maximum error points are chosen,
653     %   given the sign convention mentioned above. In order to work
654     %   properly, this section requires Z(1) = 0 and Z(P+2) = N + 1 .
655
656     for I = 1:P
657         MAXX = 0.;
658         SIG = -SIG;
659         ITEMP = I + 2;
660         ZE  =  Z(ITEMP) - 1;
661         LOW =  Z(I) + 1;
662         
663         %          Scan the open point interval containing only the 1th initial
664         %          reference point. In the interval pick the point with largest
665         %          magnitude and correct sign. Most of the sorting occurs in
666         %          this section. SIG contains the sign assumed for H(I).
667         
668         for J = LOW:ZE
669             if (SIG*(H(J)-MAXX) > 0)
670                 MAXX = H(J);
671                 INDEX = J;
672             end
673         end
674         ITEMP = I + 1;
675         ITEMP =  Z(ITEMP);
676         MAXL = abs(MAXX);
677         
678         %          If the MAX error is significantly greater than the
679         %          input point, switch to this point.
680         
681         if (abs( MAXX - H(ITEMP) )/MAXL > EPSH)
682             ITEMP = I + 1;
683             Z(ITEMP) = INDEX;
684             L = 1;
685         end
686     end
687     %
688     MAXL = 0.;
689     MAXR = 0.;
690     ITEMP = P + 1;
691     LOW =  Z(ITEMP) + 1;
692     %
693     if (LOW <= N)
694         
695         %          Find the error with largest abs value and proper sign
696         %          from among the points above the last reference point.
697         %          This section is necessary because the set of points
698         %          chosen may begin with the wrong sign alternation.
699         
700         for J = LOW:N
701             if (SIG*(MAXR-H(J)) > 0)
702                 MAXR = H(J);
703                 INDR = J;
704             end
705         end
706     end
707
708     %   Find the error with largest abs value and proper sign
709     %   from among the points below  the 1st reference  point.
710     %   This section is necessary by the same reason as above.
711
712     ITEMP =  Z(2);
713     HZ1 = H(ITEMP);
714     HIGH = ITEMP -1;
715     if (HIGH > 0)
716         if (HZ1 < 0)
717             SIG = -1.;
718         elseif (HZ1 == 0)
719             SIG = 0.;
720         else
721             SIG = 1.;
722         end
723         
724         for J = 1:HIGH
725             if (SIG*(MAXL-H(J)) > 0)
726                 MAXL = H(J);
727                 INDL = J;
728             end
729         end
730         
731     end
732
733     %   MAXL and MAXR contain the magnitude of the significant
734     %   errors outside the reference point set. If either is
735     %   zero, the reference point set extends to the end point
736     %   on that side of the interval.
737
738     MAXL = abs(MAXL);
739     MAXR = abs(MAXR);
740     HZ1 = abs(HZ1);
741     ITEMP = P + 1;
742     ITEMP =  Z(ITEMP);
743     HZP = abs(H(ITEMP));
744
745     %   L = 0 implies that the previous prescan did not change
746     %   any points. If L = 0 and MAXL, MAXR are not significant
747     %   if compared with upper and lower reference point errors,
748     %   respectively, use the EQUAL exit.
749
750     FLAG1 = 1;
751     if (L == 0)
752         if ( (MAXL == 0) || (EPSH >= (MAXL-HZP)/MAXL) )
753             if ( (MAXR == 0) || (EPSH >= (MAXR-HZ1)/MAXR) )
754                 FLAG1 = 0;
755                 EQUAL = 1;
756             end
757         end
758     end
759
760     if ( (MAXL == 0) && (MAXR == 0) )
761         FLAG1 = 0;
762     end
763
764     if ( (MAXL > MAXR) && (MAXL <= HZP) && (MAXR < HZ1) )
765         FLAG1 = 0;
766     end
767
768     if ( (MAXL <= MAXR) && (MAXR <= HZ1) && (MAXL < HZP) )
769         FLAG1 = 0;
770     end
771
772     %   If a point outside the present reference set must be
773     %   included, (i.e. the sign of the 1st point previously
774     %   assumed is wrong) shift to the side of largest
775     %   relative error first.
776
777     if (FLAG1 == 1)
778         
779         FLAG2 = 1;
780         
781         if ( (MAXL > MAXR) && (MAXL > HZP) )
782             FLAG2 = 0;
783         end
784         
785         if ( (MAXL <= MAXR) && (MAXR <= HZ1) )
786             FLAG2 = 0;
787         end
788         
789         if (FLAG2 == 1)
790             
791             %           SHR entry. This section inserts a point from
792             %           above the prescan point set
793             
794             INDEX = Z(2);
795             
796             %           shift point set down, dropping the lowest point
797             
798             Z(2:P) = Z((2:P)+1);
799             
800             ITEMP = P + 1;
801             
802             %           add the next high point
803             Z(ITEMP)=INDR;
804             
805             %           if MAXL > 0 replace reference points from the left,
806             %           stopping the 1st time the candidate for replacement
807             %           is greater than in magnitude than the prospective
808             %           replacee. Alternation of signs is preserved because
809             %           non-replacement immediately terminates the process.
810             
811             if (MAXL > 0)
812                 I = 2;
813                 FLAG3 = 1;
814                 while ( (I <= P) && (FLAG3 == 1) )
815                     ITEMP = Z(I);
816                     if ( abs(H(INDL)) >= abs(H(ITEMP)) )
817                         J = Z(I);
818                         Z(I) = INDL;
819                         INDL = INDEX;
820                         INDEX = J;
821                     else
822                         FLAG3 = 0;
823                     end
824                     I = I + 1;
825                 end
826             end
827             
828         else
829             
830             %      SHL entry. This section inserts a point from below the
831             %      prescan point set.
832             
833             ITEMP = P + 1 ;
834             INDEX = Z(ITEMP);
835             
836             Z((2:P)+1) = Z(2:P);
837             
838             %           store lowest point in Z(2)
839             Z(2) = INDL;
840             
841             %           if MAXR > 0 replace reference points from the right,
842             %           stopping the 1st time the candidate for replacement
843             %           is greater than in magnitude than the prospective
844             %           replacee.
845             
846             if (MAXR > 0)
847                 II = 2;
848                 FLAG3 = 1;
849                 while ( (II <= P) && (FLAG3 == 1) )
850                     I = P + 2 - II;
851                     ITEMP = I + 1;
852                     HIGH = Z(ITEMP);
853                     if ( abs(H(INDR)) >= abs(H(HIGH)) )
854                         J = Z(ITEMP);
855                         Z(ITEMP) = INDR;
856                         INDR = INDEX;
857                         INDEX = J;
858                     else
859                         FLAG3 = 0;
860                     end
861                     II = II + 1;
862                 end
863             end
864             
865         end
866         
867     end
868
869 endfunction
870 %       ****************************************** end of exch