Free cookie consent management tool by TermsFeed Policy Generator

source: branches/3.2/sources/HeuristicLab.ExtLibs/HeuristicLab.ALGLIB/2.3.0/ALGLIB-2.3.0/autogk.cs @ 5955

Last change on this file since 5955 was 2806, checked in by gkronber, 15 years ago

Added plugin for new version of ALGLIB. #875 (Update ALGLIB sources)

File size: 37.0 KB
Line 
1/*************************************************************************
2Copyright (c) 2005-2009, Sergey Bochkanov (ALGLIB project).
3
4>>> SOURCE LICENSE >>>
5This program is free software; you can redistribute it and/or modify
6it under the terms of the GNU General Public License as published by
7the Free Software Foundation (www.fsf.org); either version 2 of the
8License, or (at your option) any later version.
9
10This program is distributed in the hope that it will be useful,
11but WITHOUT ANY WARRANTY; without even the implied warranty of
12MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13GNU General Public License for more details.
14
15A copy of the GNU General Public License is available at
16http://www.fsf.org/licensing/licenses
17
18>>> END OF LICENSE >>>
19*************************************************************************/
20
21using System;
22
23namespace alglib
24{
25    public class autogk
26    {
27        /*************************************************************************
28        Integration report:
29        * TerminationType = completetion code:
30            * -5    non-convergence of Gauss-Kronrod nodes
31                    calculation subroutine.
32            * -1    incorrect parameters were specified
33            *  1    OK
34        * Rep.NFEV countains number of function calculations
35        * Rep.NIntervals contains number of intervals [a,b]
36          was partitioned into.
37        *************************************************************************/
38        public struct autogkreport
39        {
40            public int terminationtype;
41            public int nfev;
42            public int nintervals;
43        };
44
45
46        public struct autogkinternalstate
47        {
48            public double a;
49            public double b;
50            public double eps;
51            public double xwidth;
52            public double x;
53            public double f;
54            public int info;
55            public double r;
56            public double[,] heap;
57            public int heapsize;
58            public int heapwidth;
59            public int heapused;
60            public double sumerr;
61            public double sumabs;
62            public double[] qn;
63            public double[] wg;
64            public double[] wk;
65            public double[] wr;
66            public int n;
67            public AP.rcommstate rstate;
68        };
69
70
71        /*************************************************************************
72        This structure stores internal state of the integration algorithm  between
73        subsequent calls of the AutoGKIteration() subroutine.
74        *************************************************************************/
75        public struct autogkstate
76        {
77            public double a;
78            public double b;
79            public double alpha;
80            public double beta;
81            public double xwidth;
82            public double x;
83            public double xminusa;
84            public double bminusx;
85            public double f;
86            public int wrappermode;
87            public autogkinternalstate internalstate;
88            public AP.rcommstate rstate;
89            public double v;
90            public int terminationtype;
91            public int nfev;
92            public int nintervals;
93        };
94
95
96
97
98        /*************************************************************************
99        Integration of a smooth function F(x) on a finite interval [a,b].
100
101        Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
102        is calculated with accuracy close to the machine precision.
103
104        Algorithm works well only with smooth integrands.  It  may  be  used  with
105        continuous non-smooth integrands, but with  less  performance.
106
107        It should never be used with integrands which have integrable singularities
108        at lower or upper limits - algorithm may crash. Use AutoGKSingular in such
109        cases.
110
111        INPUT PARAMETERS:
112            A, B    -   interval boundaries (A<B, A=B or A>B)
113           
114        OUTPUT PARAMETERS
115            State   -   structure which stores algorithm state between  subsequent
116                        calls of AutoGKIteration.  Used for reverse communication.
117                        This structure should be  passed  to  the  AutoGKIteration
118                        subroutine.
119
120        SEE ALSO
121            AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults.
122           
123
124          -- ALGLIB --
125             Copyright 06.05.2009 by Bochkanov Sergey
126        *************************************************************************/
127        public static void autogksmooth(double a,
128            double b,
129            ref autogkstate state)
130        {
131            autogksmoothw(a, b, 0.0, ref state);
132        }
133
134
135        /*************************************************************************
136        Integration of a smooth function F(x) on a finite interval [a,b].
137
138        This subroutine is same as AutoGKSmooth(), but it guarantees that interval
139        [a,b] is partitioned into subintervals which have width at most XWidth.
140
141        Subroutine  can  be  used  when  integrating nearly-constant function with
142        narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth
143        subroutine can overlook them.
144
145        INPUT PARAMETERS:
146            A, B    -   interval boundaries (A<B, A=B or A>B)
147
148        OUTPUT PARAMETERS
149            State   -   structure which stores algorithm state between  subsequent
150                        calls of AutoGKIteration.  Used for reverse communication.
151                        This structure should be  passed  to  the  AutoGKIteration
152                        subroutine.
153
154        SEE ALSO
155            AutoGKSmooth, AutoGKSingular, AutoGKIteration, AutoGKResults.
156
157
158          -- ALGLIB --
159             Copyright 06.05.2009 by Bochkanov Sergey
160        *************************************************************************/
161        public static void autogksmoothw(double a,
162            double b,
163            double xwidth,
164            ref autogkstate state)
165        {
166            state.wrappermode = 0;
167            state.a = a;
168            state.b = b;
169            state.xwidth = xwidth;
170            state.rstate.ra = new double[10+1];
171            state.rstate.stage = -1;
172        }
173
174
175        /*************************************************************************
176        Integration on a finite interval [A,B].
177        Integrand have integrable singularities at A/B.
178
179        F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B,  with known
180        alpha/beta (alpha>-1, beta>-1).  If alpha/beta  are  not known,  estimates
181        from below can be used (but these estimates should be greater than -1 too).
182
183        One  of  alpha/beta variables (or even both alpha/beta) may be equal to 0,
184        which means than function F(x) is non-singular at A/B. Anyway (singular at
185        bounds or not), function F(x) is supposed to be continuous on (A,B).
186
187        Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result
188        is calculated with accuracy close to the machine precision.
189
190        INPUT PARAMETERS:
191            A, B    -   interval boundaries (A<B, A=B or A>B)
192            Alpha   -   power-law coefficient of the F(x) at A,
193                        Alpha>-1
194            Beta    -   power-law coefficient of the F(x) at B,
195                        Beta>-1
196
197        OUTPUT PARAMETERS
198            State   -   structure which stores algorithm state between  subsequent
199                        calls of AutoGKIteration.  Used for reverse communication.
200                        This structure should be  passed  to  the  AutoGKIteration
201                        subroutine.
202
203        SEE ALSO
204            AutoGKSmooth, AutoGKSmoothW, AutoGKIteration, AutoGKResults.
205
206
207          -- ALGLIB --
208             Copyright 06.05.2009 by Bochkanov Sergey
209        *************************************************************************/
210        public static void autogksingular(double a,
211            double b,
212            double alpha,
213            double beta,
214            ref autogkstate state)
215        {
216            state.wrappermode = 1;
217            state.a = a;
218            state.b = b;
219            state.alpha = alpha;
220            state.beta = beta;
221            state.xwidth = 0.0;
222            state.rstate.ra = new double[10+1];
223            state.rstate.stage = -1;
224        }
225
226
227        /*************************************************************************
228        One step of adaptive integration process.
229
230        Called after initialization with one of AutoGKXXX subroutines.
231        See HTML documentation for examples.
232
233        Input parameters:
234            State   -   structure which stores algorithm state between  calls  and
235                        which  is  used  for   reverse   communication.   Must  be
236                        initialized with one of AutoGKXXX subroutines.
237
238        If suborutine returned False, iterative proces has converged. If subroutine
239        returned True, caller should calculate function value State.F  at  State.X
240        and call AutoGKIteration again.
241
242        NOTE:
243
244        When integrating "difficult" functions with integrable singularities like
245
246            F(x) = (x-A)^alpha * (B-x)^beta
247
248        subroutine may require the value of F at points which are too close to A/B.
249        Sometimes to calculate integral with high enough precision we  may need to
250        calculate F(A+delta) when delta is less than machine  epsilon.  In  finite
251        precision arithmetics A+delta will be effectively equal to A,  so  we  may
252        find us in situation when  we  are  trying  to  calculate  something  like
253        1/sqrt(1-1).
254
255        To avoid  such  situations,  AutoGKIteration  subroutine  fills  not  only
256        State.X  field,  but  also   State.XMinusA   (which  equals  to  X-A)  and
257        State.BMinusX  (which  equals to B-X) fields.  If X is too close to A or B
258        (X-A<0.001*A, or B-X<0.001*B, for example) use  these  fields  instead  of
259        State.X
260
261
262          -- ALGLIB --
263             Copyright 07.05.2009 by Bochkanov Sergey
264        *************************************************************************/
265        public static bool autogkiteration(ref autogkstate state)
266        {
267            bool result = new bool();
268            double s = 0;
269            double tmp = 0;
270            double eps = 0;
271            double a = 0;
272            double b = 0;
273            double x = 0;
274            double t = 0;
275            double alpha = 0;
276            double beta = 0;
277            double v1 = 0;
278            double v2 = 0;
279
280           
281            //
282            // Reverse communication preparations
283            // I know it looks ugly, but it works the same way
284            // anywhere from C++ to Python.
285            //
286            // This code initializes locals by:
287            // * random values determined during code
288            //   generation - on first subroutine call
289            // * values from previous call - on subsequent calls
290            //
291            if( state.rstate.stage>=0 )
292            {
293                s = state.rstate.ra[0];
294                tmp = state.rstate.ra[1];
295                eps = state.rstate.ra[2];
296                a = state.rstate.ra[3];
297                b = state.rstate.ra[4];
298                x = state.rstate.ra[5];
299                t = state.rstate.ra[6];
300                alpha = state.rstate.ra[7];
301                beta = state.rstate.ra[8];
302                v1 = state.rstate.ra[9];
303                v2 = state.rstate.ra[10];
304            }
305            else
306            {
307                s = -983;
308                tmp = -989;
309                eps = -834;
310                a = 900;
311                b = -287;
312                x = 364;
313                t = 214;
314                alpha = -338;
315                beta = -686;
316                v1 = 912;
317                v2 = 585;
318            }
319            if( state.rstate.stage==0 )
320            {
321                goto lbl_0;
322            }
323            if( state.rstate.stage==1 )
324            {
325                goto lbl_1;
326            }
327            if( state.rstate.stage==2 )
328            {
329                goto lbl_2;
330            }
331           
332            //
333            // Routine body
334            //
335            eps = 0;
336            a = state.a;
337            b = state.b;
338            alpha = state.alpha;
339            beta = state.beta;
340            state.terminationtype = -1;
341            state.nfev = 0;
342            state.nintervals = 0;
343           
344            //
345            // smooth function  at a finite interval
346            //
347            if( state.wrappermode!=0 )
348            {
349                goto lbl_3;
350            }
351           
352            //
353            // special case
354            //
355            if( (double)(a)==(double)(b) )
356            {
357                state.terminationtype = 1;
358                state.v = 0;
359                result = false;
360                return result;
361            }
362           
363            //
364            // general case
365            //
366            autogkinternalprepare(a, b, eps, state.xwidth, ref state.internalstate);
367        lbl_5:
368            if( ! autogkinternaliteration(ref state.internalstate) )
369            {
370                goto lbl_6;
371            }
372            x = state.internalstate.x;
373            state.x = x;
374            state.xminusa = x-a;
375            state.bminusx = b-x;
376            state.rstate.stage = 0;
377            goto lbl_rcomm;
378        lbl_0:
379            state.nfev = state.nfev+1;
380            state.internalstate.f = state.f;
381            goto lbl_5;
382        lbl_6:
383            state.v = state.internalstate.r;
384            state.terminationtype = state.internalstate.info;
385            state.nintervals = state.internalstate.heapused;
386            result = false;
387            return result;
388        lbl_3:
389           
390            //
391            // function with power-law singularities at the ends of a finite interval
392            //
393            if( state.wrappermode!=1 )
394            {
395                goto lbl_7;
396            }
397           
398            //
399            // test coefficients
400            //
401            if( (double)(alpha)<=(double)(-1) | (double)(beta)<=(double)(-1) )
402            {
403                state.terminationtype = -1;
404                state.v = 0;
405                result = false;
406                return result;
407            }
408           
409            //
410            // special cases
411            //
412            if( (double)(a)==(double)(b) )
413            {
414                state.terminationtype = 1;
415                state.v = 0;
416                result = false;
417                return result;
418            }
419           
420            //
421            // reduction to general form
422            //
423            if( (double)(a)<(double)(b) )
424            {
425                s = +1;
426            }
427            else
428            {
429                s = -1;
430                tmp = a;
431                a = b;
432                b = tmp;
433                tmp = alpha;
434                alpha = beta;
435                beta = tmp;
436            }
437            alpha = Math.Min(alpha, 0);
438            beta = Math.Min(beta, 0);
439           
440            //
441            // first, integrate left half of [a,b]:
442            //     integral(f(x)dx, a, (b+a)/2) =
443            //     = 1/(1+alpha) * integral(t^(-alpha/(1+alpha))*f(a+t^(1/(1+alpha)))dt, 0, (0.5*(b-a))^(1+alpha))
444            //
445            autogkinternalprepare(0, Math.Pow(0.5*(b-a), 1+alpha), eps, state.xwidth, ref state.internalstate);
446        lbl_9:
447            if( ! autogkinternaliteration(ref state.internalstate) )
448            {
449                goto lbl_10;
450            }
451           
452            //
453            // Fill State.X, State.XMinusA, State.BMinusX.
454            // Latter two are filled correctly even if B<A.
455            //
456            x = state.internalstate.x;
457            t = Math.Pow(x, 1/(1+alpha));
458            state.x = a+t;
459            if( (double)(s)>(double)(0) )
460            {
461                state.xminusa = t;
462                state.bminusx = b-(a+t);
463            }
464            else
465            {
466                state.xminusa = a+t-b;
467                state.bminusx = -t;
468            }
469            state.rstate.stage = 1;
470            goto lbl_rcomm;
471        lbl_1:
472            if( (double)(alpha)!=(double)(0) )
473            {
474                state.internalstate.f = state.f*Math.Pow(x, -(alpha/(1+alpha)))/(1+alpha);
475            }
476            else
477            {
478                state.internalstate.f = state.f;
479            }
480            state.nfev = state.nfev+1;
481            goto lbl_9;
482        lbl_10:
483            v1 = state.internalstate.r;
484            state.nintervals = state.nintervals+state.internalstate.heapused;
485           
486            //
487            // then, integrate right half of [a,b]:
488            //     integral(f(x)dx, (b+a)/2, b) =
489            //     = 1/(1+beta) * integral(t^(-beta/(1+beta))*f(b-t^(1/(1+beta)))dt, 0, (0.5*(b-a))^(1+beta))
490            //
491            autogkinternalprepare(0, Math.Pow(0.5*(b-a), 1+beta), eps, state.xwidth, ref state.internalstate);
492        lbl_11:
493            if( ! autogkinternaliteration(ref state.internalstate) )
494            {
495                goto lbl_12;
496            }
497           
498            //
499            // Fill State.X, State.XMinusA, State.BMinusX.
500            // Latter two are filled correctly (X-A, B-X) even if B<A.
501            //
502            x = state.internalstate.x;
503            t = Math.Pow(x, 1/(1+beta));
504            state.x = b-t;
505            if( (double)(s)>(double)(0) )
506            {
507                state.xminusa = b-t-a;
508                state.bminusx = t;
509            }
510            else
511            {
512                state.xminusa = -t;
513                state.bminusx = a-(b-t);
514            }
515            state.rstate.stage = 2;
516            goto lbl_rcomm;
517        lbl_2:
518            if( (double)(beta)!=(double)(0) )
519            {
520                state.internalstate.f = state.f*Math.Pow(x, -(beta/(1+beta)))/(1+beta);
521            }
522            else
523            {
524                state.internalstate.f = state.f;
525            }
526            state.nfev = state.nfev+1;
527            goto lbl_11;
528        lbl_12:
529            v2 = state.internalstate.r;
530            state.nintervals = state.nintervals+state.internalstate.heapused;
531           
532            //
533            // final result
534            //
535            state.v = s*(v1+v2);
536            state.terminationtype = 1;
537            result = false;
538            return result;
539        lbl_7:
540            result = false;
541            return result;
542           
543            //
544            // Saving state
545            //
546        lbl_rcomm:
547            result = true;
548            state.rstate.ra[0] = s;
549            state.rstate.ra[1] = tmp;
550            state.rstate.ra[2] = eps;
551            state.rstate.ra[3] = a;
552            state.rstate.ra[4] = b;
553            state.rstate.ra[5] = x;
554            state.rstate.ra[6] = t;
555            state.rstate.ra[7] = alpha;
556            state.rstate.ra[8] = beta;
557            state.rstate.ra[9] = v1;
558            state.rstate.ra[10] = v2;
559            return result;
560        }
561
562
563        /*************************************************************************
564        Adaptive integration results
565
566        Called after AutoGKIteration returned False.
567
568        Input parameters:
569            State   -   algorithm state (used by AutoGKIteration).
570
571        Output parameters:
572            V       -   integral(f(x)dx,a,b)
573            Rep     -   optimization report (see AutoGKReport description)
574
575          -- ALGLIB --
576             Copyright 14.11.2007 by Bochkanov Sergey
577        *************************************************************************/
578        public static void autogkresults(ref autogkstate state,
579            ref double v,
580            ref autogkreport rep)
581        {
582            v = state.v;
583            rep.terminationtype = state.terminationtype;
584            rep.nfev = state.nfev;
585            rep.nintervals = state.nintervals;
586        }
587
588
589        /*************************************************************************
590        Internal AutoGK subroutine
591        eps<0   - error
592        eps=0   - automatic eps selection
593
594        width<0 -   error
595        width=0 -   no width requirements
596        *************************************************************************/
597        private static void autogkinternalprepare(double a,
598            double b,
599            double eps,
600            double xwidth,
601            ref autogkinternalstate state)
602        {
603           
604            //
605            // Save settings
606            //
607            state.a = a;
608            state.b = b;
609            state.eps = eps;
610            state.xwidth = xwidth;
611           
612            //
613            // Prepare RComm structure
614            //
615            state.rstate.ia = new int[3+1];
616            state.rstate.ra = new double[8+1];
617            state.rstate.stage = -1;
618        }
619
620
621        /*************************************************************************
622        Internal AutoGK subroutine
623        *************************************************************************/
624        private static bool autogkinternaliteration(ref autogkinternalstate state)
625        {
626            bool result = new bool();
627            double c1 = 0;
628            double c2 = 0;
629            int i = 0;
630            int j = 0;
631            double intg = 0;
632            double intk = 0;
633            double inta = 0;
634            double v = 0;
635            double ta = 0;
636            double tb = 0;
637            int ns = 0;
638            double qeps = 0;
639            int info = 0;
640
641           
642            //
643            // Reverse communication preparations
644            // I know it looks ugly, but it works the same way
645            // anywhere from C++ to Python.
646            //
647            // This code initializes locals by:
648            // * random values determined during code
649            //   generation - on first subroutine call
650            // * values from previous call - on subsequent calls
651            //
652            if( state.rstate.stage>=0 )
653            {
654                i = state.rstate.ia[0];
655                j = state.rstate.ia[1];
656                ns = state.rstate.ia[2];
657                info = state.rstate.ia[3];
658                c1 = state.rstate.ra[0];
659                c2 = state.rstate.ra[1];
660                intg = state.rstate.ra[2];
661                intk = state.rstate.ra[3];
662                inta = state.rstate.ra[4];
663                v = state.rstate.ra[5];
664                ta = state.rstate.ra[6];
665                tb = state.rstate.ra[7];
666                qeps = state.rstate.ra[8];
667            }
668            else
669            {
670                i = 497;
671                j = -271;
672                ns = -581;
673                info = 745;
674                c1 = -533;
675                c2 = -77;
676                intg = 678;
677                intk = -293;
678                inta = 316;
679                v = 647;
680                ta = -756;
681                tb = 830;
682                qeps = -871;
683            }
684            if( state.rstate.stage==0 )
685            {
686                goto lbl_0;
687            }
688            if( state.rstate.stage==1 )
689            {
690                goto lbl_1;
691            }
692            if( state.rstate.stage==2 )
693            {
694                goto lbl_2;
695            }
696           
697            //
698            // Routine body
699            //
700           
701            //
702            // initialize quadratures.
703            // use 15-point Gauss-Kronrod formula.
704            //
705            state.n = 15;
706            gkq.gkqgenerategausslegendre(state.n, ref info, ref state.qn, ref state.wk, ref state.wg);
707            if( info<0 )
708            {
709                state.info = -5;
710                state.r = 0;
711                result = false;
712                return result;
713            }
714            state.wr = new double[state.n];
715            for(i=0; i<=state.n-1; i++)
716            {
717                if( i==0 )
718                {
719                    state.wr[i] = 0.5*Math.Abs(state.qn[1]-state.qn[0]);
720                    continue;
721                }
722                if( i==state.n-1 )
723                {
724                    state.wr[state.n-1] = 0.5*Math.Abs(state.qn[state.n-1]-state.qn[state.n-2]);
725                    continue;
726                }
727                state.wr[i] = 0.5*Math.Abs(state.qn[i-1]-state.qn[i+1]);
728            }
729           
730            //
731            // special case
732            //
733            if( (double)(state.a)==(double)(state.b) )
734            {
735                state.info = 1;
736                state.r = 0;
737                result = false;
738                return result;
739            }
740           
741            //
742            // test parameters
743            //
744            if( (double)(state.eps)<(double)(0) | (double)(state.xwidth)<(double)(0) )
745            {
746                state.info = -1;
747                state.r = 0;
748                result = false;
749                return result;
750            }
751            state.info = 1;
752            if( (double)(state.eps)==(double)(0) )
753            {
754                state.eps = 1000*AP.Math.MachineEpsilon;
755            }
756           
757            //
758            // First, prepare heap
759            // * column 0   -   absolute error
760            // * column 1   -   integral of a F(x) (calculated using Kronrod extension nodes)
761            // * column 2   -   integral of a |F(x)| (calculated using modified rect. method)
762            // * column 3   -   left boundary of a subinterval
763            // * column 4   -   right boundary of a subinterval
764            //
765            if( (double)(state.xwidth)!=(double)(0) )
766            {
767                goto lbl_3;
768            }
769           
770            //
771            // no maximum width requirements
772            // start from one big subinterval
773            //
774            state.heapwidth = 5;
775            state.heapsize = 1;
776            state.heapused = 1;
777            state.heap = new double[state.heapsize, state.heapwidth];
778            c1 = 0.5*(state.b-state.a);
779            c2 = 0.5*(state.b+state.a);
780            intg = 0;
781            intk = 0;
782            inta = 0;
783            i = 0;
784        lbl_5:
785            if( i>state.n-1 )
786            {
787                goto lbl_7;
788            }
789           
790            //
791            // obtain F
792            //
793            state.x = c1*state.qn[i]+c2;
794            state.rstate.stage = 0;
795            goto lbl_rcomm;
796        lbl_0:
797            v = state.f;
798           
799            //
800            // Gauss-Kronrod formula
801            //
802            intk = intk+v*state.wk[i];
803            if( i%2==1 )
804            {
805                intg = intg+v*state.wg[i];
806            }
807           
808            //
809            // Integral |F(x)|
810            // Use rectangles method
811            //
812            inta = inta+Math.Abs(v)*state.wr[i];
813            i = i+1;
814            goto lbl_5;
815        lbl_7:
816            intk = intk*(state.b-state.a)*0.5;
817            intg = intg*(state.b-state.a)*0.5;
818            inta = inta*(state.b-state.a)*0.5;
819            state.heap[0,0] = Math.Abs(intg-intk);
820            state.heap[0,1] = intk;
821            state.heap[0,2] = inta;
822            state.heap[0,3] = state.a;
823            state.heap[0,4] = state.b;
824            state.sumerr = state.heap[0,0];
825            state.sumabs = Math.Abs(inta);
826            goto lbl_4;
827        lbl_3:
828           
829            //
830            // maximum subinterval should be no more than XWidth.
831            // so we create Ceil((B-A)/XWidth)+1 small subintervals
832            //
833            ns = (int)Math.Ceiling(Math.Abs(state.b-state.a)/state.xwidth)+1;
834            state.heapsize = ns;
835            state.heapused = ns;
836            state.heapwidth = 5;
837            state.heap = new double[state.heapsize, state.heapwidth];
838            state.sumerr = 0;
839            state.sumabs = 0;
840            j = 0;
841        lbl_8:
842            if( j>ns-1 )
843            {
844                goto lbl_10;
845            }
846            ta = state.a+j*(state.b-state.a)/ns;
847            tb = state.a+(j+1)*(state.b-state.a)/ns;
848            c1 = 0.5*(tb-ta);
849            c2 = 0.5*(tb+ta);
850            intg = 0;
851            intk = 0;
852            inta = 0;
853            i = 0;
854        lbl_11:
855            if( i>state.n-1 )
856            {
857                goto lbl_13;
858            }
859           
860            //
861            // obtain F
862            //
863            state.x = c1*state.qn[i]+c2;
864            state.rstate.stage = 1;
865            goto lbl_rcomm;
866        lbl_1:
867            v = state.f;
868           
869            //
870            // Gauss-Kronrod formula
871            //
872            intk = intk+v*state.wk[i];
873            if( i%2==1 )
874            {
875                intg = intg+v*state.wg[i];
876            }
877           
878            //
879            // Integral |F(x)|
880            // Use rectangles method
881            //
882            inta = inta+Math.Abs(v)*state.wr[i];
883            i = i+1;
884            goto lbl_11;
885        lbl_13:
886            intk = intk*(tb-ta)*0.5;
887            intg = intg*(tb-ta)*0.5;
888            inta = inta*(tb-ta)*0.5;
889            state.heap[j,0] = Math.Abs(intg-intk);
890            state.heap[j,1] = intk;
891            state.heap[j,2] = inta;
892            state.heap[j,3] = ta;
893            state.heap[j,4] = tb;
894            state.sumerr = state.sumerr+state.heap[j,0];
895            state.sumabs = state.sumabs+Math.Abs(inta);
896            j = j+1;
897            goto lbl_8;
898        lbl_10:
899        lbl_4:
900           
901            //
902            // method iterations
903            //
904        lbl_14:
905            if( false )
906            {
907                goto lbl_15;
908            }
909           
910            //
911            // additional memory if needed
912            //
913            if( state.heapused==state.heapsize )
914            {
915                mheapresize(ref state.heap, ref state.heapsize, 4*state.heapsize, state.heapwidth);
916            }
917           
918            //
919            // TODO: every 20 iterations recalculate errors/sums
920            // TODO: one more criterion to prevent infinite loops with too strict Eps
921            //
922            if( (double)(state.sumerr)<=(double)(state.eps*state.sumabs) )
923            {
924                state.r = 0;
925                for(j=0; j<=state.heapused-1; j++)
926                {
927                    state.r = state.r+state.heap[j,1];
928                }
929                result = false;
930                return result;
931            }
932           
933            //
934            // Exclude interval with maximum absolute error
935            //
936            mheappop(ref state.heap, state.heapused, state.heapwidth);
937            state.sumerr = state.sumerr-state.heap[state.heapused-1,0];
938            state.sumabs = state.sumabs-state.heap[state.heapused-1,2];
939           
940            //
941            // Divide interval, create subintervals
942            //
943            ta = state.heap[state.heapused-1,3];
944            tb = state.heap[state.heapused-1,4];
945            state.heap[state.heapused-1,3] = ta;
946            state.heap[state.heapused-1,4] = 0.5*(ta+tb);
947            state.heap[state.heapused,3] = 0.5*(ta+tb);
948            state.heap[state.heapused,4] = tb;
949            j = state.heapused-1;
950        lbl_16:
951            if( j>state.heapused )
952            {
953                goto lbl_18;
954            }
955            c1 = 0.5*(state.heap[j,4]-state.heap[j,3]);
956            c2 = 0.5*(state.heap[j,4]+state.heap[j,3]);
957            intg = 0;
958            intk = 0;
959            inta = 0;
960            i = 0;
961        lbl_19:
962            if( i>state.n-1 )
963            {
964                goto lbl_21;
965            }
966           
967            //
968            // F(x)
969            //
970            state.x = c1*state.qn[i]+c2;
971            state.rstate.stage = 2;
972            goto lbl_rcomm;
973        lbl_2:
974            v = state.f;
975           
976            //
977            // Gauss-Kronrod formula
978            //
979            intk = intk+v*state.wk[i];
980            if( i%2==1 )
981            {
982                intg = intg+v*state.wg[i];
983            }
984           
985            //
986            // Integral |F(x)|
987            // Use rectangles method
988            //
989            inta = inta+Math.Abs(v)*state.wr[i];
990            i = i+1;
991            goto lbl_19;
992        lbl_21:
993            intk = intk*(state.heap[j,4]-state.heap[j,3])*0.5;
994            intg = intg*(state.heap[j,4]-state.heap[j,3])*0.5;
995            inta = inta*(state.heap[j,4]-state.heap[j,3])*0.5;
996            state.heap[j,0] = Math.Abs(intg-intk);
997            state.heap[j,1] = intk;
998            state.heap[j,2] = inta;
999            state.sumerr = state.sumerr+state.heap[j,0];
1000            state.sumabs = state.sumabs+state.heap[j,2];
1001            j = j+1;
1002            goto lbl_16;
1003        lbl_18:
1004            mheappush(ref state.heap, state.heapused-1, state.heapwidth);
1005            mheappush(ref state.heap, state.heapused, state.heapwidth);
1006            state.heapused = state.heapused+1;
1007            goto lbl_14;
1008        lbl_15:
1009            result = false;
1010            return result;
1011           
1012            //
1013            // Saving state
1014            //
1015        lbl_rcomm:
1016            result = true;
1017            state.rstate.ia[0] = i;
1018            state.rstate.ia[1] = j;
1019            state.rstate.ia[2] = ns;
1020            state.rstate.ia[3] = info;
1021            state.rstate.ra[0] = c1;
1022            state.rstate.ra[1] = c2;
1023            state.rstate.ra[2] = intg;
1024            state.rstate.ra[3] = intk;
1025            state.rstate.ra[4] = inta;
1026            state.rstate.ra[5] = v;
1027            state.rstate.ra[6] = ta;
1028            state.rstate.ra[7] = tb;
1029            state.rstate.ra[8] = qeps;
1030            return result;
1031        }
1032
1033
1034        private static void mheappop(ref double[,] heap,
1035            int heapsize,
1036            int heapwidth)
1037        {
1038            int i = 0;
1039            int p = 0;
1040            double t = 0;
1041            int maxcp = 0;
1042
1043            if( heapsize==1 )
1044            {
1045                return;
1046            }
1047            for(i=0; i<=heapwidth-1; i++)
1048            {
1049                t = heap[heapsize-1,i];
1050                heap[heapsize-1,i] = heap[0,i];
1051                heap[0,i] = t;
1052            }
1053            p = 0;
1054            while( 2*p+1<heapsize-1 )
1055            {
1056                maxcp = 2*p+1;
1057                if( 2*p+2<heapsize-1 )
1058                {
1059                    if( (double)(heap[2*p+2,0])>(double)(heap[2*p+1,0]) )
1060                    {
1061                        maxcp = 2*p+2;
1062                    }
1063                }
1064                if( (double)(heap[p,0])<(double)(heap[maxcp,0]) )
1065                {
1066                    for(i=0; i<=heapwidth-1; i++)
1067                    {
1068                        t = heap[p,i];
1069                        heap[p,i] = heap[maxcp,i];
1070                        heap[maxcp,i] = t;
1071                    }
1072                    p = maxcp;
1073                }
1074                else
1075                {
1076                    break;
1077                }
1078            }
1079        }
1080
1081
1082        private static void mheappush(ref double[,] heap,
1083            int heapsize,
1084            int heapwidth)
1085        {
1086            int i = 0;
1087            int p = 0;
1088            double t = 0;
1089            int parent = 0;
1090
1091            if( heapsize==0 )
1092            {
1093                return;
1094            }
1095            p = heapsize;
1096            while( p!=0 )
1097            {
1098                parent = (p-1)/2;
1099                if( (double)(heap[p,0])>(double)(heap[parent,0]) )
1100                {
1101                    for(i=0; i<=heapwidth-1; i++)
1102                    {
1103                        t = heap[p,i];
1104                        heap[p,i] = heap[parent,i];
1105                        heap[parent,i] = t;
1106                    }
1107                    p = parent;
1108                }
1109                else
1110                {
1111                    break;
1112                }
1113            }
1114        }
1115
1116
1117        private static void mheapresize(ref double[,] heap,
1118            ref int heapsize,
1119            int newheapsize,
1120            int heapwidth)
1121        {
1122            double[,] tmp = new double[0,0];
1123            int i = 0;
1124            int i_ = 0;
1125
1126            tmp = new double[heapsize, heapwidth];
1127            for(i=0; i<=heapsize-1; i++)
1128            {
1129                for(i_=0; i_<=heapwidth-1;i_++)
1130                {
1131                    tmp[i,i_] = heap[i,i_];
1132                }
1133            }
1134            heap = new double[newheapsize, heapwidth];
1135            for(i=0; i<=heapsize-1; i++)
1136            {
1137                for(i_=0; i_<=heapwidth-1;i_++)
1138                {
1139                    heap[i,i_] = tmp[i,i_];
1140                }
1141            }
1142            heapsize = newheapsize;
1143        }
1144    }
1145}
Note: See TracBrowser for help on using the repository browser.