Statistiques
| Révision :

root / tmp / org.txm.analec.rcp / src matt / JamaPlus / SparseSVD.java @ 2891

Historique | Voir | Annoter | Télécharger (31,55 ko)

1
/*
2
 * To change this template, choose Tools | Templates
3
 * and open the template in the editor.
4
 */
5
package JamaPlus;
6

    
7
import JamaPlus.util.*;
8
import java.util.*;
9

    
10
/**
11
 *
12
 * @author Bernard Victorri
13
 */
14
public class SparseSVD {  // based on code adapted from SVDLIBC - svdLAS2 (adapted from SVDPACKC)
15
  private boolean transpose; // si transposition de la matrice en entrée
16
  private int rows, cols, dim; // nb rows, nb cols, nb de val sing. désirées
17
  // (après transposition éventuelle)
18
  private double[][] Ut; // (d x m) transpose of left singular vectors (rows of Ut)
19
  private double[][] Vt; // (d x n) transpose of right singular vectors (rows of Vt)
20
  private double[] S; // d singular values
21
  /* Constantes */
22
  private final static int MAXLL = 2; // ??
23
  private final static double[] END = {-1e-30, 1e-30};
24
  private final static double EPS = Machine.eps(); // precision de la machine
25
  private final static double RAD_EPS = Math.sqrt(EPS);
26
  private final static double RAD34_EPS = RAD_EPS*Math.sqrt(RAD_EPS);
27
  private final static double KAPPA = Math.max(RAD34_EPS, 1e-6);
28
  private double EPS1;  // = precision * sqrt(nbcols)
29
  /* Variables de travail : mémoire à libérer en fin de calcul */
30
  private double[] alph;  // diagonale de la matrice tridiagonale T
31
  private double[] bet; // éléments hors-diagonale de T
32
  private double[] ritz; // valeurs propres de la  projection de A'A sur l'espace de Krylov
33
  private double[] bnd; // a vérifier : initialisation (127) nécessaire ?? 
34
  private double[] rj ;
35
  private  double[] qj;
36
  private  double[] qj1;
37
  private  double[] pj ;
38
  private  double[] pj1;
39
  private  double[] wk;
40
   private   double[] eta; 
41
  private  double[] oldeta; 
42

    
43

    
44
//    private static int irandom = 0;  // deboguage : à supprimer
45

    
46
  private static class Storage {  // store Lanczos vectors q(j) 
47
    private double[][] P, Q;  // P supplementary storage for j < MAXLL (j= 0 or 1)
48

    
49
    private Storage(int nb, int maxll) {
50
      P = new double[maxll][];
51
      Q = new double[nb][];
52
    }
53

    
54
    private void storeP(int n, int j, double[] p) {
55
      if (P[j]==null) P[j] = new double[n];
56
      System.arraycopy(p, 0, P[j], 0, n);
57
    }
58

    
59
    private void storeQ(int n, int j, double[] q) {
60
      if (Q[j]==null) Q[j] = new double[n];
61
      System.arraycopy(q, 0, Q[j], 0, n);
62
    }
63

    
64
    private void retrieveP(int n, int j, double[] p) {
65
      System.arraycopy(P[j], 0, p, 0, n);
66
    }
67

    
68
    private void retrieveQ(int n, int j, double[] q) {
69
      System.arraycopy(Q[j], 0, q, 0, n);
70
    }
71
  }
72
  private Storage storage;
73

    
74
 public enum CodeSVDException {
75
   DIM_OUT_OF_BOUNDS ("Nombre de valeurs singulières désirées invalide"),
76
   FIRST_STEP_FAILURE("Impossible d'initialiser le premier pas de calcul"),
77
   CONVERGENCE_FAILURE("Echec de convergence ");
78
   String message;
79
  CodeSVDException(String message) {
80
   this.message = message;
81
 }
82
 }
83
  public static class SparseSVDException extends Exception { // Erreurs
84
    private CodeSVDException code;
85
    private int k;
86

    
87
    private SparseSVDException(CodeSVDException code, int k) {
88
      super();
89
      this.code = code;
90
      this.k = k;
91
    }
92

    
93
    public CodeSVDException getCode() {
94
      return code;
95
    }
96

    
97
    public int getK() {
98
      return k;
99
    }
100

    
101
    @Override
102
    public String getMessage() {
103
      return super.getMessage()+"\ncode = "+getCode().message +", n = "+getK();
104
    }
105
  }
106

    
107
  public SparseSVD(SparseMatrix spm, int d) throws SparseSVDException {
108
    int iter = Math.min(spm.getRowDimension(), spm.getColumnDimension()); // nb d'itérations 
109
    if (d<=0 || d>iter)
110
      throw new SparseSVDException(CodeSVDException.DIM_OUT_OF_BOUNDS, d);
111
    dim = d;
112
    transpose = spm.getColumnDimension()>=spm.getRowDimension()*1.2;
113
    SparseMatrix A = transpose ? spm.transpose() : spm.copy();
114
    rows = A.getRowDimension();
115
    cols = A.getColumnDimension();
116
    EPS1 = EPS*Math.sqrt(cols);
117
    alph = new double[iter];  // diagonale de la matrice tridiagonale T
118
    bet = new double[iter+1]; // éléments hors-diagonale de T
119
    ritz = new double[iter+1];
120
    bnd = new double[iter+1]; // a vérifier : initialisation (127) nécessaire ?? 
121
    storage = new Storage(iter, MAXLL);
122
    // Calcul de la matrice tridiagonale 
123
    int[] steps_neig_ = lanso(A, iter);
124
    Ut = new double[dim][rows];
125
    Vt = new double[dim][cols];
126
    S = new double[dim];
127
    // Calcul des  vecteurs propres
128
    //  nsig  : nb de val. propres "kappa-acceptables"
129
    int nsig = ritvec(A, steps_neig_);
130
    if (nsig<dim) dim = nsig;  // moins de valeurs obtenues que demandées
131
    // libère la mémoire
132
    storage = null;
133
    alph =  bet = ritz = bnd = null;
134

    
135
  }
136

    
137
  private int[] lanso(SparseMatrix A, int iter) throws SparseSVDException {
138
    // Calcul de la matrice tridiagonale
139
    int neig = 0;
140
    // espace de travail
141
    rj = new double[cols];
142
    qj = new double[cols];
143
     qj1 = new double[cols];
144
     pj = new double[cols];
145
     pj1 = new double[cols];
146
     wk = new double[cols];
147
    // step one 
148
    double[] rnm_tol_ = stpone(A, cols); // initialise rmn et tol
149
     eta = new double[iter]; // orthogonality estimate of Lanczos vectors
150
    oldeta = new double[iter];
151
    if (rnm_tol_[0]==0) {
152
      ritz[0] = alph[0];
153
      storage.storeQ(cols, 0, qj);
154
      return new int[]{0, 1}; // steps = 0 et neig = 1
155
    }
156
    eta[0] = oldeta[0] = EPS1;
157
    boolean[] enough_ = {false}; // flag de sortie de boucle
158
    int steps = 0; // j = steps
159
    int[] ll_ = {0};  // 0, 1 or 2 initial Lanczos vectors in local orthog.
160
    int first = 1;
161
    int last = Math.min(dim+Math.max(8, dim), iter);  // = iter dans notre version
162
    int i, l;
163
    int intro = 0;
164
    while (!enough_[0]) {
165
      steps = lanczos_step(A, first, last, 
166
              ll_, enough_, rnm_tol_, cols);
167
      steps = enough_[0] ? steps-1 : last-1;
168
      first = steps+1;
169
      bet[first] = rnm_tol_[0];
170
      // analyse T
171
      l = 0;
172
      for (int id2 = 0; id2<steps; id2++) {
173
        if (l>steps) break;
174
        for (i = l; i<=steps; i++) if (bet[i+1]==0) break;
175
        if (i>steps) i = steps;
176
        // now i is at the end of an unreduced submatrix
177
        DoubleArraysPlus.copyReverse(i-l+1, alph, l, ritz, l);
178
        DoubleArraysPlus.copyReverse(i-l, bet, l+1, wk, l+1);
179
        imtqlb(i-l+1, l, ritz, wk, bnd);
180
        for (int id3 = l; id3<=i; id3++)
181
          bnd[id3] = rnm_tol_[0]*Math.abs(bnd[id3]);
182
        l = i+1;
183
      }
184
      // sort eigenvalues into increasing order
185
      DoubleArraysPlus.sort2(ritz, bnd, steps+1, 0);
186
      // massage error bounds for very close ritz values 
187
      neig = error_bound(enough_, END[0], END[1], steps, rnm_tol_[1]);
188
      // should we stop? 
189
      if (neig<dim) {
190
        if (neig==0) {
191
          last = first+9;
192
          intro = first;
193
        } else {
194
          last = first+Math.max(3, 1+((steps-intro)*(dim-neig))/neig);
195
        }
196
        last = Math.min(last, iter);
197
      } else {
198
        enough_[0] = true;
199
      }
200
      enough_[0] = enough_[0]||first>=iter;
201
    }
202
    storage.storeQ(cols, steps, qj);
203
    // libère la mémoire
204
     rj = qj =  qj1 = pj =  pj1 =  wk = null;
205
     eta = oldeta = null;
206
    return new int[]{steps, neig};
207
  }
208

    
209
  private double[] stpone(SparseMatrix A,  int n)
210
          throws SparseSVDException {
211
    /*  stp-one performs the first step of the Lanczos algorithm.  It also
212
    does a step of extended local re-orthogonalization.
213
    Arguments 
214
    (input)
215
    n      dimension of the eigenproblem for matrix B
216
    (output)
217
    wptr   array of pointers that point to work space that contains
218
    wptr[0]             r[j]
219
    wptr[1]             q[j]
220
    wptr[2]             q[j-1]
221
    wptr[3]             p
222
    wptr[4]             p[j-1]
223
    alph             diagonal elements of matrix T 
224
    throw a SparseSVDException(-1) if the choice of initial vector (startv) failed
225
     */
226
    // get initial normalized vector; default is random 
227
    startv0(A, n);
228
    System.arraycopy(pj, 0, qj, 0, n);
229
    // take the first step   
230
    A.opb(pj, rj);
231
    alph[0] = DoubleArraysPlus.dot(rj, pj);
232
    for (int i = 0; i<n; i++) rj[i] -= alph[0]*qj[i];
233
    /* extended local reorthogonalization */
234
    double t = DoubleArraysPlus.dot(rj, pj);
235
    for (int i = 0; i<n; i++) rj[i] -= t*qj[i];
236
    alph[0] += t;
237
    System.arraycopy(rj, 0, pj1, 0, n);
238
    double rnm = Math.sqrt(DoubleArraysPlus.dot(pj1, pj1));
239
    double tol = RAD_EPS*(rnm+Math.abs(alph[0]));
240
    return new double[]{rnm, tol};
241
  }
242

    
243
//  private static double random2() {
244
//    double x = 0.11*(++irandom);
245
//    return x-Math.floor(x);
246
//  }
247
//
248
private void startv0(SparseMatrix A, int n)
249
          throws SparseSVDException {
250
    /* startv delivers a starting normalized vector in r, 
251
     * and throws a SparseSVDException(-1) if no starting vector can be found.
252
    Parameters 
253
    (input)
254
    n      dimension of the eigenproblem matrix B
255
    wptr   array of pointers that point to work space
256
    step      starting index for a Lanczos run
257
    (output)
258
    wptr   array of pointers that point to work space that contains
259
    r[j], q[j], q[j-1], p[j], p[j-1]
260
     */
261
// get initial vector; default is random
262
    double rnm2 = 0;
263
    Random random = new Random(918273);
264
    for (int id = 0; id<3; id++) {
265
      for (int i = 0; i<n; i++) wk[i]  = random.nextDouble(); 
266
      // apply operator to put r in range (essential if m singular)
267
      A.opb(wk, pj);
268
      rnm2 = DoubleArraysPlus.dot(pj, pj);
269
      if (rnm2>0) break;
270
    }
271
    // normalize
272
    if (rnm2<=0) throw new SparseSVDException(CodeSVDException.FIRST_STEP_FAILURE, 0);
273
    rnm2 = 1/Math.sqrt(rnm2);
274
    for (int i = 0; i<n; i++) pj[i] *= rnm2;
275
  }
276

    
277
  private int lanczos_step(SparseMatrix A, int first, int last,int[] ll_,   
278
          boolean[] enough_, double[] rnm_tol_, int n) throws SparseSVDException {
279
    /*   embodies a single Lanczos step
280
    Arguments 
281
    (input)
282
    n        dimension of the eigenproblem for matrix B
283
    first    start of index through loop                                      
284
    last     end of index through loop                                     
285
    wptr            array of pointers pointing to work space                    
286
    alf            array to hold diagonal of the tridiagonal matrix T
287
    eta      orthogonality estimate of Lanczos vectors at step j   
288
    oldeta   orthogonality estimate of Lanczos vectors at step j-1
289
    bet      array to hold off-diagonal of T                     
290
    ll       number of intitial Lanczos vectors in local orthog. 
291
    (has value of 0, 1 or 2)                        
292
    enough   stop flag                        
293
     */
294
    int j;
295
    double t;
296
    double mid[];
297
    for (j = first; j<last; j++) {
298
      mid = qj1;
299
      qj1 = qj;
300
      qj = mid;
301
      mid = pj;
302
      pj = pj1;
303
      pj1 = mid;
304
      storage.storeQ(n, j-1, qj1);
305
      if (j-1<MAXLL) storage.storeP(n, j-1, pj1);
306
      bet[j] = rnm_tol_[0];
307

    
308
      // restart if invariant subspace is found 
309
      if (bet[j]==0) {
310
        rnm_tol_[0] = startv(A, j, n);
311
        if (rnm_tol_[0]==0) enough_[0] = true;
312
      }
313
      if (enough_[0]) {
314
        /* added by Doug... */
315
        /* These lines fix a bug that occurs with low-rank matrices */
316
        mid = qj1;
317
        qj1 = qj;
318
        qj = mid;
319
        /* ...added by Doug */
320
        break;
321
      }
322
      /* take a lanczos step */
323
      t = 1.0/rnm_tol_[0];
324
      for (int i = 0; i<n; i++) qj[i] = t*rj[i];
325
      for (int i = 0; i<n; i++) pj[i] *= t;
326
      A.opb(pj, rj);
327
      for (int i = 0; i<n; i++) rj[i] -= rnm_tol_[0]*qj1[i];
328
      alph[j] = DoubleArraysPlus.dot(rj, pj);
329
      for (int i = 0; i<n; i++) rj[i] -= alph[j]*qj[i];
330
      /* orthogonalize against initial lanczos vectors */
331
      if (j<=MAXLL&&(Math.abs(alph[j-1])>4.0*Math.abs(alph[j])))
332
        ll_[0] = j;
333
      for (int i = 0; i<Math.min(ll_[0], j-1); i++) {
334
        storage.retrieveP(n, i, wk);
335
        t = DoubleArraysPlus.dot(wk, rj);
336
        storage.retrieveQ(n, i, wk);
337
        for (int ii = 0; ii<n; ii++) rj[ii] -= t*wk[ii];
338
        oldeta[i] = eta[i] = EPS1;
339
      }
340
      /* extended local reorthogonalization */
341
      t = DoubleArraysPlus.dot(rj, pj1);
342
      for (int i = 0; i<n; i++) rj[i] -= t*qj1[i];
343
      if (bet[j]>0) bet[j] += t;
344
      t = DoubleArraysPlus.dot(rj, pj);
345
      for (int i = 0; i<n; i++) rj[i] -= t*qj[i];
346
      alph[j] += t;
347
      System.arraycopy(rj, 0, pj1, 0, n);
348
      rnm_tol_[0] = Math.sqrt(DoubleArraysPlus.dot(rj, pj1));
349
      rnm_tol_[1] = RAD_EPS*(bet[j]+Math.abs(alph[j])+rnm_tol_[0]);
350
      /* update the orthogonality bounds */
351
      ortbnd(j, rnm_tol_[0]);
352
      /* restore the orthogonality state when needed */
353
      purge(n, ll_[0], j, rnm_tol_);
354
      if (rnm_tol_[0]<=rnm_tol_[1]) rnm_tol_[0] = 0;
355
    }
356
    return j;
357
  }
358

    
359
  private double startv(SparseMatrix A, int step, int n)
360
          throws SparseSVDException {
361
    /* startv delivers a starting vector in r and returns |r|; it returns 
362
    zero if the range is spanned, and throws a SparseSVDException(-1) if no starting 
363
    vector within range of operator can be found.
364
    Parameters 
365
    (input)
366
    n      dimension of the eigenproblem matrix B
367
    wptr   array of pointers that point to work space
368
    step      starting index for a Lanczos run
369
    (output)
370
    wptr   array of pointers that point to work space that contains
371
    r[j], q[j], q[j-1], p[j], p[j-1]
372
     */
373
// get initial vector; default is random
374
    double rnm2 = DoubleArraysPlus.dot(rj, rj);
375
    Random random = new Random(918273+step);
376
    for (int id = 0; id<3; id++) {
377
      for (int i = 0; i<n; i++) rj[i] = random.nextDouble();
378
      System.arraycopy(rj, 0, pj, 0, n);
379
      // apply operator to put r in range (essential if m singular)
380
      A.opb(pj, rj);
381
      System.arraycopy(rj, 0, pj, 0, n);
382
      rnm2 = DoubleArraysPlus.dot(rj, pj);
383
      if (rnm2>0) break;
384
    }
385
    if (rnm2<=0) throw new SparseSVDException(CodeSVDException.FIRST_STEP_FAILURE, 0);
386
    double t;
387
    for (int j = 0; j<step; j++) {
388
      storage.retrieveQ(n, j, wk);
389
      t = -DoubleArraysPlus.dot(pj, wk);
390
      for (int i = 0; i<n; i++) rj[i] += t*wk[i];
391
    }
392
    // make sure q[step] is orthogonal to q[step-1] 
393
    t = DoubleArraysPlus.dot(pj1, rj);
394
    for (int i = 0; i<n; i++) rj[i] -= t*qj1[i];
395
    System.arraycopy(rj, 0, pj, 0, n);
396
    t = DoubleArraysPlus.dot(pj, rj);
397
    if (t<=EPS*rnm2) rnm2 = 0;
398
    else rnm2 = t;
399
    return Math.sqrt(rnm2);
400
  }
401

    
402
  private void ortbnd(int step, double rnm) {
403
    /*  updates the eta recurrence
404
    Arguments 
405
    (input)
406
    alf      array to hold diagonal of the tridiagonal matrix T         
407
    eta      orthogonality estimate of Lanczos vectors at step j        
408
    oldeta   orthogonality estimate of Lanczos vectors at step j-1     
409
    bet      array to hold off-diagonal of T                          
410
    n        dimension of the eigenproblem for matrix B                    
411
    j        dimension of T                                          
412
    rnm            norm of the next residual vector                         
413
    eps1            roundoff estimate for dot product of two unit vectors
414
    (output)
415
    eta      orthogonality estimate of Lanczos vectors at step j+1     
416
    oldeta   orthogonality estimate of Lanczos vectors at step j        
417
     */
418
    if (step<1) return;
419
    if (rnm!=0) {
420
      if (step>1)
421
        oldeta[0] = (bet[1]*eta[1]+(alph[0]-alph[step])*eta[0]
422
                -bet[step]*oldeta[0])/rnm+EPS1;
423
      for (int i = 1; i<=step-2; i++)
424
        oldeta[i] = (bet[i+1]*eta[i+1]+(alph[i]-alph[step])*eta[i]
425
                +bet[i]*eta[i-1]-bet[step]*oldeta[i])/rnm+EPS1;
426
    }
427
    oldeta[step-1] = EPS1;
428
    double t;
429
    for (int i = 0; i<step; i++) {
430
      t = oldeta[i];
431
      oldeta[i] = eta[i];
432
      eta[i] = t;
433
    }
434
    eta[step] = EPS1;
435
  }
436

    
437
  private void purge(int n, int ll, int step, double[] rnm_tol_) {
438
    /*
439
    purge examines the state of orthogonality between the new Lanczos
440
    vector and the previous ones to decide whether re-orthogonalization 
441
    should be performed
442
    Arguments 
443
    (input)
444
    n        dimension of the eigenproblem for matrix B                       
445
    ll       number of intitial Lanczos vectors in local orthog.       
446
    r        residual vector to become next Lanczos vector            
447
    q        current Lanczos vector                                   
448
    ra       previous Lanczos vector
449
    qa       previous Lanczos vector
450
    wrk      temporary vector to hold the previous Lanczos vector
451
    eta      state of orthogonality between r and prev. Lanczos vectors 
452
    oldeta   state of orthogonality between q and prev. Lanczos vectors
453
    j        current Lanczos step                                     
454
    (output)
455
    r            residual vector orthogonalized against previous Lanczos 
456
    vectors
457
    q        current Lanczos vector orthogonalized against previous ones    
458
     */
459
    if (step<ll+2) return;
460
    int k = DoubleArraysPlus.indAbsMax(step-(ll+1), eta, ll);
461
    if (Math.abs(eta[k])<=RAD_EPS) return;
462
    double REPS1 = EPS1/RAD_EPS;
463
    double t;
464
    for (int iteration = 0; iteration<2; iteration++) {
465
      if (rnm_tol_[0]<=rnm_tol_[1]) break;
466
      /* bring in a lanczos vector t and orthogonalize both 
467
       * r and q against it */
468
      double tq = 0;
469
      double tr = 0;
470
      for (int i = ll; i<step; i++) {
471
        storage.retrieveQ(n, i, wk);
472
        t = -DoubleArraysPlus.dot(pj, wk);
473
        tq += Math.abs(t);
474
        for (int ii = 0; ii<n; ii++) qj[ii] += t*wk[ii];
475
        t = -DoubleArraysPlus.dot(pj1, wk);
476
        tr += Math.abs(t);
477
        for (int ii = 0; ii<n; ii++) rj[ii] += t*wk[ii];
478
      }
479
      System.arraycopy(qj, 0, pj, 0, n);
480
      t = -DoubleArraysPlus.dot(rj, pj);
481
      tr += Math.abs(t);
482
      for (int i = 0; i<n; i++) rj[i] += t*qj[i];
483
      System.arraycopy(rj, 0, pj1, 0, n);
484
      rnm_tol_[0] = Math.sqrt(DoubleArraysPlus.dot(pj1, rj));
485
      if (tq<=REPS1&&tr<=REPS1*rnm_tol_[0]) break;
486
    }
487
    for (int i = ll; i<=step; i++) {
488
      eta[i] = EPS1;
489
      oldeta[i] = EPS1;
490
    }
491
  }
492

    
493
  private static void imtqlb(int n, int i0, double[] d, double[] e, double[] bnd)
494
          throws SparseSVDException {
495
    /*   imtqlb() finds the eigenvalues of a symmetric tridiagonal
496
    matrix by the implicit QL method.
497
    Arguments 
498
    (input)
499
    n      order of the symmetric tridiagonal matrix   
500
    d      contains the diagonal elements of the input matrix           
501
    e      contains the subdiagonal elements of the input matrix in its
502
    last n-1 positions.  e[0] is arbitrary
503
    i0   starting index for the 3 vectors
504
    (elements with index < i0 or >= i0+n are preserved)
505
    (output)
506
    d      contains the eigenvalues in ascending order.  if an error
507
    exit is made, the eigenvalues are correct and ordered for
508
    indices 0,1,...ierr, but may not be the smallest eigenvalues.
509
    e      has been destroyed.                                            
510
    throws a SparseSVDException(j) if the j-th eigenvalue has
511
    not been determined after 30 iterations.                    
512
     */
513
    if (n==1) return;
514
    bnd[i0] = 1;
515
    for (int i = i0+1; i<i0+n; i++) {
516
      bnd[i] = 0;
517
      e[i-1] = e[i];
518
    }
519
    e[i0+n-1] = 0;
520
    for (int l = i0; l<i0+n; l++) {
521
      for (int iteration = 0; iteration<=30; iteration++) {
522
        double p = d[l];
523
        double f = bnd[l];
524
        int m;
525
        for (m = l; m<i0+n-1; m++) { // test de convergence
526
          double test = Math.abs(d[m])+Math.abs(d[m+1]);
527
          if (test+Math.abs(e[m])==test) break;
528
        }
529
        if (m==l) {
530
          d[l] = p;
531
          bnd[l] = f;
532
          /* order the eigenvalues */
533
          DoubleArraysPlus.sort2(d, bnd, l-i0+1, i0);
534
          break;
535
        } else {
536
          if (iteration==30) throw new SparseSVDException(CodeSVDException.CONVERGENCE_FAILURE, l);
537
          /*........ form shift ........*/
538
          double g = (d[l+1]-p)/(2.0*e[l]);
539
          double r = Math.hypot(g, 1);
540
          g = d[m]-p+e[l]/(g+Math.copySign(r, g));
541
          double s = 1;
542
          double c = 1;
543
          p = 0;
544
          boolean underflow = false;
545
          for (int i = m-1; i>=l; i--) {
546
            f = s*e[i];
547
            double b = c*e[i];
548
            r = Math.hypot(f, g);
549
            e[i+1] = r;
550
            if (r==0) {
551
              /*........ recover from underflow .........*/
552
              underflow = true;
553
              d[i+1] -= p;
554
              e[m] = 0.0;
555
              break;
556
            }
557
            s = f/r;
558
            c = g/r;
559
            g = d[i+1]-p;
560
            r = (d[i]-g)*s+2*c*b;
561
            p = s*r;
562
            d[i+1] = g+p;
563
            g = c*r-b;
564
            f = bnd[i+1];
565
            bnd[i+1] = s*bnd[i]+c*f;
566
            bnd[i] = c*bnd[i]-s*f;
567
          }
568

    
569
          if (!underflow) {
570
            d[l] -= p;
571
            e[l] = g;
572
            e[m] = 0.0;
573
          }
574
        }
575
      }
576
    }
577
  }
578

    
579
  private int error_bound(boolean[] enough_, double endl, double endr,
580
          int step, double tol) {
581
    /*
582
    massages error bounds for very close ritz values by placing 
583
    a gap between them.  The error bounds are then refined to reflect this.
584
    Arguments 
585
    (input)
586
    endl     left end of interval containing unwanted eigenvalues
587
    endr     right end of interval containing unwanted eigenvalues
588
    ritz     array to store the ritz values
589
    bnd      array to store the error bounds
590
    enough   stop flag
591
     */
592
    int mid = DoubleArraysPlus.indAbsMax(step+1, bnd, 1);
593

    
594
    for (int i = step; i>mid; i--)
595
      if (Math.abs(ritz[i-1]-ritz[i])<RAD34_EPS*Math.abs(ritz[i]))
596
        if (bnd[i]>tol&&bnd[i-1]>tol) {
597
          bnd[i-1] = Math.hypot(bnd[i], bnd[i-1]);
598
          bnd[i] = 0;
599
        }
600
    for (int i = 1; i<mid; i++)
601
      if (Math.abs(ritz[i+1]-ritz[i])<RAD34_EPS*Math.abs(ritz[i]))
602
        if (bnd[i]>tol&&bnd[i+1]>tol) {
603
          bnd[i+1] = Math.hypot(bnd[i], bnd[i+1]);
604
          bnd[i] = 0.0;
605
        }
606
    /* refine the error bounds */
607
    int neig = 0;
608
    double gapl = ritz[step]-ritz[0];
609
    for (int i = 0; i<=step; i++) {
610
      double gap = gapl;
611
      if (i<step) gapl = ritz[i+1]-ritz[i];
612
      gap = Math.min(gap, gapl);
613
      if (gap>bnd[i]) bnd[i] *= (bnd[i]/gap);
614
      if (bnd[i]<=16.0*EPS*Math.abs(ritz[i])) {
615
        neig++;
616
        if (!enough_[0]) enough_[0] = endl<ritz[i]&&ritz[i]<endr;
617
      }
618
    }
619
    return neig;
620
  }
621

    
622
  private int ritvec0(SparseMatrix A, int[] steps_neig_) throws SparseSVDException {
623

    
624
    int js, jsq, i, k, /*size,*/ id2, tmp, nsig, x;
625
    double[] s, xv2;
626
    double tmp0, tmp1, xnorm;
627
    double[] w1 = Vt[0];
628
    double[] w2 = new double[cols];
629

    
630
    js = steps_neig_[0]+1;
631
    jsq = js*js;
632
    /*size = sizeof(double) * n;*/
633

    
634
    s = new double[jsq];
635
    xv2 = new double[cols];
636

    
637
    /* initialize s to an identity matrix */
638
    for (i = 0; i<jsq; i += (js+1)) s[i] = 1.0;
639
    DoubleArraysPlus.copyReverse(js, alph, 0, w1, 0);
640
    DoubleArraysPlus.copyReverse(steps_neig_[0], bet, 1, w2, 1);
641

    
642
    /* on return from imtql2(), w1 contains eigenvalues in ascending 
643
     * order and s contains the corresponding eigenvectors */
644
    double[][] z = new double[js][js];
645
    for (int r = 0; r<js; r++) for (int c = 0; c<js; c++) z[r][c] = s[r*js+c];
646
    imtql2(js, js, w1, w2, z);
647
    for (int r = 0; r<js; r++) for (int c = 0; c<js; c++) s[r*js+c] = z[r][c];
648

    
649

    
650
    /*fwrite((char *)&n, sizeof(n), 1, fp_out2);
651
    fwrite((char *)&js, sizeof(js), 1, fp_out2);
652
    fwrite((char *)&kappa, sizeof(kappa), 1, fp_out2);*/
653
    /*id = 0;*/
654
    nsig = 0;
655
    x = 0;
656
    id2 = jsq-js;
657
    for (k = 0; k<js; k++) {
658
      tmp = id2;
659
      if (bnd[k]<=KAPPA*Math.abs(ritz[k])&&k>js-steps_neig_[1]-1) {
660
        if (--x<0) x = dim-1;
661
        w1 = Vt[x];
662
        for (i = 0; i<cols; i++) w1[i] = 0.0;
663
        for (i = 0; i<js; i++) {
664
          storage.retrieveQ(cols, i, w2);
665
          for (int ii = 0; ii<cols; ii++) w1[ii] += s[tmp]*w2[ii];
666
          tmp -= js;
667
        }
668
        /*fwrite((char *)w1, size, 1, fp_out2);*/
669

    
670
        /* store the w1 vector row-wise in array xv1;   
671
         * size of xv1 is (steps+1) * (nrow+ncol) elements 
672
         * and each vector, even though only ncol long,
673
         * will have (nrow+ncol) elements in xv1.      
674
         * It is as if xv1 is a 2-d array (steps+1) by     
675
         * (nrow+ncol) and each vector occupies a row  */
676

    
677
        /* j is the index in the R arrays, which are sorted by high to low 
678
        singular values. */
679

    
680
        /*for (i = 0; i < n; i++) R->Vt->value[x]xv1[id++] = w1[i];*/
681
        /*id += nrow;*/
682
        nsig++;
683
      }
684
      id2++;
685
    }
686
    s = null;
687

    
688
    /* Rotate the singular vectors and values. */
689
    /* x is now the location of the highest singular value. */
690
    DoubleArraysPlus.rotateArray(Vt, x);
691
    dim = Math.min(dim, nsig);
692
    for (x = 0; x<dim; x++) {
693
      /* multiply by matrix B first */
694
      A.opb(Vt[x], xv2);
695
      tmp0 = DoubleArraysPlus.dot(Vt[x], xv2);
696
      for (int ii = 0; ii<cols; ii++) xv2[ii] -= tmp0*Vt[x][ii];
697
      tmp0 = Math.sqrt(tmp0);
698
      xnorm = Math.sqrt(DoubleArraysPlus.dot(xv2, xv2));
699

    
700
      /* multiply by matrix A to get (scaled) left s-vector */
701
      A.opa(Vt[x], Ut[x]);
702
      tmp1 = 1.0/tmp0;
703
      for (int ii = 0; ii<rows; ii++) Ut[x][ii] *= tmp1;
704
      xnorm *= tmp1;
705
      bnd[i] = xnorm;
706
      S[x] = tmp0;
707
    }
708

    
709
    xv2 = w2 = null;
710
    return nsig;
711
    /* multiply by matrix A to get (scaled) left s-vector */
712

    
713
  }
714

    
715
  private int ritvec(SparseMatrix A, int[] steps_neig_) throws SparseSVDException {
716
    //  computes the singular vectors of matrix A               *
717
/*  Parameters
718
    (input)
719
    nrow       number of rows of A
720
    steps      number of Lanczos iterations performed
721
    fp_out2    pointer to unformatted output file
722
    n              dimension of matrix A
723
    kappa      relative accuracy of ritz values acceptable as 
724
    eigenvalues of A'A
725
    ritz       array of ritz values
726
    bnd        array of error bounds
727
    alf        array of diagonal elements of the tridiagonal matrix T
728
    bet        array of off-diagonal elements of T
729
    w1, w2     work space
730
    (output)
731
    xv1        array of eigenvectors of A'A (right singular vectors of A)
732
    ierr              error code
733
    0 for normal return from imtql2()
734
    k if convergence did not occur for k-th eigenvalue in
735
    imtql2()
736
    nsig       number of accepted ritz values based on kappa
737
    (local)
738
    s              work array which is initialized to the identity matrix
739
    of order (j + 1) upon calling imtql2().  After the call,
740
    s contains the orthonormal eigenvectors of the symmetric 
741
    tridiagonal matrix T
742
     */
743
    // int n = cols;
744

    
745
    double[] w1 = Vt[0];
746
    double[] w2 = new double[cols];
747
    int js = steps_neig_[0]+1;
748
    double[][] s = new double[js][js];
749
    double[] xv2 = new double[cols];
750
    /* initialize s to an identity matrix */
751
    for (int i = 0; i<js; i++) s[i][i] = 1;
752
    DoubleArraysPlus.copyReverse(js, alph, 0, w1, 0);
753
    DoubleArraysPlus.copyReverse(steps_neig_[0], bet, 1, w2, 1);
754
    /* on return from imtql2(), w1 contains eigenvalues in ascending 
755
     * order and s contains the corresponding eigenvectors */
756
    imtql2(js, js, w1, w2, s);
757
    int nsig = 0;
758
    int x = 0;
759
    for (int k = 0; k<js; k++) {
760
      if (bnd[k]<=KAPPA*Math.abs(ritz[k])&&k>js-steps_neig_[1]-1) {
761
        if (--x<0) x = dim-1;
762
        w1 = Vt[x];
763
        for (int i = 0; i<cols; i++) w1[i] = 0;
764
        for (int i = 0; i<js; i++) {
765
          storage.retrieveQ(cols, i, w2);
766
          for (int ii = 0; ii<cols; ii++) w1[ii] += s[k][js-1-i]*w2[ii];
767
        }
768
        /*fwrite((char *)w1, size, 1, fp_out2);*/
769

    
770
        /* store the w1 vector row-wise in array xv1;   
771
         * size of xv1 is (steps+1) * (nrow+ncol) elements 
772
         * and each vector, even though only ncol long,
773
         * will have (nrow+ncol) elements in xv1.      
774
         * It is as if xv1 is a 2-d array (steps+1) by     
775
         * (nrow+ncol) and each vector occupies a row  */
776

    
777
        /* j is the index in the R arrays, which are sorted by high to low 
778
        singular values. */
779

    
780
        /*for (i = 0; i < n; i++) R->Vt->value[x]xv1[id++] = w1[i];*/
781
        /*id += nrow;*/
782
        nsig++;
783
      }
784
    }
785
    s = null;  // libère la mémoire
786
  /* Rotate the singular vectors and values. */
787
    /* x is now the location of the highest singular value. */
788
    DoubleArraysPlus.rotateArray(Vt, x);
789
    int d = Math.min(dim, nsig);
790
    for (x = 0; x<d; x++) {
791
      /* multiply by matrix B first */
792
      A.opb(Vt[x], xv2);
793
      double tmp0 = DoubleArraysPlus.dot(Vt[x], xv2);
794
      for (int i = 0; i<cols; i++) xv2[i] -= tmp0*Vt[x][i];
795
      tmp0 = Math.sqrt(tmp0);
796
      double xnorm = Math.sqrt(DoubleArraysPlus.dot(xv2, xv2));
797
      /* multiply by matrix A to get (scaled) left s-vector */
798
      A.opa(Vt[x], Ut[x]);
799
      double tmp1 = 1/tmp0;
800
      for (int i = 0; i<rows; i++) Ut[x][i] *= tmp1;
801
      xnorm *= tmp1;
802
      //   bnd[i] = xnorm; bizarre ??
803
      S[x] = tmp0;
804
    }
805
    xv2 = w2 = null;
806
    return nsig;
807
  }
808

    
809
  private static void imtql2(int nm, int n, double d[], double[] e, double[][] z)
810
          throws SparseSVDException {
811
    /*   imtqlb() finds the eigenvalues  and eigenvectors of a symmetric tridiagonal
812
    matrix by the implicit QL method.
813
    Arguments 
814
    (input)
815
    nm     row dimension of the symmetric tridiagonal matrix   
816
    n      order of the symmetric tridiagonal matrix   
817
    d      contains the diagonal elements of the input matrix           
818
    e      contains the subdiagonal elements of the input matrix in its
819
    last n-1 positions.  e[0] is arbitrary
820
    z      contains the identity matrix
821
    (output)
822
    d      contains the eigenvalues in ascending order.  if an error
823
    exit is made, the eigenvalues are correct but unordered for
824
    indices 0,1,...ierr.
825
    e      has been destroyed.                                            
826
    z      contains orthonormal eigenvectors of the symmetric   
827
    tridiagonal (or full) matrix.  if an error exit is made,
828
    z contains the eigenvectors associated with the stored 
829
    eigenvalues.                                        
830
    throws a SparseSVDException(j) if the j-th eigenvalue has
831
    not been determined after 30 iterations.                    
832
     */
833
    if (n==1) return;
834
    for (int i = 1; i<n; i++) e[i-1] = e[i];
835
    e[n-1] = 0.0;
836
    int nnm = n*nm;
837
    for (int l = 0; l<n; l++) {
838
      /* look for small sub-diagonal element */
839
      for (int iteration = 0; iteration<=30; iteration++) {
840
        double p = d[l];
841
        int m;
842
        for (m = l; m<n-1; m++) {// test de convergence
843
          double test = Math.abs(d[m])+Math.abs(d[m+1]);
844
          if (test+Math.abs(e[m])==test) break;
845
        }
846
        if (m==l) break;
847
        /* set error -- no convergence to an eigenvalue after
848
         * 30 iterations. */
849
        if (iteration==30) throw new SparseSVDException(CodeSVDException.CONVERGENCE_FAILURE, l);
850
        /* form shift */
851
        double g = (d[l+1]-p)/(2*e[l]);
852
        double r = Math.hypot(g, 1);
853
        g = d[m]-p+e[l]/(g+Math.copySign(r, g));
854
        double s = 1;
855
        double c = 1;
856
        p = 0;
857
        boolean underflow = false;
858
        for (int i = m-1; i>=l; i--) {
859
          double f = s*e[i];
860
          double b = c*e[i];
861
          r = Math.hypot(f, g);
862
          e[i+1] = r;
863
          if (r==0) {
864
            /*........ recover from underflow .........*/
865
            underflow = true;
866
            d[i+1] -= p;
867
            e[m] = 0.0;
868
            break;
869
          }
870
          s = f/r;
871
          c = g/r;
872
          g = d[i+1]-p;
873
          r = (d[i]-g)*s+2*c*b;
874
          p = s*r;
875
          d[i+1] = g+p;
876
          g = c*r-b;
877
          /* form vector */
878
          for (int k = 0; k<nm; k++) {
879
            f = z[i+1][k];
880
            z[i+1][k] = s*z[i][k]+c*f;
881
            z[i][k] = c*z[i][k]-s*f;
882
          }
883
        }
884
        if (!underflow) {
885
          d[l] -= p;
886
          e[l] = g;
887
          e[m] = 0.0;
888
        }
889
      }
890
    }
891
    /* order the eigenvalues and corresponding eigenvectors */
892
    DoubleArraysPlus.sort2(d, z, n, 0);
893
  }
894

    
895
  /* ------------------------
896
  Public Methods
897
   * ------------------------ */
898
  /** Return the left singular vectors
899
  @return     U
900
   */
901
  public Matrix getU() {
902
    return transpose ? (new Matrix(Vt, dim, cols)).transpose()
903
            : (new Matrix(Ut, dim, rows)).transpose();
904
  }
905

    
906
  /** Return the right singular vectors
907
  @return     V
908
   */
909
  public Matrix getV() {
910
    return transpose ? (new Matrix(Ut, dim, rows)).transpose()
911
            : (new Matrix(Vt, dim, cols)).transpose();
912
  }
913

    
914
  /** Return the one-dimensional array of singular values
915
  @return     diagonal of S.
916
   */
917
  public double[] getSingularValues() {
918
    return Arrays.copyOfRange(S, 0, dim);
919
  }
920
}