Free cookie consent management tool by TermsFeed Policy Generator

source: branches/CEDMA-Exporter-715/sources/HeuristicLab.LinearRegression/3.2/alglib/bdsvd.cs @ 2273

Last change on this file since 2273 was 2154, checked in by gkronber, 15 years ago

Added linear regression plugin. #697

File size: 45.8 KB
Line 
1/*************************************************************************
2Copyright (c) 1992-2007 The University of Tennessee.  All rights reserved.
3
4Contributors:
5    * Sergey Bochkanov (ALGLIB project). Translation from FORTRAN to
6      pseudocode.
7
8See subroutines comments for additional copyrights.
9
10Redistribution and use in source and binary forms, with or without
11modification, are permitted provided that the following conditions are
12met:
13
14- Redistributions of source code must retain the above copyright
15  notice, this list of conditions and the following disclaimer.
16
17- Redistributions in binary form must reproduce the above copyright
18  notice, this list of conditions and the following disclaimer listed
19  in this license in the documentation and/or other materials
20  provided with the distribution.
21
22- Neither the name of the copyright holders nor the names of its
23  contributors may be used to endorse or promote products derived from
24  this software without specific prior written permission.
25
26THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
27"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
28LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
29A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
30OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
31SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
32LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
33DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
34THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
35(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
36OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
37*************************************************************************/
38
39using System;
40
41class bdsvd
42{
43    /*************************************************************************
44    Singular value decomposition of a bidiagonal matrix (extended algorithm)
45
46    The algorithm performs the singular value decomposition  of  a  bidiagonal
47    matrix B (upper or lower) representing it as B = Q*S*P^T, where Q and  P -
48    orthogonal matrices, S - diagonal matrix with non-negative elements on the
49    main diagonal, in descending order.
50
51    The  algorithm  finds  singular  values.  In  addition,  the algorithm can
52    calculate  matrices  Q  and P (more precisely, not the matrices, but their
53    product  with  given  matrices U and VT - U*Q and (P^T)*VT)).  Of  course,
54    matrices U and VT can be of any type, including identity. Furthermore, the
55    algorithm can calculate Q'*C (this product is calculated more  effectively
56    than U*Q,  because  this calculation operates with rows instead  of matrix
57    columns).
58
59    The feature of the algorithm is its ability to find  all  singular  values
60    including those which are arbitrarily close to 0  with  relative  accuracy
61    close to  machine precision. If the parameter IsFractionalAccuracyRequired
62    is set to True, all singular values will have high relative accuracy close
63    to machine precision. If the parameter is set to False, only  the  biggest
64    singular value will have relative accuracy  close  to  machine  precision.
65    The absolute error of other singular values is equal to the absolute error
66    of the biggest singular value.
67
68    Input parameters:
69        D       -   main diagonal of matrix B.
70                    Array whose index ranges within [0..N-1].
71        E       -   superdiagonal (or subdiagonal) of matrix B.
72                    Array whose index ranges within [0..N-2].
73        N       -   size of matrix B.
74        IsUpper -   True, if the matrix is upper bidiagonal.
75        IsFractionalAccuracyRequired -
76                    accuracy to search singular values with.
77        U       -   matrix to be multiplied by Q.
78                    Array whose indexes range within [0..NRU-1, 0..N-1].
79                    The matrix can be bigger, in that case only the  submatrix
80                    [0..NRU-1, 0..N-1] will be multiplied by Q.
81        NRU     -   number of rows in matrix U.
82        C       -   matrix to be multiplied by Q'.
83                    Array whose indexes range within [0..N-1, 0..NCC-1].
84                    The matrix can be bigger, in that case only the  submatrix
85                    [0..N-1, 0..NCC-1] will be multiplied by Q'.
86        NCC     -   number of columns in matrix C.
87        VT      -   matrix to be multiplied by P^T.
88                    Array whose indexes range within [0..N-1, 0..NCVT-1].
89                    The matrix can be bigger, in that case only the  submatrix
90                    [0..N-1, 0..NCVT-1] will be multiplied by P^T.
91        NCVT    -   number of columns in matrix VT.
92
93    Output parameters:
94        D       -   singular values of matrix B in descending order.
95        U       -   if NRU>0, contains matrix U*Q.
96        VT      -   if NCVT>0, contains matrix (P^T)*VT.
97        C       -   if NCC>0, contains matrix Q'*C.
98
99    Result:
100        True, if the algorithm has converged.
101        False, if the algorithm hasn't converged (rare case).
102
103    Additional information:
104        The type of convergence is controlled by the internal  parameter  TOL.
105        If the parameter is greater than 0, the singular values will have
106        relative accuracy TOL. If TOL<0, the singular values will have
107        absolute accuracy ABS(TOL)*norm(B).
108        By default, |TOL| falls within the range of 10*Epsilon and 100*Epsilon,
109        where Epsilon is the machine precision. It is not  recommended  to  use
110        TOL less than 10*Epsilon since this will  considerably  slow  down  the
111        algorithm and may not lead to error decreasing.
112    History:
113        * 31 March, 2007.
114            changed MAXITR from 6 to 12.
115
116      -- LAPACK routine (version 3.0) --
117         Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
118         Courant Institute, Argonne National Lab, and Rice University
119         October 31, 1999.
120    *************************************************************************/
121    public static bool rmatrixbdsvd(ref double[] d,
122        double[] e,
123        int n,
124        bool isupper,
125        bool isfractionalaccuracyrequired,
126        ref double[,] u,
127        int nru,
128        ref double[,] c,
129        int ncc,
130        ref double[,] vt,
131        int ncvt)
132    {
133        bool result = new bool();
134        double[] d1 = new double[0];
135        double[] e1 = new double[0];
136        int i_ = 0;
137        int i1_ = 0;
138
139        e = (double[])e.Clone();
140
141        d1 = new double[n+1];
142        i1_ = (0) - (1);
143        for(i_=1; i_<=n;i_++)
144        {
145            d1[i_] = d[i_+i1_];
146        }
147        if( n>1 )
148        {
149            e1 = new double[n-1+1];
150            i1_ = (0) - (1);
151            for(i_=1; i_<=n-1;i_++)
152            {
153                e1[i_] = e[i_+i1_];
154            }
155        }
156        result = bidiagonalsvddecompositioninternal(ref d1, e1, n, isupper, isfractionalaccuracyrequired, ref u, 0, nru, ref c, 0, ncc, ref vt, 0, ncvt);
157        i1_ = (1) - (0);
158        for(i_=0; i_<=n-1;i_++)
159        {
160            d[i_] = d1[i_+i1_];
161        }
162        return result;
163    }
164
165
166    /*************************************************************************
167    Obsolete 1-based subroutine. See RMatrixBDSVD for 0-based replacement.
168
169    History:
170        * 31 March, 2007.
171            changed MAXITR from 6 to 12.
172
173      -- LAPACK routine (version 3.0) --
174         Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
175         Courant Institute, Argonne National Lab, and Rice University
176         October 31, 1999.
177    *************************************************************************/
178    public static bool bidiagonalsvddecomposition(ref double[] d,
179        double[] e,
180        int n,
181        bool isupper,
182        bool isfractionalaccuracyrequired,
183        ref double[,] u,
184        int nru,
185        ref double[,] c,
186        int ncc,
187        ref double[,] vt,
188        int ncvt)
189    {
190        bool result = new bool();
191
192        e = (double[])e.Clone();
193
194        result = bidiagonalsvddecompositioninternal(ref d, e, n, isupper, isfractionalaccuracyrequired, ref u, 1, nru, ref c, 1, ncc, ref vt, 1, ncvt);
195        return result;
196    }
197
198
199    /*************************************************************************
200    Internal working subroutine for bidiagonal decomposition
201    *************************************************************************/
202    private static bool bidiagonalsvddecompositioninternal(ref double[] d,
203        double[] e,
204        int n,
205        bool isupper,
206        bool isfractionalaccuracyrequired,
207        ref double[,] u,
208        int ustart,
209        int nru,
210        ref double[,] c,
211        int cstart,
212        int ncc,
213        ref double[,] vt,
214        int vstart,
215        int ncvt)
216    {
217        bool result = new bool();
218        int i = 0;
219        int idir = 0;
220        int isub = 0;
221        int iter = 0;
222        int j = 0;
223        int ll = 0;
224        int lll = 0;
225        int m = 0;
226        int maxit = 0;
227        int oldll = 0;
228        int oldm = 0;
229        double abse = 0;
230        double abss = 0;
231        double cosl = 0;
232        double cosr = 0;
233        double cs = 0;
234        double eps = 0;
235        double f = 0;
236        double g = 0;
237        double h = 0;
238        double mu = 0;
239        double oldcs = 0;
240        double oldsn = 0;
241        double r = 0;
242        double shift = 0;
243        double sigmn = 0;
244        double sigmx = 0;
245        double sinl = 0;
246        double sinr = 0;
247        double sll = 0;
248        double smax = 0;
249        double smin = 0;
250        double sminl = 0;
251        double sminlo = 0;
252        double sminoa = 0;
253        double sn = 0;
254        double thresh = 0;
255        double tol = 0;
256        double tolmul = 0;
257        double unfl = 0;
258        double[] work0 = new double[0];
259        double[] work1 = new double[0];
260        double[] work2 = new double[0];
261        double[] work3 = new double[0];
262        int maxitr = 0;
263        bool matrixsplitflag = new bool();
264        bool iterflag = new bool();
265        double[] utemp = new double[0];
266        double[] vttemp = new double[0];
267        double[] ctemp = new double[0];
268        double[] etemp = new double[0];
269        bool rightside = new bool();
270        bool fwddir = new bool();
271        double tmp = 0;
272        int mm1 = 0;
273        int mm0 = 0;
274        bool bchangedir = new bool();
275        int uend = 0;
276        int cend = 0;
277        int vend = 0;
278        int i_ = 0;
279
280        e = (double[])e.Clone();
281
282        result = true;
283        if( n==0 )
284        {
285            return result;
286        }
287        if( n==1 )
288        {
289            if( d[1]<0 )
290            {
291                d[1] = -d[1];
292                if( ncvt>0 )
293                {
294                    for(i_=vstart; i_<=vstart+ncvt-1;i_++)
295                    {
296                        vt[vstart,i_] = -1*vt[vstart,i_];
297                    }
298                }
299            }
300            return result;
301        }
302       
303        //
304        // init
305        //
306        work0 = new double[n-1+1];
307        work1 = new double[n-1+1];
308        work2 = new double[n-1+1];
309        work3 = new double[n-1+1];
310        uend = ustart+Math.Max(nru-1, 0);
311        vend = vstart+Math.Max(ncvt-1, 0);
312        cend = cstart+Math.Max(ncc-1, 0);
313        utemp = new double[uend+1];
314        vttemp = new double[vend+1];
315        ctemp = new double[cend+1];
316        maxitr = 12;
317        rightside = true;
318        fwddir = true;
319       
320        //
321        // resize E from N-1 to N
322        //
323        etemp = new double[n+1];
324        for(i=1; i<=n-1; i++)
325        {
326            etemp[i] = e[i];
327        }
328        e = new double[n+1];
329        for(i=1; i<=n-1; i++)
330        {
331            e[i] = etemp[i];
332        }
333        e[n] = 0;
334        idir = 0;
335       
336        //
337        // Get machine constants
338        //
339        eps = AP.Math.MachineEpsilon;
340        unfl = AP.Math.MinRealNumber;
341       
342        //
343        // If matrix lower bidiagonal, rotate to be upper bidiagonal
344        // by applying Givens rotations on the left
345        //
346        if( !isupper )
347        {
348            for(i=1; i<=n-1; i++)
349            {
350                rotations.generaterotation(d[i], e[i], ref cs, ref sn, ref r);
351                d[i] = r;
352                e[i] = sn*d[i+1];
353                d[i+1] = cs*d[i+1];
354                work0[i] = cs;
355                work1[i] = sn;
356            }
357           
358            //
359            // Update singular vectors if desired
360            //
361            if( nru>0 )
362            {
363                rotations.applyrotationsfromtheright(fwddir, ustart, uend, 1+ustart-1, n+ustart-1, ref work0, ref work1, ref u, ref utemp);
364            }
365            if( ncc>0 )
366            {
367                rotations.applyrotationsfromtheleft(fwddir, 1+cstart-1, n+cstart-1, cstart, cend, ref work0, ref work1, ref c, ref ctemp);
368            }
369        }
370       
371        //
372        // Compute singular values to relative accuracy TOL
373        // (By setting TOL to be negative, algorithm will compute
374        // singular values to absolute accuracy ABS(TOL)*norm(input matrix))
375        //
376        tolmul = Math.Max(10, Math.Min(100, Math.Pow(eps, -0.125)));
377        tol = tolmul*eps;
378        if( !isfractionalaccuracyrequired )
379        {
380            tol = -tol;
381        }
382       
383        //
384        // Compute approximate maximum, minimum singular values
385        //
386        smax = 0;
387        for(i=1; i<=n; i++)
388        {
389            smax = Math.Max(smax, Math.Abs(d[i]));
390        }
391        for(i=1; i<=n-1; i++)
392        {
393            smax = Math.Max(smax, Math.Abs(e[i]));
394        }
395        sminl = 0;
396        if( tol>=0 )
397        {
398           
399            //
400            // Relative accuracy desired
401            //
402            sminoa = Math.Abs(d[1]);
403            if( sminoa!=0 )
404            {
405                mu = sminoa;
406                for(i=2; i<=n; i++)
407                {
408                    mu = Math.Abs(d[i])*(mu/(mu+Math.Abs(e[i-1])));
409                    sminoa = Math.Min(sminoa, mu);
410                    if( sminoa==0 )
411                    {
412                        break;
413                    }
414                }
415            }
416            sminoa = sminoa/Math.Sqrt(n);
417            thresh = Math.Max(tol*sminoa, maxitr*n*n*unfl);
418        }
419        else
420        {
421           
422            //
423            // Absolute accuracy desired
424            //
425            thresh = Math.Max(Math.Abs(tol)*smax, maxitr*n*n*unfl);
426        }
427       
428        //
429        // Prepare for main iteration loop for the singular values
430        // (MAXIT is the maximum number of passes through the inner
431        // loop permitted before nonconvergence signalled.)
432        //
433        maxit = maxitr*n*n;
434        iter = 0;
435        oldll = -1;
436        oldm = -1;
437       
438        //
439        // M points to last element of unconverged part of matrix
440        //
441        m = n;
442       
443        //
444        // Begin main iteration loop
445        //
446        while( true )
447        {
448           
449            //
450            // Check for convergence or exceeding iteration count
451            //
452            if( m<=1 )
453            {
454                break;
455            }
456            if( iter>maxit )
457            {
458                result = false;
459                return result;
460            }
461           
462            //
463            // Find diagonal block of matrix to work on
464            //
465            if( tol<0 & Math.Abs(d[m])<=thresh )
466            {
467                d[m] = 0;
468            }
469            smax = Math.Abs(d[m]);
470            smin = smax;
471            matrixsplitflag = false;
472            for(lll=1; lll<=m-1; lll++)
473            {
474                ll = m-lll;
475                abss = Math.Abs(d[ll]);
476                abse = Math.Abs(e[ll]);
477                if( tol<0 & abss<=thresh )
478                {
479                    d[ll] = 0;
480                }
481                if( abse<=thresh )
482                {
483                    matrixsplitflag = true;
484                    break;
485                }
486                smin = Math.Min(smin, abss);
487                smax = Math.Max(smax, Math.Max(abss, abse));
488            }
489            if( !matrixsplitflag )
490            {
491                ll = 0;
492            }
493            else
494            {
495               
496                //
497                // Matrix splits since E(LL) = 0
498                //
499                e[ll] = 0;
500                if( ll==m-1 )
501                {
502                   
503                    //
504                    // Convergence of bottom singular value, return to top of loop
505                    //
506                    m = m-1;
507                    continue;
508                }
509            }
510            ll = ll+1;
511           
512            //
513            // E(LL) through E(M-1) are nonzero, E(LL-1) is zero
514            //
515            if( ll==m-1 )
516            {
517               
518                //
519                // 2 by 2 block, handle separately
520                //
521                svdv2x2(d[m-1], e[m-1], d[m], ref sigmn, ref sigmx, ref sinr, ref cosr, ref sinl, ref cosl);
522                d[m-1] = sigmx;
523                e[m-1] = 0;
524                d[m] = sigmn;
525               
526                //
527                // Compute singular vectors, if desired
528                //
529                if( ncvt>0 )
530                {
531                    mm0 = m+(vstart-1);
532                    mm1 = m-1+(vstart-1);
533                    for(i_=vstart; i_<=vend;i_++)
534                    {
535                        vttemp[i_] = cosr*vt[mm1,i_];
536                    }
537                    for(i_=vstart; i_<=vend;i_++)
538                    {
539                        vttemp[i_] = vttemp[i_] + sinr*vt[mm0,i_];
540                    }
541                    for(i_=vstart; i_<=vend;i_++)
542                    {
543                        vt[mm0,i_] = cosr*vt[mm0,i_];
544                    }
545                    for(i_=vstart; i_<=vend;i_++)
546                    {
547                        vt[mm0,i_] = vt[mm0,i_] - sinr*vt[mm1,i_];
548                    }
549                    for(i_=vstart; i_<=vend;i_++)
550                    {
551                        vt[mm1,i_] = vttemp[i_];
552                    }
553                }
554                if( nru>0 )
555                {
556                    mm0 = m+ustart-1;
557                    mm1 = m-1+ustart-1;
558                    for(i_=ustart; i_<=uend;i_++)
559                    {
560                        utemp[i_] = cosl*u[i_,mm1];
561                    }
562                    for(i_=ustart; i_<=uend;i_++)
563                    {
564                        utemp[i_] = utemp[i_] + sinl*u[i_,mm0];
565                    }
566                    for(i_=ustart; i_<=uend;i_++)
567                    {
568                        u[i_,mm0] = cosl*u[i_,mm0];
569                    }
570                    for(i_=ustart; i_<=uend;i_++)
571                    {
572                        u[i_,mm0] = u[i_,mm0] - sinl*u[i_,mm1];
573                    }
574                    for(i_=ustart; i_<=uend;i_++)
575                    {
576                        u[i_,mm1] = utemp[i_];
577                    }
578                }
579                if( ncc>0 )
580                {
581                    mm0 = m+cstart-1;
582                    mm1 = m-1+cstart-1;
583                    for(i_=cstart; i_<=cend;i_++)
584                    {
585                        ctemp[i_] = cosl*c[mm1,i_];
586                    }
587                    for(i_=cstart; i_<=cend;i_++)
588                    {
589                        ctemp[i_] = ctemp[i_] + sinl*c[mm0,i_];
590                    }
591                    for(i_=cstart; i_<=cend;i_++)
592                    {
593                        c[mm0,i_] = cosl*c[mm0,i_];
594                    }
595                    for(i_=cstart; i_<=cend;i_++)
596                    {
597                        c[mm0,i_] = c[mm0,i_] - sinl*c[mm1,i_];
598                    }
599                    for(i_=cstart; i_<=cend;i_++)
600                    {
601                        c[mm1,i_] = ctemp[i_];
602                    }
603                }
604                m = m-2;
605                continue;
606            }
607           
608            //
609            // If working on new submatrix, choose shift direction
610            // (from larger end diagonal element towards smaller)
611            //
612            // Previously was
613            //     "if (LL>OLDM) or (M<OLDLL) then"
614            // fixed thanks to Michael Rolle < m@rolle.name >
615            // Very strange that LAPACK still contains it.
616            //
617            bchangedir = false;
618            if( idir==1 & Math.Abs(d[ll])<1.0E-3*Math.Abs(d[m]) )
619            {
620                bchangedir = true;
621            }
622            if( idir==2 & Math.Abs(d[m])<1.0E-3*Math.Abs(d[ll]) )
623            {
624                bchangedir = true;
625            }
626            if( ll!=oldll | m!=oldm | bchangedir )
627            {
628                if( Math.Abs(d[ll])>=Math.Abs(d[m]) )
629                {
630                   
631                    //
632                    // Chase bulge from top (big end) to bottom (small end)
633                    //
634                    idir = 1;
635                }
636                else
637                {
638                   
639                    //
640                    // Chase bulge from bottom (big end) to top (small end)
641                    //
642                    idir = 2;
643                }
644            }
645           
646            //
647            // Apply convergence tests
648            //
649            if( idir==1 )
650            {
651               
652                //
653                // Run convergence test in forward direction
654                // First apply standard test to bottom of matrix
655                //
656                if( Math.Abs(e[m-1])<=Math.Abs(tol)*Math.Abs(d[m]) | tol<0 & Math.Abs(e[m-1])<=thresh )
657                {
658                    e[m-1] = 0;
659                    continue;
660                }
661                if( tol>=0 )
662                {
663                   
664                    //
665                    // If relative accuracy desired,
666                    // apply convergence criterion forward
667                    //
668                    mu = Math.Abs(d[ll]);
669                    sminl = mu;
670                    iterflag = false;
671                    for(lll=ll; lll<=m-1; lll++)
672                    {
673                        if( Math.Abs(e[lll])<=tol*mu )
674                        {
675                            e[lll] = 0;
676                            iterflag = true;
677                            break;
678                        }
679                        sminlo = sminl;
680                        mu = Math.Abs(d[lll+1])*(mu/(mu+Math.Abs(e[lll])));
681                        sminl = Math.Min(sminl, mu);
682                    }
683                    if( iterflag )
684                    {
685                        continue;
686                    }
687                }
688            }
689            else
690            {
691               
692                //
693                // Run convergence test in backward direction
694                // First apply standard test to top of matrix
695                //
696                if( Math.Abs(e[ll])<=Math.Abs(tol)*Math.Abs(d[ll]) | tol<0 & Math.Abs(e[ll])<=thresh )
697                {
698                    e[ll] = 0;
699                    continue;
700                }
701                if( tol>=0 )
702                {
703                   
704                    //
705                    // If relative accuracy desired,
706                    // apply convergence criterion backward
707                    //
708                    mu = Math.Abs(d[m]);
709                    sminl = mu;
710                    iterflag = false;
711                    for(lll=m-1; lll>=ll; lll--)
712                    {
713                        if( Math.Abs(e[lll])<=tol*mu )
714                        {
715                            e[lll] = 0;
716                            iterflag = true;
717                            break;
718                        }
719                        sminlo = sminl;
720                        mu = Math.Abs(d[lll])*(mu/(mu+Math.Abs(e[lll])));
721                        sminl = Math.Min(sminl, mu);
722                    }
723                    if( iterflag )
724                    {
725                        continue;
726                    }
727                }
728            }
729            oldll = ll;
730            oldm = m;
731           
732            //
733            // Compute shift.  First, test if shifting would ruin relative
734            // accuracy, and if so set the shift to zero.
735            //
736            if( tol>=0 & n*tol*(sminl/smax)<=Math.Max(eps, 0.01*tol) )
737            {
738               
739                //
740                // Use a zero shift to avoid loss of relative accuracy
741                //
742                shift = 0;
743            }
744            else
745            {
746               
747                //
748                // Compute the shift from 2-by-2 block at end of matrix
749                //
750                if( idir==1 )
751                {
752                    sll = Math.Abs(d[ll]);
753                    svd2x2(d[m-1], e[m-1], d[m], ref shift, ref r);
754                }
755                else
756                {
757                    sll = Math.Abs(d[m]);
758                    svd2x2(d[ll], e[ll], d[ll+1], ref shift, ref r);
759                }
760               
761                //
762                // Test if shift negligible, and if so set to zero
763                //
764                if( sll>0 )
765                {
766                    if( AP.Math.Sqr(shift/sll)<eps )
767                    {
768                        shift = 0;
769                    }
770                }
771            }
772           
773            //
774            // Increment iteration count
775            //
776            iter = iter+m-ll;
777           
778            //
779            // If SHIFT = 0, do simplified QR iteration
780            //
781            if( shift==0 )
782            {
783                if( idir==1 )
784                {
785                   
786                    //
787                    // Chase bulge from top to bottom
788                    // Save cosines and sines for later singular vector updates
789                    //
790                    cs = 1;
791                    oldcs = 1;
792                    for(i=ll; i<=m-1; i++)
793                    {
794                        rotations.generaterotation(d[i]*cs, e[i], ref cs, ref sn, ref r);
795                        if( i>ll )
796                        {
797                            e[i-1] = oldsn*r;
798                        }
799                        rotations.generaterotation(oldcs*r, d[i+1]*sn, ref oldcs, ref oldsn, ref tmp);
800                        d[i] = tmp;
801                        work0[i-ll+1] = cs;
802                        work1[i-ll+1] = sn;
803                        work2[i-ll+1] = oldcs;
804                        work3[i-ll+1] = oldsn;
805                    }
806                    h = d[m]*cs;
807                    d[m] = h*oldcs;
808                    e[m-1] = h*oldsn;
809                   
810                    //
811                    // Update singular vectors
812                    //
813                    if( ncvt>0 )
814                    {
815                        rotations.applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, ref work0, ref work1, ref vt, ref vttemp);
816                    }
817                    if( nru>0 )
818                    {
819                        rotations.applyrotationsfromtheright(fwddir, ustart, uend, ll+ustart-1, m+ustart-1, ref work2, ref work3, ref u, ref utemp);
820                    }
821                    if( ncc>0 )
822                    {
823                        rotations.applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, ref work2, ref work3, ref c, ref ctemp);
824                    }
825                   
826                    //
827                    // Test convergence
828                    //
829                    if( Math.Abs(e[m-1])<=thresh )
830                    {
831                        e[m-1] = 0;
832                    }
833                }
834                else
835                {
836                   
837                    //
838                    // Chase bulge from bottom to top
839                    // Save cosines and sines for later singular vector updates
840                    //
841                    cs = 1;
842                    oldcs = 1;
843                    for(i=m; i>=ll+1; i--)
844                    {
845                        rotations.generaterotation(d[i]*cs, e[i-1], ref cs, ref sn, ref r);
846                        if( i<m )
847                        {
848                            e[i] = oldsn*r;
849                        }
850                        rotations.generaterotation(oldcs*r, d[i-1]*sn, ref oldcs, ref oldsn, ref tmp);
851                        d[i] = tmp;
852                        work0[i-ll] = cs;
853                        work1[i-ll] = -sn;
854                        work2[i-ll] = oldcs;
855                        work3[i-ll] = -oldsn;
856                    }
857                    h = d[ll]*cs;
858                    d[ll] = h*oldcs;
859                    e[ll] = h*oldsn;
860                   
861                    //
862                    // Update singular vectors
863                    //
864                    if( ncvt>0 )
865                    {
866                        rotations.applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, ref work2, ref work3, ref vt, ref vttemp);
867                    }
868                    if( nru>0 )
869                    {
870                        rotations.applyrotationsfromtheright(!fwddir, ustart, uend, ll+ustart-1, m+ustart-1, ref work0, ref work1, ref u, ref utemp);
871                    }
872                    if( ncc>0 )
873                    {
874                        rotations.applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, ref work0, ref work1, ref c, ref ctemp);
875                    }
876                   
877                    //
878                    // Test convergence
879                    //
880                    if( Math.Abs(e[ll])<=thresh )
881                    {
882                        e[ll] = 0;
883                    }
884                }
885            }
886            else
887            {
888               
889                //
890                // Use nonzero shift
891                //
892                if( idir==1 )
893                {
894                   
895                    //
896                    // Chase bulge from top to bottom
897                    // Save cosines and sines for later singular vector updates
898                    //
899                    f = (Math.Abs(d[ll])-shift)*(extsignbdsqr(1, d[ll])+shift/d[ll]);
900                    g = e[ll];
901                    for(i=ll; i<=m-1; i++)
902                    {
903                        rotations.generaterotation(f, g, ref cosr, ref sinr, ref r);
904                        if( i>ll )
905                        {
906                            e[i-1] = r;
907                        }
908                        f = cosr*d[i]+sinr*e[i];
909                        e[i] = cosr*e[i]-sinr*d[i];
910                        g = sinr*d[i+1];
911                        d[i+1] = cosr*d[i+1];
912                        rotations.generaterotation(f, g, ref cosl, ref sinl, ref r);
913                        d[i] = r;
914                        f = cosl*e[i]+sinl*d[i+1];
915                        d[i+1] = cosl*d[i+1]-sinl*e[i];
916                        if( i<m-1 )
917                        {
918                            g = sinl*e[i+1];
919                            e[i+1] = cosl*e[i+1];
920                        }
921                        work0[i-ll+1] = cosr;
922                        work1[i-ll+1] = sinr;
923                        work2[i-ll+1] = cosl;
924                        work3[i-ll+1] = sinl;
925                    }
926                    e[m-1] = f;
927                   
928                    //
929                    // Update singular vectors
930                    //
931                    if( ncvt>0 )
932                    {
933                        rotations.applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, ref work0, ref work1, ref vt, ref vttemp);
934                    }
935                    if( nru>0 )
936                    {
937                        rotations.applyrotationsfromtheright(fwddir, ustart, uend, ll+ustart-1, m+ustart-1, ref work2, ref work3, ref u, ref utemp);
938                    }
939                    if( ncc>0 )
940                    {
941                        rotations.applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, ref work2, ref work3, ref c, ref ctemp);
942                    }
943                   
944                    //
945                    // Test convergence
946                    //
947                    if( Math.Abs(e[m-1])<=thresh )
948                    {
949                        e[m-1] = 0;
950                    }
951                }
952                else
953                {
954                   
955                    //
956                    // Chase bulge from bottom to top
957                    // Save cosines and sines for later singular vector updates
958                    //
959                    f = (Math.Abs(d[m])-shift)*(extsignbdsqr(1, d[m])+shift/d[m]);
960                    g = e[m-1];
961                    for(i=m; i>=ll+1; i--)
962                    {
963                        rotations.generaterotation(f, g, ref cosr, ref sinr, ref r);
964                        if( i<m )
965                        {
966                            e[i] = r;
967                        }
968                        f = cosr*d[i]+sinr*e[i-1];
969                        e[i-1] = cosr*e[i-1]-sinr*d[i];
970                        g = sinr*d[i-1];
971                        d[i-1] = cosr*d[i-1];
972                        rotations.generaterotation(f, g, ref cosl, ref sinl, ref r);
973                        d[i] = r;
974                        f = cosl*e[i-1]+sinl*d[i-1];
975                        d[i-1] = cosl*d[i-1]-sinl*e[i-1];
976                        if( i>ll+1 )
977                        {
978                            g = sinl*e[i-2];
979                            e[i-2] = cosl*e[i-2];
980                        }
981                        work0[i-ll] = cosr;
982                        work1[i-ll] = -sinr;
983                        work2[i-ll] = cosl;
984                        work3[i-ll] = -sinl;
985                    }
986                    e[ll] = f;
987                   
988                    //
989                    // Test convergence
990                    //
991                    if( Math.Abs(e[ll])<=thresh )
992                    {
993                        e[ll] = 0;
994                    }
995                   
996                    //
997                    // Update singular vectors if desired
998                    //
999                    if( ncvt>0 )
1000                    {
1001                        rotations.applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, ref work2, ref work3, ref vt, ref vttemp);
1002                    }
1003                    if( nru>0 )
1004                    {
1005                        rotations.applyrotationsfromtheright(!fwddir, ustart, uend, ll+ustart-1, m+ustart-1, ref work0, ref work1, ref u, ref utemp);
1006                    }
1007                    if( ncc>0 )
1008                    {
1009                        rotations.applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, ref work0, ref work1, ref c, ref ctemp);
1010                    }
1011                }
1012            }
1013           
1014            //
1015            // QR iteration finished, go back and check convergence
1016            //
1017            continue;
1018        }
1019       
1020        //
1021        // All singular values converged, so make them positive
1022        //
1023        for(i=1; i<=n; i++)
1024        {
1025            if( d[i]<0 )
1026            {
1027                d[i] = -d[i];
1028               
1029                //
1030                // Change sign of singular vectors, if desired
1031                //
1032                if( ncvt>0 )
1033                {
1034                    for(i_=vstart; i_<=vend;i_++)
1035                    {
1036                        vt[i+vstart-1,i_] = -1*vt[i+vstart-1,i_];
1037                    }
1038                }
1039            }
1040        }
1041       
1042        //
1043        // Sort the singular values into decreasing order (insertion sort on
1044        // singular values, but only one transposition per singular vector)
1045        //
1046        for(i=1; i<=n-1; i++)
1047        {
1048           
1049            //
1050            // Scan for smallest D(I)
1051            //
1052            isub = 1;
1053            smin = d[1];
1054            for(j=2; j<=n+1-i; j++)
1055            {
1056                if( d[j]<=smin )
1057                {
1058                    isub = j;
1059                    smin = d[j];
1060                }
1061            }
1062            if( isub!=n+1-i )
1063            {
1064               
1065                //
1066                // Swap singular values and vectors
1067                //
1068                d[isub] = d[n+1-i];
1069                d[n+1-i] = smin;
1070                if( ncvt>0 )
1071                {
1072                    j = n+1-i;
1073                    for(i_=vstart; i_<=vend;i_++)
1074                    {
1075                        vttemp[i_] = vt[isub+vstart-1,i_];
1076                    }
1077                    for(i_=vstart; i_<=vend;i_++)
1078                    {
1079                        vt[isub+vstart-1,i_] = vt[j+vstart-1,i_];
1080                    }
1081                    for(i_=vstart; i_<=vend;i_++)
1082                    {
1083                        vt[j+vstart-1,i_] = vttemp[i_];
1084                    }
1085                }
1086                if( nru>0 )
1087                {
1088                    j = n+1-i;
1089                    for(i_=ustart; i_<=uend;i_++)
1090                    {
1091                        utemp[i_] = u[i_,isub+ustart-1];
1092                    }
1093                    for(i_=ustart; i_<=uend;i_++)
1094                    {
1095                        u[i_,isub+ustart-1] = u[i_,j+ustart-1];
1096                    }
1097                    for(i_=ustart; i_<=uend;i_++)
1098                    {
1099                        u[i_,j+ustart-1] = utemp[i_];
1100                    }
1101                }
1102                if( ncc>0 )
1103                {
1104                    j = n+1-i;
1105                    for(i_=cstart; i_<=cend;i_++)
1106                    {
1107                        ctemp[i_] = c[isub+cstart-1,i_];
1108                    }
1109                    for(i_=cstart; i_<=cend;i_++)
1110                    {
1111                        c[isub+cstart-1,i_] = c[j+cstart-1,i_];
1112                    }
1113                    for(i_=cstart; i_<=cend;i_++)
1114                    {
1115                        c[j+cstart-1,i_] = ctemp[i_];
1116                    }
1117                }
1118            }
1119        }
1120        return result;
1121    }
1122
1123
1124    private static double extsignbdsqr(double a,
1125        double b)
1126    {
1127        double result = 0;
1128
1129        if( b>=0 )
1130        {
1131            result = Math.Abs(a);
1132        }
1133        else
1134        {
1135            result = -Math.Abs(a);
1136        }
1137        return result;
1138    }
1139
1140
1141    private static void svd2x2(double f,
1142        double g,
1143        double h,
1144        ref double ssmin,
1145        ref double ssmax)
1146    {
1147        double aas = 0;
1148        double at = 0;
1149        double au = 0;
1150        double c = 0;
1151        double fa = 0;
1152        double fhmn = 0;
1153        double fhmx = 0;
1154        double ga = 0;
1155        double ha = 0;
1156
1157        fa = Math.Abs(f);
1158        ga = Math.Abs(g);
1159        ha = Math.Abs(h);
1160        fhmn = Math.Min(fa, ha);
1161        fhmx = Math.Max(fa, ha);
1162        if( fhmn==0 )
1163        {
1164            ssmin = 0;
1165            if( fhmx==0 )
1166            {
1167                ssmax = ga;
1168            }
1169            else
1170            {
1171                ssmax = Math.Max(fhmx, ga)*Math.Sqrt(1+AP.Math.Sqr(Math.Min(fhmx, ga)/Math.Max(fhmx, ga)));
1172            }
1173        }
1174        else
1175        {
1176            if( ga<fhmx )
1177            {
1178                aas = 1+fhmn/fhmx;
1179                at = (fhmx-fhmn)/fhmx;
1180                au = AP.Math.Sqr(ga/fhmx);
1181                c = 2/(Math.Sqrt(aas*aas+au)+Math.Sqrt(at*at+au));
1182                ssmin = fhmn*c;
1183                ssmax = fhmx/c;
1184            }
1185            else
1186            {
1187                au = fhmx/ga;
1188                if( au==0 )
1189                {
1190                   
1191                    //
1192                    // Avoid possible harmful underflow if exponent range
1193                    // asymmetric (true SSMIN may not underflow even if
1194                    // AU underflows)
1195                    //
1196                    ssmin = fhmn*fhmx/ga;
1197                    ssmax = ga;
1198                }
1199                else
1200                {
1201                    aas = 1+fhmn/fhmx;
1202                    at = (fhmx-fhmn)/fhmx;
1203                    c = 1/(Math.Sqrt(1+AP.Math.Sqr(aas*au))+Math.Sqrt(1+AP.Math.Sqr(at*au)));
1204                    ssmin = fhmn*c*au;
1205                    ssmin = ssmin+ssmin;
1206                    ssmax = ga/(c+c);
1207                }
1208            }
1209        }
1210    }
1211
1212
1213    private static void svdv2x2(double f,
1214        double g,
1215        double h,
1216        ref double ssmin,
1217        ref double ssmax,
1218        ref double snr,
1219        ref double csr,
1220        ref double snl,
1221        ref double csl)
1222    {
1223        bool gasmal = new bool();
1224        bool swp = new bool();
1225        int pmax = 0;
1226        double a = 0;
1227        double clt = 0;
1228        double crt = 0;
1229        double d = 0;
1230        double fa = 0;
1231        double ft = 0;
1232        double ga = 0;
1233        double gt = 0;
1234        double ha = 0;
1235        double ht = 0;
1236        double l = 0;
1237        double m = 0;
1238        double mm = 0;
1239        double r = 0;
1240        double s = 0;
1241        double slt = 0;
1242        double srt = 0;
1243        double t = 0;
1244        double temp = 0;
1245        double tsign = 0;
1246        double tt = 0;
1247        double v = 0;
1248
1249        ft = f;
1250        fa = Math.Abs(ft);
1251        ht = h;
1252        ha = Math.Abs(h);
1253       
1254        //
1255        // PMAX points to the maximum absolute element of matrix
1256        //  PMAX = 1 if F largest in absolute values
1257        //  PMAX = 2 if G largest in absolute values
1258        //  PMAX = 3 if H largest in absolute values
1259        //
1260        pmax = 1;
1261        swp = ha>fa;
1262        if( swp )
1263        {
1264           
1265            //
1266            // Now FA .ge. HA
1267            //
1268            pmax = 3;
1269            temp = ft;
1270            ft = ht;
1271            ht = temp;
1272            temp = fa;
1273            fa = ha;
1274            ha = temp;
1275        }
1276        gt = g;
1277        ga = Math.Abs(gt);
1278        if( ga==0 )
1279        {
1280           
1281            //
1282            // Diagonal matrix
1283            //
1284            ssmin = ha;
1285            ssmax = fa;
1286            clt = 1;
1287            crt = 1;
1288            slt = 0;
1289            srt = 0;
1290        }
1291        else
1292        {
1293            gasmal = true;
1294            if( ga>fa )
1295            {
1296                pmax = 2;
1297                if( fa/ga<AP.Math.MachineEpsilon )
1298                {
1299                   
1300                    //
1301                    // Case of very large GA
1302                    //
1303                    gasmal = false;
1304                    ssmax = ga;
1305                    if( ha>1 )
1306                    {
1307                        v = ga/ha;
1308                        ssmin = fa/v;
1309                    }
1310                    else
1311                    {
1312                        v = fa/ga;
1313                        ssmin = v*ha;
1314                    }
1315                    clt = 1;
1316                    slt = ht/gt;
1317                    srt = 1;
1318                    crt = ft/gt;
1319                }
1320            }
1321            if( gasmal )
1322            {
1323               
1324                //
1325                // Normal case
1326                //
1327                d = fa-ha;
1328                if( d==fa )
1329                {
1330                    l = 1;
1331                }
1332                else
1333                {
1334                    l = d/fa;
1335                }
1336                m = gt/ft;
1337                t = 2-l;
1338                mm = m*m;
1339                tt = t*t;
1340                s = Math.Sqrt(tt+mm);
1341                if( l==0 )
1342                {
1343                    r = Math.Abs(m);
1344                }
1345                else
1346                {
1347                    r = Math.Sqrt(l*l+mm);
1348                }
1349                a = 0.5*(s+r);
1350                ssmin = ha/a;
1351                ssmax = fa*a;
1352                if( mm==0 )
1353                {
1354                   
1355                    //
1356                    // Note that M is very tiny
1357                    //
1358                    if( l==0 )
1359                    {
1360                        t = extsignbdsqr(2, ft)*extsignbdsqr(1, gt);
1361                    }
1362                    else
1363                    {
1364                        t = gt/extsignbdsqr(d, ft)+m/t;
1365                    }
1366                }
1367                else
1368                {
1369                    t = (m/(s+t)+m/(r+l))*(1+a);
1370                }
1371                l = Math.Sqrt(t*t+4);
1372                crt = 2/l;
1373                srt = t/l;
1374                clt = (crt+srt*m)/a;
1375                v = ht/ft;
1376                slt = v*srt/a;
1377            }
1378        }
1379        if( swp )
1380        {
1381            csl = srt;
1382            snl = crt;
1383            csr = slt;
1384            snr = clt;
1385        }
1386        else
1387        {
1388            csl = clt;
1389            snl = slt;
1390            csr = crt;
1391            snr = srt;
1392        }
1393       
1394        //
1395        // Correct signs of SSMAX and SSMIN
1396        //
1397        if( pmax==1 )
1398        {
1399            tsign = extsignbdsqr(1, csr)*extsignbdsqr(1, csl)*extsignbdsqr(1, f);
1400        }
1401        if( pmax==2 )
1402        {
1403            tsign = extsignbdsqr(1, snr)*extsignbdsqr(1, csl)*extsignbdsqr(1, g);
1404        }
1405        if( pmax==3 )
1406        {
1407            tsign = extsignbdsqr(1, snr)*extsignbdsqr(1, snl)*extsignbdsqr(1, h);
1408        }
1409        ssmax = extsignbdsqr(ssmax, tsign);
1410        ssmin = extsignbdsqr(ssmin, tsign*extsignbdsqr(1, f)*extsignbdsqr(1, h));
1411    }
1412}
Note: See TracBrowser for help on using the repository browser.