Statistiques
| Révision :

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

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

1 481 mdecorde
/*
2 481 mdecorde
 * To change this template, choose Tools | Templates
3 481 mdecorde
 * and open the template in the editor.
4 481 mdecorde
 */
5 481 mdecorde
package JamaPlus;
6 481 mdecorde
7 481 mdecorde
import JamaPlus.util.*;
8 481 mdecorde
import java.util.*;
9 481 mdecorde
10 481 mdecorde
/**
11 481 mdecorde
 *
12 481 mdecorde
 * @author Bernard Victorri
13 481 mdecorde
 */
14 481 mdecorde
public class SparseSVD {  // based on code adapted from SVDLIBC - svdLAS2 (adapted from SVDPACKC)
15 481 mdecorde
  private boolean transpose; // si transposition de la matrice en entrée
16 481 mdecorde
  private int rows, cols, dim; // nb rows, nb cols, nb de val sing. désirées
17 481 mdecorde
  // (après transposition éventuelle)
18 481 mdecorde
  private double[][] Ut; // (d x m) transpose of left singular vectors (rows of Ut)
19 481 mdecorde
  private double[][] Vt; // (d x n) transpose of right singular vectors (rows of Vt)
20 481 mdecorde
  private double[] S; // d singular values
21 481 mdecorde
  /* Constantes */
22 481 mdecorde
  private final static int MAXLL = 2; // ??
23 481 mdecorde
  private final static double[] END = {-1e-30, 1e-30};
24 481 mdecorde
  private final static double EPS = Machine.eps(); // precision de la machine
25 481 mdecorde
  private final static double RAD_EPS = Math.sqrt(EPS);
26 481 mdecorde
  private final static double RAD34_EPS = RAD_EPS*Math.sqrt(RAD_EPS);
27 481 mdecorde
  private final static double KAPPA = Math.max(RAD34_EPS, 1e-6);
28 481 mdecorde
  private double EPS1;  // = precision * sqrt(nbcols)
29 481 mdecorde
  /* Variables de travail : mémoire à libérer en fin de calcul */
30 481 mdecorde
  private double[] alph;  // diagonale de la matrice tridiagonale T
31 481 mdecorde
  private double[] bet; // éléments hors-diagonale de T
32 481 mdecorde
  private double[] ritz; // valeurs propres de la  projection de A'A sur l'espace de Krylov
33 481 mdecorde
  private double[] bnd; // a vérifier : initialisation (127) nécessaire ??
34 481 mdecorde
  private double[] rj ;
35 481 mdecorde
  private  double[] qj;
36 481 mdecorde
  private  double[] qj1;
37 481 mdecorde
  private  double[] pj ;
38 481 mdecorde
  private  double[] pj1;
39 481 mdecorde
  private  double[] wk;
40 481 mdecorde
   private   double[] eta;
41 481 mdecorde
  private  double[] oldeta;
42 481 mdecorde
43 481 mdecorde
44 481 mdecorde
//    private static int irandom = 0;  // deboguage : à supprimer
45 481 mdecorde
46 481 mdecorde
  private static class Storage {  // store Lanczos vectors q(j)
47 481 mdecorde
    private double[][] P, Q;  // P supplementary storage for j < MAXLL (j= 0 or 1)
48 481 mdecorde
49 481 mdecorde
    private Storage(int nb, int maxll) {
50 481 mdecorde
      P = new double[maxll][];
51 481 mdecorde
      Q = new double[nb][];
52 481 mdecorde
    }
53 481 mdecorde
54 481 mdecorde
    private void storeP(int n, int j, double[] p) {
55 481 mdecorde
      if (P[j]==null) P[j] = new double[n];
56 481 mdecorde
      System.arraycopy(p, 0, P[j], 0, n);
57 481 mdecorde
    }
58 481 mdecorde
59 481 mdecorde
    private void storeQ(int n, int j, double[] q) {
60 481 mdecorde
      if (Q[j]==null) Q[j] = new double[n];
61 481 mdecorde
      System.arraycopy(q, 0, Q[j], 0, n);
62 481 mdecorde
    }
63 481 mdecorde
64 481 mdecorde
    private void retrieveP(int n, int j, double[] p) {
65 481 mdecorde
      System.arraycopy(P[j], 0, p, 0, n);
66 481 mdecorde
    }
67 481 mdecorde
68 481 mdecorde
    private void retrieveQ(int n, int j, double[] q) {
69 481 mdecorde
      System.arraycopy(Q[j], 0, q, 0, n);
70 481 mdecorde
    }
71 481 mdecorde
  }
72 481 mdecorde
  private Storage storage;
73 481 mdecorde
74 481 mdecorde
 public enum CodeSVDException {
75 481 mdecorde
   DIM_OUT_OF_BOUNDS ("Nombre de valeurs singulières désirées invalide"),
76 481 mdecorde
   FIRST_STEP_FAILURE("Impossible d'initialiser le premier pas de calcul"),
77 481 mdecorde
   CONVERGENCE_FAILURE("Echec de convergence ");
78 481 mdecorde
   String message;
79 481 mdecorde
  CodeSVDException(String message) {
80 481 mdecorde
   this.message = message;
81 481 mdecorde
 }
82 481 mdecorde
 }
83 481 mdecorde
  public static class SparseSVDException extends Exception { // Erreurs
84 481 mdecorde
    private CodeSVDException code;
85 481 mdecorde
    private int k;
86 481 mdecorde
87 481 mdecorde
    private SparseSVDException(CodeSVDException code, int k) {
88 481 mdecorde
      super();
89 481 mdecorde
      this.code = code;
90 481 mdecorde
      this.k = k;
91 481 mdecorde
    }
92 481 mdecorde
93 481 mdecorde
    public CodeSVDException getCode() {
94 481 mdecorde
      return code;
95 481 mdecorde
    }
96 481 mdecorde
97 481 mdecorde
    public int getK() {
98 481 mdecorde
      return k;
99 481 mdecorde
    }
100 481 mdecorde
101 481 mdecorde
    @Override
102 481 mdecorde
    public String getMessage() {
103 481 mdecorde
      return super.getMessage()+"\ncode = "+getCode().message +", n = "+getK();
104 481 mdecorde
    }
105 481 mdecorde
  }
106 481 mdecorde
107 481 mdecorde
  public SparseSVD(SparseMatrix spm, int d) throws SparseSVDException {
108 481 mdecorde
    int iter = Math.min(spm.getRowDimension(), spm.getColumnDimension()); // nb d'itérations
109 481 mdecorde
    if (d<=0 || d>iter)
110 481 mdecorde
      throw new SparseSVDException(CodeSVDException.DIM_OUT_OF_BOUNDS, d);
111 481 mdecorde
    dim = d;
112 481 mdecorde
    transpose = spm.getColumnDimension()>=spm.getRowDimension()*1.2;
113 481 mdecorde
    SparseMatrix A = transpose ? spm.transpose() : spm.copy();
114 481 mdecorde
    rows = A.getRowDimension();
115 481 mdecorde
    cols = A.getColumnDimension();
116 481 mdecorde
    EPS1 = EPS*Math.sqrt(cols);
117 481 mdecorde
    alph = new double[iter];  // diagonale de la matrice tridiagonale T
118 481 mdecorde
    bet = new double[iter+1]; // éléments hors-diagonale de T
119 481 mdecorde
    ritz = new double[iter+1];
120 481 mdecorde
    bnd = new double[iter+1]; // a vérifier : initialisation (127) nécessaire ??
121 481 mdecorde
    storage = new Storage(iter, MAXLL);
122 481 mdecorde
    // Calcul de la matrice tridiagonale
123 481 mdecorde
    int[] steps_neig_ = lanso(A, iter);
124 481 mdecorde
    Ut = new double[dim][rows];
125 481 mdecorde
    Vt = new double[dim][cols];
126 481 mdecorde
    S = new double[dim];
127 481 mdecorde
    // Calcul des  vecteurs propres
128 481 mdecorde
    //  nsig  : nb de val. propres "kappa-acceptables"
129 481 mdecorde
    int nsig = ritvec(A, steps_neig_);
130 481 mdecorde
    if (nsig<dim) dim = nsig;  // moins de valeurs obtenues que demandées
131 481 mdecorde
    // libère la mémoire
132 481 mdecorde
    storage = null;
133 481 mdecorde
    alph =  bet = ritz = bnd = null;
134 481 mdecorde
135 481 mdecorde
  }
136 481 mdecorde
137 481 mdecorde
  private int[] lanso(SparseMatrix A, int iter) throws SparseSVDException {
138 481 mdecorde
    // Calcul de la matrice tridiagonale
139 481 mdecorde
    int neig = 0;
140 481 mdecorde
    // espace de travail
141 481 mdecorde
    rj = new double[cols];
142 481 mdecorde
    qj = new double[cols];
143 481 mdecorde
     qj1 = new double[cols];
144 481 mdecorde
     pj = new double[cols];
145 481 mdecorde
     pj1 = new double[cols];
146 481 mdecorde
     wk = new double[cols];
147 481 mdecorde
    // step one
148 481 mdecorde
    double[] rnm_tol_ = stpone(A, cols); // initialise rmn et tol
149 481 mdecorde
     eta = new double[iter]; // orthogonality estimate of Lanczos vectors
150 481 mdecorde
    oldeta = new double[iter];
151 481 mdecorde
    if (rnm_tol_[0]==0) {
152 481 mdecorde
      ritz[0] = alph[0];
153 481 mdecorde
      storage.storeQ(cols, 0, qj);
154 481 mdecorde
      return new int[]{0, 1}; // steps = 0 et neig = 1
155 481 mdecorde
    }
156 481 mdecorde
    eta[0] = oldeta[0] = EPS1;
157 481 mdecorde
    boolean[] enough_ = {false}; // flag de sortie de boucle
158 481 mdecorde
    int steps = 0; // j = steps
159 481 mdecorde
    int[] ll_ = {0};  // 0, 1 or 2 initial Lanczos vectors in local orthog.
160 481 mdecorde
    int first = 1;
161 481 mdecorde
    int last = Math.min(dim+Math.max(8, dim), iter);  // = iter dans notre version
162 481 mdecorde
    int i, l;
163 481 mdecorde
    int intro = 0;
164 481 mdecorde
    while (!enough_[0]) {
165 481 mdecorde
      steps = lanczos_step(A, first, last,
166 481 mdecorde
              ll_, enough_, rnm_tol_, cols);
167 481 mdecorde
      steps = enough_[0] ? steps-1 : last-1;
168 481 mdecorde
      first = steps+1;
169 481 mdecorde
      bet[first] = rnm_tol_[0];
170 481 mdecorde
      // analyse T
171 481 mdecorde
      l = 0;
172 481 mdecorde
      for (int id2 = 0; id2<steps; id2++) {
173 481 mdecorde
        if (l>steps) break;
174 481 mdecorde
        for (i = l; i<=steps; i++) if (bet[i+1]==0) break;
175 481 mdecorde
        if (i>steps) i = steps;
176 481 mdecorde
        // now i is at the end of an unreduced submatrix
177 481 mdecorde
        DoubleArraysPlus.copyReverse(i-l+1, alph, l, ritz, l);
178 481 mdecorde
        DoubleArraysPlus.copyReverse(i-l, bet, l+1, wk, l+1);
179 481 mdecorde
        imtqlb(i-l+1, l, ritz, wk, bnd);
180 481 mdecorde
        for (int id3 = l; id3<=i; id3++)
181 481 mdecorde
          bnd[id3] = rnm_tol_[0]*Math.abs(bnd[id3]);
182 481 mdecorde
        l = i+1;
183 481 mdecorde
      }
184 481 mdecorde
      // sort eigenvalues into increasing order
185 481 mdecorde
      DoubleArraysPlus.sort2(ritz, bnd, steps+1, 0);
186 481 mdecorde
      // massage error bounds for very close ritz values
187 481 mdecorde
      neig = error_bound(enough_, END[0], END[1], steps, rnm_tol_[1]);
188 481 mdecorde
      // should we stop?
189 481 mdecorde
      if (neig<dim) {
190 481 mdecorde
        if (neig==0) {
191 481 mdecorde
          last = first+9;
192 481 mdecorde
          intro = first;
193 481 mdecorde
        } else {
194 481 mdecorde
          last = first+Math.max(3, 1+((steps-intro)*(dim-neig))/neig);
195 481 mdecorde
        }
196 481 mdecorde
        last = Math.min(last, iter);
197 481 mdecorde
      } else {
198 481 mdecorde
        enough_[0] = true;
199 481 mdecorde
      }
200 481 mdecorde
      enough_[0] = enough_[0]||first>=iter;
201 481 mdecorde
    }
202 481 mdecorde
    storage.storeQ(cols, steps, qj);
203 481 mdecorde
    // libère la mémoire
204 481 mdecorde
     rj = qj =  qj1 = pj =  pj1 =  wk = null;
205 481 mdecorde
     eta = oldeta = null;
206 481 mdecorde
    return new int[]{steps, neig};
207 481 mdecorde
  }
208 481 mdecorde
209 481 mdecorde
  private double[] stpone(SparseMatrix A,  int n)
210 481 mdecorde
          throws SparseSVDException {
211 481 mdecorde
    /*  stp-one performs the first step of the Lanczos algorithm.  It also
212 481 mdecorde
    does a step of extended local re-orthogonalization.
213 481 mdecorde
    Arguments
214 481 mdecorde
    (input)
215 481 mdecorde
    n      dimension of the eigenproblem for matrix B
216 481 mdecorde
    (output)
217 481 mdecorde
    wptr   array of pointers that point to work space that contains
218 481 mdecorde
    wptr[0]             r[j]
219 481 mdecorde
    wptr[1]             q[j]
220 481 mdecorde
    wptr[2]             q[j-1]
221 481 mdecorde
    wptr[3]             p
222 481 mdecorde
    wptr[4]             p[j-1]
223 481 mdecorde
    alph             diagonal elements of matrix T
224 481 mdecorde
    throw a SparseSVDException(-1) if the choice of initial vector (startv) failed
225 481 mdecorde
     */
226 481 mdecorde
    // get initial normalized vector; default is random
227 481 mdecorde
    startv0(A, n);
228 481 mdecorde
    System.arraycopy(pj, 0, qj, 0, n);
229 481 mdecorde
    // take the first step
230 481 mdecorde
    A.opb(pj, rj);
231 481 mdecorde
    alph[0] = DoubleArraysPlus.dot(rj, pj);
232 481 mdecorde
    for (int i = 0; i<n; i++) rj[i] -= alph[0]*qj[i];
233 481 mdecorde
    /* extended local reorthogonalization */
234 481 mdecorde
    double t = DoubleArraysPlus.dot(rj, pj);
235 481 mdecorde
    for (int i = 0; i<n; i++) rj[i] -= t*qj[i];
236 481 mdecorde
    alph[0] += t;
237 481 mdecorde
    System.arraycopy(rj, 0, pj1, 0, n);
238 481 mdecorde
    double rnm = Math.sqrt(DoubleArraysPlus.dot(pj1, pj1));
239 481 mdecorde
    double tol = RAD_EPS*(rnm+Math.abs(alph[0]));
240 481 mdecorde
    return new double[]{rnm, tol};
241 481 mdecorde
  }
242 481 mdecorde
243 481 mdecorde
//  private static double random2() {
244 481 mdecorde
//    double x = 0.11*(++irandom);
245 481 mdecorde
//    return x-Math.floor(x);
246 481 mdecorde
//  }
247 481 mdecorde
//
248 481 mdecorde
private void startv0(SparseMatrix A, int n)
249 481 mdecorde
          throws SparseSVDException {
250 481 mdecorde
    /* startv delivers a starting normalized vector in r,
251 481 mdecorde
     * and throws a SparseSVDException(-1) if no starting vector can be found.
252 481 mdecorde
    Parameters
253 481 mdecorde
    (input)
254 481 mdecorde
    n      dimension of the eigenproblem matrix B
255 481 mdecorde
    wptr   array of pointers that point to work space
256 481 mdecorde
    step      starting index for a Lanczos run
257 481 mdecorde
    (output)
258 481 mdecorde
    wptr   array of pointers that point to work space that contains
259 481 mdecorde
    r[j], q[j], q[j-1], p[j], p[j-1]
260 481 mdecorde
     */
261 481 mdecorde
// get initial vector; default is random
262 481 mdecorde
    double rnm2 = 0;
263 481 mdecorde
    Random random = new Random(918273);
264 481 mdecorde
    for (int id = 0; id<3; id++) {
265 481 mdecorde
      for (int i = 0; i<n; i++) wk[i]  = random.nextDouble();
266 481 mdecorde
      // apply operator to put r in range (essential if m singular)
267 481 mdecorde
      A.opb(wk, pj);
268 481 mdecorde
      rnm2 = DoubleArraysPlus.dot(pj, pj);
269 481 mdecorde
      if (rnm2>0) break;
270 481 mdecorde
    }
271 481 mdecorde
    // normalize
272 481 mdecorde
    if (rnm2<=0) throw new SparseSVDException(CodeSVDException.FIRST_STEP_FAILURE, 0);
273 481 mdecorde
    rnm2 = 1/Math.sqrt(rnm2);
274 481 mdecorde
    for (int i = 0; i<n; i++) pj[i] *= rnm2;
275 481 mdecorde
  }
276 481 mdecorde
277 481 mdecorde
  private int lanczos_step(SparseMatrix A, int first, int last,int[] ll_,
278 481 mdecorde
          boolean[] enough_, double[] rnm_tol_, int n) throws SparseSVDException {
279 481 mdecorde
    /*   embodies a single Lanczos step
280 481 mdecorde
    Arguments
281 481 mdecorde
    (input)
282 481 mdecorde
    n        dimension of the eigenproblem for matrix B
283 481 mdecorde
    first    start of index through loop
284 481 mdecorde
    last     end of index through loop
285 481 mdecorde
    wptr            array of pointers pointing to work space
286 481 mdecorde
    alf            array to hold diagonal of the tridiagonal matrix T
287 481 mdecorde
    eta      orthogonality estimate of Lanczos vectors at step j
288 481 mdecorde
    oldeta   orthogonality estimate of Lanczos vectors at step j-1
289 481 mdecorde
    bet      array to hold off-diagonal of T
290 481 mdecorde
    ll       number of intitial Lanczos vectors in local orthog.
291 481 mdecorde
    (has value of 0, 1 or 2)
292 481 mdecorde
    enough   stop flag
293 481 mdecorde
     */
294 481 mdecorde
    int j;
295 481 mdecorde
    double t;
296 481 mdecorde
    double mid[];
297 481 mdecorde
    for (j = first; j<last; j++) {
298 481 mdecorde
      mid = qj1;
299 481 mdecorde
      qj1 = qj;
300 481 mdecorde
      qj = mid;
301 481 mdecorde
      mid = pj;
302 481 mdecorde
      pj = pj1;
303 481 mdecorde
      pj1 = mid;
304 481 mdecorde
      storage.storeQ(n, j-1, qj1);
305 481 mdecorde
      if (j-1<MAXLL) storage.storeP(n, j-1, pj1);
306 481 mdecorde
      bet[j] = rnm_tol_[0];
307 481 mdecorde
308 481 mdecorde
      // restart if invariant subspace is found
309 481 mdecorde
      if (bet[j]==0) {
310 481 mdecorde
        rnm_tol_[0] = startv(A, j, n);
311 481 mdecorde
        if (rnm_tol_[0]==0) enough_[0] = true;
312 481 mdecorde
      }
313 481 mdecorde
      if (enough_[0]) {
314 481 mdecorde
        /* added by Doug... */
315 481 mdecorde
        /* These lines fix a bug that occurs with low-rank matrices */
316 481 mdecorde
        mid = qj1;
317 481 mdecorde
        qj1 = qj;
318 481 mdecorde
        qj = mid;
319 481 mdecorde
        /* ...added by Doug */
320 481 mdecorde
        break;
321 481 mdecorde
      }
322 481 mdecorde
      /* take a lanczos step */
323 481 mdecorde
      t = 1.0/rnm_tol_[0];
324 481 mdecorde
      for (int i = 0; i<n; i++) qj[i] = t*rj[i];
325 481 mdecorde
      for (int i = 0; i<n; i++) pj[i] *= t;
326 481 mdecorde
      A.opb(pj, rj);
327 481 mdecorde
      for (int i = 0; i<n; i++) rj[i] -= rnm_tol_[0]*qj1[i];
328 481 mdecorde
      alph[j] = DoubleArraysPlus.dot(rj, pj);
329 481 mdecorde
      for (int i = 0; i<n; i++) rj[i] -= alph[j]*qj[i];
330 481 mdecorde
      /* orthogonalize against initial lanczos vectors */
331 481 mdecorde
      if (j<=MAXLL&&(Math.abs(alph[j-1])>4.0*Math.abs(alph[j])))
332 481 mdecorde
        ll_[0] = j;
333 481 mdecorde
      for (int i = 0; i<Math.min(ll_[0], j-1); i++) {
334 481 mdecorde
        storage.retrieveP(n, i, wk);
335 481 mdecorde
        t = DoubleArraysPlus.dot(wk, rj);
336 481 mdecorde
        storage.retrieveQ(n, i, wk);
337 481 mdecorde
        for (int ii = 0; ii<n; ii++) rj[ii] -= t*wk[ii];
338 481 mdecorde
        oldeta[i] = eta[i] = EPS1;
339 481 mdecorde
      }
340 481 mdecorde
      /* extended local reorthogonalization */
341 481 mdecorde
      t = DoubleArraysPlus.dot(rj, pj1);
342 481 mdecorde
      for (int i = 0; i<n; i++) rj[i] -= t*qj1[i];
343 481 mdecorde
      if (bet[j]>0) bet[j] += t;
344 481 mdecorde
      t = DoubleArraysPlus.dot(rj, pj);
345 481 mdecorde
      for (int i = 0; i<n; i++) rj[i] -= t*qj[i];
346 481 mdecorde
      alph[j] += t;
347 481 mdecorde
      System.arraycopy(rj, 0, pj1, 0, n);
348 481 mdecorde
      rnm_tol_[0] = Math.sqrt(DoubleArraysPlus.dot(rj, pj1));
349 481 mdecorde
      rnm_tol_[1] = RAD_EPS*(bet[j]+Math.abs(alph[j])+rnm_tol_[0]);
350 481 mdecorde
      /* update the orthogonality bounds */
351 481 mdecorde
      ortbnd(j, rnm_tol_[0]);
352 481 mdecorde
      /* restore the orthogonality state when needed */
353 481 mdecorde
      purge(n, ll_[0], j, rnm_tol_);
354 481 mdecorde
      if (rnm_tol_[0]<=rnm_tol_[1]) rnm_tol_[0] = 0;
355 481 mdecorde
    }
356 481 mdecorde
    return j;
357 481 mdecorde
  }
358 481 mdecorde
359 481 mdecorde
  private double startv(SparseMatrix A, int step, int n)
360 481 mdecorde
          throws SparseSVDException {
361 481 mdecorde
    /* startv delivers a starting vector in r and returns |r|; it returns
362 481 mdecorde
    zero if the range is spanned, and throws a SparseSVDException(-1) if no starting
363 481 mdecorde
    vector within range of operator can be found.
364 481 mdecorde
    Parameters
365 481 mdecorde
    (input)
366 481 mdecorde
    n      dimension of the eigenproblem matrix B
367 481 mdecorde
    wptr   array of pointers that point to work space
368 481 mdecorde
    step      starting index for a Lanczos run
369 481 mdecorde
    (output)
370 481 mdecorde
    wptr   array of pointers that point to work space that contains
371 481 mdecorde
    r[j], q[j], q[j-1], p[j], p[j-1]
372 481 mdecorde
     */
373 481 mdecorde
// get initial vector; default is random
374 481 mdecorde
    double rnm2 = DoubleArraysPlus.dot(rj, rj);
375 481 mdecorde
    Random random = new Random(918273+step);
376 481 mdecorde
    for (int id = 0; id<3; id++) {
377 481 mdecorde
      for (int i = 0; i<n; i++) rj[i] = random.nextDouble();
378 481 mdecorde
      System.arraycopy(rj, 0, pj, 0, n);
379 481 mdecorde
      // apply operator to put r in range (essential if m singular)
380 481 mdecorde
      A.opb(pj, rj);
381 481 mdecorde
      System.arraycopy(rj, 0, pj, 0, n);
382 481 mdecorde
      rnm2 = DoubleArraysPlus.dot(rj, pj);
383 481 mdecorde
      if (rnm2>0) break;
384 481 mdecorde
    }
385 481 mdecorde
    if (rnm2<=0) throw new SparseSVDException(CodeSVDException.FIRST_STEP_FAILURE, 0);
386 481 mdecorde
    double t;
387 481 mdecorde
    for (int j = 0; j<step; j++) {
388 481 mdecorde
      storage.retrieveQ(n, j, wk);
389 481 mdecorde
      t = -DoubleArraysPlus.dot(pj, wk);
390 481 mdecorde
      for (int i = 0; i<n; i++) rj[i] += t*wk[i];
391 481 mdecorde
    }
392 481 mdecorde
    // make sure q[step] is orthogonal to q[step-1]
393 481 mdecorde
    t = DoubleArraysPlus.dot(pj1, rj);
394 481 mdecorde
    for (int i = 0; i<n; i++) rj[i] -= t*qj1[i];
395 481 mdecorde
    System.arraycopy(rj, 0, pj, 0, n);
396 481 mdecorde
    t = DoubleArraysPlus.dot(pj, rj);
397 481 mdecorde
    if (t<=EPS*rnm2) rnm2 = 0;
398 481 mdecorde
    else rnm2 = t;
399 481 mdecorde
    return Math.sqrt(rnm2);
400 481 mdecorde
  }
401 481 mdecorde
402 481 mdecorde
  private void ortbnd(int step, double rnm) {
403 481 mdecorde
    /*  updates the eta recurrence
404 481 mdecorde
    Arguments
405 481 mdecorde
    (input)
406 481 mdecorde
    alf      array to hold diagonal of the tridiagonal matrix T
407 481 mdecorde
    eta      orthogonality estimate of Lanczos vectors at step j
408 481 mdecorde
    oldeta   orthogonality estimate of Lanczos vectors at step j-1
409 481 mdecorde
    bet      array to hold off-diagonal of T
410 481 mdecorde
    n        dimension of the eigenproblem for matrix B
411 481 mdecorde
    j        dimension of T
412 481 mdecorde
    rnm            norm of the next residual vector
413 481 mdecorde
    eps1            roundoff estimate for dot product of two unit vectors
414 481 mdecorde
    (output)
415 481 mdecorde
    eta      orthogonality estimate of Lanczos vectors at step j+1
416 481 mdecorde
    oldeta   orthogonality estimate of Lanczos vectors at step j
417 481 mdecorde
     */
418 481 mdecorde
    if (step<1) return;
419 481 mdecorde
    if (rnm!=0) {
420 481 mdecorde
      if (step>1)
421 481 mdecorde
        oldeta[0] = (bet[1]*eta[1]+(alph[0]-alph[step])*eta[0]
422 481 mdecorde
                -bet[step]*oldeta[0])/rnm+EPS1;
423 481 mdecorde
      for (int i = 1; i<=step-2; i++)
424 481 mdecorde
        oldeta[i] = (bet[i+1]*eta[i+1]+(alph[i]-alph[step])*eta[i]
425 481 mdecorde
                +bet[i]*eta[i-1]-bet[step]*oldeta[i])/rnm+EPS1;
426 481 mdecorde
    }
427 481 mdecorde
    oldeta[step-1] = EPS1;
428 481 mdecorde
    double t;
429 481 mdecorde
    for (int i = 0; i<step; i++) {
430 481 mdecorde
      t = oldeta[i];
431 481 mdecorde
      oldeta[i] = eta[i];
432 481 mdecorde
      eta[i] = t;
433 481 mdecorde
    }
434 481 mdecorde
    eta[step] = EPS1;
435 481 mdecorde
  }
436 481 mdecorde
437 481 mdecorde
  private void purge(int n, int ll, int step, double[] rnm_tol_) {
438 481 mdecorde
    /*
439 481 mdecorde
    purge examines the state of orthogonality between the new Lanczos
440 481 mdecorde
    vector and the previous ones to decide whether re-orthogonalization
441 481 mdecorde
    should be performed
442 481 mdecorde
    Arguments
443 481 mdecorde
    (input)
444 481 mdecorde
    n        dimension of the eigenproblem for matrix B
445 481 mdecorde
    ll       number of intitial Lanczos vectors in local orthog.
446 481 mdecorde
    r        residual vector to become next Lanczos vector
447 481 mdecorde
    q        current Lanczos vector
448 481 mdecorde
    ra       previous Lanczos vector
449 481 mdecorde
    qa       previous Lanczos vector
450 481 mdecorde
    wrk      temporary vector to hold the previous Lanczos vector
451 481 mdecorde
    eta      state of orthogonality between r and prev. Lanczos vectors
452 481 mdecorde
    oldeta   state of orthogonality between q and prev. Lanczos vectors
453 481 mdecorde
    j        current Lanczos step
454 481 mdecorde
    (output)
455 481 mdecorde
    r            residual vector orthogonalized against previous Lanczos
456 481 mdecorde
    vectors
457 481 mdecorde
    q        current Lanczos vector orthogonalized against previous ones
458 481 mdecorde
     */
459 481 mdecorde
    if (step<ll+2) return;
460 481 mdecorde
    int k = DoubleArraysPlus.indAbsMax(step-(ll+1), eta, ll);
461 481 mdecorde
    if (Math.abs(eta[k])<=RAD_EPS) return;
462 481 mdecorde
    double REPS1 = EPS1/RAD_EPS;
463 481 mdecorde
    double t;
464 481 mdecorde
    for (int iteration = 0; iteration<2; iteration++) {
465 481 mdecorde
      if (rnm_tol_[0]<=rnm_tol_[1]) break;
466 481 mdecorde
      /* bring in a lanczos vector t and orthogonalize both
467 481 mdecorde
       * r and q against it */
468 481 mdecorde
      double tq = 0;
469 481 mdecorde
      double tr = 0;
470 481 mdecorde
      for (int i = ll; i<step; i++) {
471 481 mdecorde
        storage.retrieveQ(n, i, wk);
472 481 mdecorde
        t = -DoubleArraysPlus.dot(pj, wk);
473 481 mdecorde
        tq += Math.abs(t);
474 481 mdecorde
        for (int ii = 0; ii<n; ii++) qj[ii] += t*wk[ii];
475 481 mdecorde
        t = -DoubleArraysPlus.dot(pj1, wk);
476 481 mdecorde
        tr += Math.abs(t);
477 481 mdecorde
        for (int ii = 0; ii<n; ii++) rj[ii] += t*wk[ii];
478 481 mdecorde
      }
479 481 mdecorde
      System.arraycopy(qj, 0, pj, 0, n);
480 481 mdecorde
      t = -DoubleArraysPlus.dot(rj, pj);
481 481 mdecorde
      tr += Math.abs(t);
482 481 mdecorde
      for (int i = 0; i<n; i++) rj[i] += t*qj[i];
483 481 mdecorde
      System.arraycopy(rj, 0, pj1, 0, n);
484 481 mdecorde
      rnm_tol_[0] = Math.sqrt(DoubleArraysPlus.dot(pj1, rj));
485 481 mdecorde
      if (tq<=REPS1&&tr<=REPS1*rnm_tol_[0]) break;
486 481 mdecorde
    }
487 481 mdecorde
    for (int i = ll; i<=step; i++) {
488 481 mdecorde
      eta[i] = EPS1;
489 481 mdecorde
      oldeta[i] = EPS1;
490 481 mdecorde
    }
491 481 mdecorde
  }
492 481 mdecorde
493 481 mdecorde
  private static void imtqlb(int n, int i0, double[] d, double[] e, double[] bnd)
494 481 mdecorde
          throws SparseSVDException {
495 481 mdecorde
    /*   imtqlb() finds the eigenvalues of a symmetric tridiagonal
496 481 mdecorde
    matrix by the implicit QL method.
497 481 mdecorde
    Arguments
498 481 mdecorde
    (input)
499 481 mdecorde
    n      order of the symmetric tridiagonal matrix
500 481 mdecorde
    d      contains the diagonal elements of the input matrix
501 481 mdecorde
    e      contains the subdiagonal elements of the input matrix in its
502 481 mdecorde
    last n-1 positions.  e[0] is arbitrary
503 481 mdecorde
    i0   starting index for the 3 vectors
504 481 mdecorde
    (elements with index < i0 or >= i0+n are preserved)
505 481 mdecorde
    (output)
506 481 mdecorde
    d      contains the eigenvalues in ascending order.  if an error
507 481 mdecorde
    exit is made, the eigenvalues are correct and ordered for
508 481 mdecorde
    indices 0,1,...ierr, but may not be the smallest eigenvalues.
509 481 mdecorde
    e      has been destroyed.
510 481 mdecorde
    throws a SparseSVDException(j) if the j-th eigenvalue has
511 481 mdecorde
    not been determined after 30 iterations.
512 481 mdecorde
     */
513 481 mdecorde
    if (n==1) return;
514 481 mdecorde
    bnd[i0] = 1;
515 481 mdecorde
    for (int i = i0+1; i<i0+n; i++) {
516 481 mdecorde
      bnd[i] = 0;
517 481 mdecorde
      e[i-1] = e[i];
518 481 mdecorde
    }
519 481 mdecorde
    e[i0+n-1] = 0;
520 481 mdecorde
    for (int l = i0; l<i0+n; l++) {
521 481 mdecorde
      for (int iteration = 0; iteration<=30; iteration++) {
522 481 mdecorde
        double p = d[l];
523 481 mdecorde
        double f = bnd[l];
524 481 mdecorde
        int m;
525 481 mdecorde
        for (m = l; m<i0+n-1; m++) { // test de convergence
526 481 mdecorde
          double test = Math.abs(d[m])+Math.abs(d[m+1]);
527 481 mdecorde
          if (test+Math.abs(e[m])==test) break;
528 481 mdecorde
        }
529 481 mdecorde
        if (m==l) {
530 481 mdecorde
          d[l] = p;
531 481 mdecorde
          bnd[l] = f;
532 481 mdecorde
          /* order the eigenvalues */
533 481 mdecorde
          DoubleArraysPlus.sort2(d, bnd, l-i0+1, i0);
534 481 mdecorde
          break;
535 481 mdecorde
        } else {
536 481 mdecorde
          if (iteration==30) throw new SparseSVDException(CodeSVDException.CONVERGENCE_FAILURE, l);
537 481 mdecorde
          /*........ form shift ........*/
538 481 mdecorde
          double g = (d[l+1]-p)/(2.0*e[l]);
539 481 mdecorde
          double r = Math.hypot(g, 1);
540 481 mdecorde
          g = d[m]-p+e[l]/(g+Math.copySign(r, g));
541 481 mdecorde
          double s = 1;
542 481 mdecorde
          double c = 1;
543 481 mdecorde
          p = 0;
544 481 mdecorde
          boolean underflow = false;
545 481 mdecorde
          for (int i = m-1; i>=l; i--) {
546 481 mdecorde
            f = s*e[i];
547 481 mdecorde
            double b = c*e[i];
548 481 mdecorde
            r = Math.hypot(f, g);
549 481 mdecorde
            e[i+1] = r;
550 481 mdecorde
            if (r==0) {
551 481 mdecorde
              /*........ recover from underflow .........*/
552 481 mdecorde
              underflow = true;
553 481 mdecorde
              d[i+1] -= p;
554 481 mdecorde
              e[m] = 0.0;
555 481 mdecorde
              break;
556 481 mdecorde
            }
557 481 mdecorde
            s = f/r;
558 481 mdecorde
            c = g/r;
559 481 mdecorde
            g = d[i+1]-p;
560 481 mdecorde
            r = (d[i]-g)*s+2*c*b;
561 481 mdecorde
            p = s*r;
562 481 mdecorde
            d[i+1] = g+p;
563 481 mdecorde
            g = c*r-b;
564 481 mdecorde
            f = bnd[i+1];
565 481 mdecorde
            bnd[i+1] = s*bnd[i]+c*f;
566 481 mdecorde
            bnd[i] = c*bnd[i]-s*f;
567 481 mdecorde
          }
568 481 mdecorde
569 481 mdecorde
          if (!underflow) {
570 481 mdecorde
            d[l] -= p;
571 481 mdecorde
            e[l] = g;
572 481 mdecorde
            e[m] = 0.0;
573 481 mdecorde
          }
574 481 mdecorde
        }
575 481 mdecorde
      }
576 481 mdecorde
    }
577 481 mdecorde
  }
578 481 mdecorde
579 481 mdecorde
  private int error_bound(boolean[] enough_, double endl, double endr,
580 481 mdecorde
          int step, double tol) {
581 481 mdecorde
    /*
582 481 mdecorde
    massages error bounds for very close ritz values by placing
583 481 mdecorde
    a gap between them.  The error bounds are then refined to reflect this.
584 481 mdecorde
    Arguments
585 481 mdecorde
    (input)
586 481 mdecorde
    endl     left end of interval containing unwanted eigenvalues
587 481 mdecorde
    endr     right end of interval containing unwanted eigenvalues
588 481 mdecorde
    ritz     array to store the ritz values
589 481 mdecorde
    bnd      array to store the error bounds
590 481 mdecorde
    enough   stop flag
591 481 mdecorde
     */
592 481 mdecorde
    int mid = DoubleArraysPlus.indAbsMax(step+1, bnd, 1);
593 481 mdecorde
594 481 mdecorde
    for (int i = step; i>mid; i--)
595 481 mdecorde
      if (Math.abs(ritz[i-1]-ritz[i])<RAD34_EPS*Math.abs(ritz[i]))
596 481 mdecorde
        if (bnd[i]>tol&&bnd[i-1]>tol) {
597 481 mdecorde
          bnd[i-1] = Math.hypot(bnd[i], bnd[i-1]);
598 481 mdecorde
          bnd[i] = 0;
599 481 mdecorde
        }
600 481 mdecorde
    for (int i = 1; i<mid; i++)
601 481 mdecorde
      if (Math.abs(ritz[i+1]-ritz[i])<RAD34_EPS*Math.abs(ritz[i]))
602 481 mdecorde
        if (bnd[i]>tol&&bnd[i+1]>tol) {
603 481 mdecorde
          bnd[i+1] = Math.hypot(bnd[i], bnd[i+1]);
604 481 mdecorde
          bnd[i] = 0.0;
605 481 mdecorde
        }
606 481 mdecorde
    /* refine the error bounds */
607 481 mdecorde
    int neig = 0;
608 481 mdecorde
    double gapl = ritz[step]-ritz[0];
609 481 mdecorde
    for (int i = 0; i<=step; i++) {
610 481 mdecorde
      double gap = gapl;
611 481 mdecorde
      if (i<step) gapl = ritz[i+1]-ritz[i];
612 481 mdecorde
      gap = Math.min(gap, gapl);
613 481 mdecorde
      if (gap>bnd[i]) bnd[i] *= (bnd[i]/gap);
614 481 mdecorde
      if (bnd[i]<=16.0*EPS*Math.abs(ritz[i])) {
615 481 mdecorde
        neig++;
616 481 mdecorde
        if (!enough_[0]) enough_[0] = endl<ritz[i]&&ritz[i]<endr;
617 481 mdecorde
      }
618 481 mdecorde
    }
619 481 mdecorde
    return neig;
620 481 mdecorde
  }
621 481 mdecorde
622 481 mdecorde
  private int ritvec0(SparseMatrix A, int[] steps_neig_) throws SparseSVDException {
623 481 mdecorde
624 481 mdecorde
    int js, jsq, i, k, /*size,*/ id2, tmp, nsig, x;
625 481 mdecorde
    double[] s, xv2;
626 481 mdecorde
    double tmp0, tmp1, xnorm;
627 481 mdecorde
    double[] w1 = Vt[0];
628 481 mdecorde
    double[] w2 = new double[cols];
629 481 mdecorde
630 481 mdecorde
    js = steps_neig_[0]+1;
631 481 mdecorde
    jsq = js*js;
632 481 mdecorde
    /*size = sizeof(double) * n;*/
633 481 mdecorde
634 481 mdecorde
    s = new double[jsq];
635 481 mdecorde
    xv2 = new double[cols];
636 481 mdecorde
637 481 mdecorde
    /* initialize s to an identity matrix */
638 481 mdecorde
    for (i = 0; i<jsq; i += (js+1)) s[i] = 1.0;
639 481 mdecorde
    DoubleArraysPlus.copyReverse(js, alph, 0, w1, 0);
640 481 mdecorde
    DoubleArraysPlus.copyReverse(steps_neig_[0], bet, 1, w2, 1);
641 481 mdecorde
642 481 mdecorde
    /* on return from imtql2(), w1 contains eigenvalues in ascending
643 481 mdecorde
     * order and s contains the corresponding eigenvectors */
644 481 mdecorde
    double[][] z = new double[js][js];
645 481 mdecorde
    for (int r = 0; r<js; r++) for (int c = 0; c<js; c++) z[r][c] = s[r*js+c];
646 481 mdecorde
    imtql2(js, js, w1, w2, z);
647 481 mdecorde
    for (int r = 0; r<js; r++) for (int c = 0; c<js; c++) s[r*js+c] = z[r][c];
648 481 mdecorde
649 481 mdecorde
650 481 mdecorde
    /*fwrite((char *)&n, sizeof(n), 1, fp_out2);
651 481 mdecorde
    fwrite((char *)&js, sizeof(js), 1, fp_out2);
652 481 mdecorde
    fwrite((char *)&kappa, sizeof(kappa), 1, fp_out2);*/
653 481 mdecorde
    /*id = 0;*/
654 481 mdecorde
    nsig = 0;
655 481 mdecorde
    x = 0;
656 481 mdecorde
    id2 = jsq-js;
657 481 mdecorde
    for (k = 0; k<js; k++) {
658 481 mdecorde
      tmp = id2;
659 481 mdecorde
      if (bnd[k]<=KAPPA*Math.abs(ritz[k])&&k>js-steps_neig_[1]-1) {
660 481 mdecorde
        if (--x<0) x = dim-1;
661 481 mdecorde
        w1 = Vt[x];
662 481 mdecorde
        for (i = 0; i<cols; i++) w1[i] = 0.0;
663 481 mdecorde
        for (i = 0; i<js; i++) {
664 481 mdecorde
          storage.retrieveQ(cols, i, w2);
665 481 mdecorde
          for (int ii = 0; ii<cols; ii++) w1[ii] += s[tmp]*w2[ii];
666 481 mdecorde
          tmp -= js;
667 481 mdecorde
        }
668 481 mdecorde
        /*fwrite((char *)w1, size, 1, fp_out2);*/
669 481 mdecorde
670 481 mdecorde
        /* store the w1 vector row-wise in array xv1;
671 481 mdecorde
         * size of xv1 is (steps+1) * (nrow+ncol) elements
672 481 mdecorde
         * and each vector, even though only ncol long,
673 481 mdecorde
         * will have (nrow+ncol) elements in xv1.
674 481 mdecorde
         * It is as if xv1 is a 2-d array (steps+1) by
675 481 mdecorde
         * (nrow+ncol) and each vector occupies a row  */
676 481 mdecorde
677 481 mdecorde
        /* j is the index in the R arrays, which are sorted by high to low
678 481 mdecorde
        singular values. */
679 481 mdecorde
680 481 mdecorde
        /*for (i = 0; i < n; i++) R->Vt->value[x]xv1[id++] = w1[i];*/
681 481 mdecorde
        /*id += nrow;*/
682 481 mdecorde
        nsig++;
683 481 mdecorde
      }
684 481 mdecorde
      id2++;
685 481 mdecorde
    }
686 481 mdecorde
    s = null;
687 481 mdecorde
688 481 mdecorde
    /* Rotate the singular vectors and values. */
689 481 mdecorde
    /* x is now the location of the highest singular value. */
690 481 mdecorde
    DoubleArraysPlus.rotateArray(Vt, x);
691 481 mdecorde
    dim = Math.min(dim, nsig);
692 481 mdecorde
    for (x = 0; x<dim; x++) {
693 481 mdecorde
      /* multiply by matrix B first */
694 481 mdecorde
      A.opb(Vt[x], xv2);
695 481 mdecorde
      tmp0 = DoubleArraysPlus.dot(Vt[x], xv2);
696 481 mdecorde
      for (int ii = 0; ii<cols; ii++) xv2[ii] -= tmp0*Vt[x][ii];
697 481 mdecorde
      tmp0 = Math.sqrt(tmp0);
698 481 mdecorde
      xnorm = Math.sqrt(DoubleArraysPlus.dot(xv2, xv2));
699 481 mdecorde
700 481 mdecorde
      /* multiply by matrix A to get (scaled) left s-vector */
701 481 mdecorde
      A.opa(Vt[x], Ut[x]);
702 481 mdecorde
      tmp1 = 1.0/tmp0;
703 481 mdecorde
      for (int ii = 0; ii<rows; ii++) Ut[x][ii] *= tmp1;
704 481 mdecorde
      xnorm *= tmp1;
705 481 mdecorde
      bnd[i] = xnorm;
706 481 mdecorde
      S[x] = tmp0;
707 481 mdecorde
    }
708 481 mdecorde
709 481 mdecorde
    xv2 = w2 = null;
710 481 mdecorde
    return nsig;
711 481 mdecorde
    /* multiply by matrix A to get (scaled) left s-vector */
712 481 mdecorde
713 481 mdecorde
  }
714 481 mdecorde
715 481 mdecorde
  private int ritvec(SparseMatrix A, int[] steps_neig_) throws SparseSVDException {
716 481 mdecorde
    //  computes the singular vectors of matrix A               *
717 481 mdecorde
/*  Parameters
718 481 mdecorde
    (input)
719 481 mdecorde
    nrow       number of rows of A
720 481 mdecorde
    steps      number of Lanczos iterations performed
721 481 mdecorde
    fp_out2    pointer to unformatted output file
722 481 mdecorde
    n              dimension of matrix A
723 481 mdecorde
    kappa      relative accuracy of ritz values acceptable as
724 481 mdecorde
    eigenvalues of A'A
725 481 mdecorde
    ritz       array of ritz values
726 481 mdecorde
    bnd        array of error bounds
727 481 mdecorde
    alf        array of diagonal elements of the tridiagonal matrix T
728 481 mdecorde
    bet        array of off-diagonal elements of T
729 481 mdecorde
    w1, w2     work space
730 481 mdecorde
    (output)
731 481 mdecorde
    xv1        array of eigenvectors of A'A (right singular vectors of A)
732 481 mdecorde
    ierr              error code
733 481 mdecorde
    0 for normal return from imtql2()
734 481 mdecorde
    k if convergence did not occur for k-th eigenvalue in
735 481 mdecorde
    imtql2()
736 481 mdecorde
    nsig       number of accepted ritz values based on kappa
737 481 mdecorde
    (local)
738 481 mdecorde
    s              work array which is initialized to the identity matrix
739 481 mdecorde
    of order (j + 1) upon calling imtql2().  After the call,
740 481 mdecorde
    s contains the orthonormal eigenvectors of the symmetric
741 481 mdecorde
    tridiagonal matrix T
742 481 mdecorde
     */
743 481 mdecorde
    // int n = cols;
744 481 mdecorde
745 481 mdecorde
    double[] w1 = Vt[0];
746 481 mdecorde
    double[] w2 = new double[cols];
747 481 mdecorde
    int js = steps_neig_[0]+1;
748 481 mdecorde
    double[][] s = new double[js][js];
749 481 mdecorde
    double[] xv2 = new double[cols];
750 481 mdecorde
    /* initialize s to an identity matrix */
751 481 mdecorde
    for (int i = 0; i<js; i++) s[i][i] = 1;
752 481 mdecorde
    DoubleArraysPlus.copyReverse(js, alph, 0, w1, 0);
753 481 mdecorde
    DoubleArraysPlus.copyReverse(steps_neig_[0], bet, 1, w2, 1);
754 481 mdecorde
    /* on return from imtql2(), w1 contains eigenvalues in ascending
755 481 mdecorde
     * order and s contains the corresponding eigenvectors */
756 481 mdecorde
    imtql2(js, js, w1, w2, s);
757 481 mdecorde
    int nsig = 0;
758 481 mdecorde
    int x = 0;
759 481 mdecorde
    for (int k = 0; k<js; k++) {
760 481 mdecorde
      if (bnd[k]<=KAPPA*Math.abs(ritz[k])&&k>js-steps_neig_[1]-1) {
761 481 mdecorde
        if (--x<0) x = dim-1;
762 481 mdecorde
        w1 = Vt[x];
763 481 mdecorde
        for (int i = 0; i<cols; i++) w1[i] = 0;
764 481 mdecorde
        for (int i = 0; i<js; i++) {
765 481 mdecorde
          storage.retrieveQ(cols, i, w2);
766 481 mdecorde
          for (int ii = 0; ii<cols; ii++) w1[ii] += s[k][js-1-i]*w2[ii];
767 481 mdecorde
        }
768 481 mdecorde
        /*fwrite((char *)w1, size, 1, fp_out2);*/
769 481 mdecorde
770 481 mdecorde
        /* store the w1 vector row-wise in array xv1;
771 481 mdecorde
         * size of xv1 is (steps+1) * (nrow+ncol) elements
772 481 mdecorde
         * and each vector, even though only ncol long,
773 481 mdecorde
         * will have (nrow+ncol) elements in xv1.
774 481 mdecorde
         * It is as if xv1 is a 2-d array (steps+1) by
775 481 mdecorde
         * (nrow+ncol) and each vector occupies a row  */
776 481 mdecorde
777 481 mdecorde
        /* j is the index in the R arrays, which are sorted by high to low
778 481 mdecorde
        singular values. */
779 481 mdecorde
780 481 mdecorde
        /*for (i = 0; i < n; i++) R->Vt->value[x]xv1[id++] = w1[i];*/
781 481 mdecorde
        /*id += nrow;*/
782 481 mdecorde
        nsig++;
783 481 mdecorde
      }
784 481 mdecorde
    }
785 481 mdecorde
    s = null;  // libère la mémoire
786 481 mdecorde
  /* Rotate the singular vectors and values. */
787 481 mdecorde
    /* x is now the location of the highest singular value. */
788 481 mdecorde
    DoubleArraysPlus.rotateArray(Vt, x);
789 481 mdecorde
    int d = Math.min(dim, nsig);
790 481 mdecorde
    for (x = 0; x<d; x++) {
791 481 mdecorde
      /* multiply by matrix B first */
792 481 mdecorde
      A.opb(Vt[x], xv2);
793 481 mdecorde
      double tmp0 = DoubleArraysPlus.dot(Vt[x], xv2);
794 481 mdecorde
      for (int i = 0; i<cols; i++) xv2[i] -= tmp0*Vt[x][i];
795 481 mdecorde
      tmp0 = Math.sqrt(tmp0);
796 481 mdecorde
      double xnorm = Math.sqrt(DoubleArraysPlus.dot(xv2, xv2));
797 481 mdecorde
      /* multiply by matrix A to get (scaled) left s-vector */
798 481 mdecorde
      A.opa(Vt[x], Ut[x]);
799 481 mdecorde
      double tmp1 = 1/tmp0;
800 481 mdecorde
      for (int i = 0; i<rows; i++) Ut[x][i] *= tmp1;
801 481 mdecorde
      xnorm *= tmp1;
802 481 mdecorde
      //   bnd[i] = xnorm; bizarre ??
803 481 mdecorde
      S[x] = tmp0;
804 481 mdecorde
    }
805 481 mdecorde
    xv2 = w2 = null;
806 481 mdecorde
    return nsig;
807 481 mdecorde
  }
808 481 mdecorde
809 481 mdecorde
  private static void imtql2(int nm, int n, double d[], double[] e, double[][] z)
810 481 mdecorde
          throws SparseSVDException {
811 481 mdecorde
    /*   imtqlb() finds the eigenvalues  and eigenvectors of a symmetric tridiagonal
812 481 mdecorde
    matrix by the implicit QL method.
813 481 mdecorde
    Arguments
814 481 mdecorde
    (input)
815 481 mdecorde
    nm     row dimension of the symmetric tridiagonal matrix
816 481 mdecorde
    n      order of the symmetric tridiagonal matrix
817 481 mdecorde
    d      contains the diagonal elements of the input matrix
818 481 mdecorde
    e      contains the subdiagonal elements of the input matrix in its
819 481 mdecorde
    last n-1 positions.  e[0] is arbitrary
820 481 mdecorde
    z      contains the identity matrix
821 481 mdecorde
    (output)
822 481 mdecorde
    d      contains the eigenvalues in ascending order.  if an error
823 481 mdecorde
    exit is made, the eigenvalues are correct but unordered for
824 481 mdecorde
    indices 0,1,...ierr.
825 481 mdecorde
    e      has been destroyed.
826 481 mdecorde
    z      contains orthonormal eigenvectors of the symmetric
827 481 mdecorde
    tridiagonal (or full) matrix.  if an error exit is made,
828 481 mdecorde
    z contains the eigenvectors associated with the stored
829 481 mdecorde
    eigenvalues.
830 481 mdecorde
    throws a SparseSVDException(j) if the j-th eigenvalue has
831 481 mdecorde
    not been determined after 30 iterations.
832 481 mdecorde
     */
833 481 mdecorde
    if (n==1) return;
834 481 mdecorde
    for (int i = 1; i<n; i++) e[i-1] = e[i];
835 481 mdecorde
    e[n-1] = 0.0;
836 481 mdecorde
    int nnm = n*nm;
837 481 mdecorde
    for (int l = 0; l<n; l++) {
838 481 mdecorde
      /* look for small sub-diagonal element */
839 481 mdecorde
      for (int iteration = 0; iteration<=30; iteration++) {
840 481 mdecorde
        double p = d[l];
841 481 mdecorde
        int m;
842 481 mdecorde
        for (m = l; m<n-1; m++) {// test de convergence
843 481 mdecorde
          double test = Math.abs(d[m])+Math.abs(d[m+1]);
844 481 mdecorde
          if (test+Math.abs(e[m])==test) break;
845 481 mdecorde
        }
846 481 mdecorde
        if (m==l) break;
847 481 mdecorde
        /* set error -- no convergence to an eigenvalue after
848 481 mdecorde
         * 30 iterations. */
849 481 mdecorde
        if (iteration==30) throw new SparseSVDException(CodeSVDException.CONVERGENCE_FAILURE, l);
850 481 mdecorde
        /* form shift */
851 481 mdecorde
        double g = (d[l+1]-p)/(2*e[l]);
852 481 mdecorde
        double r = Math.hypot(g, 1);
853 481 mdecorde
        g = d[m]-p+e[l]/(g+Math.copySign(r, g));
854 481 mdecorde
        double s = 1;
855 481 mdecorde
        double c = 1;
856 481 mdecorde
        p = 0;
857 481 mdecorde
        boolean underflow = false;
858 481 mdecorde
        for (int i = m-1; i>=l; i--) {
859 481 mdecorde
          double f = s*e[i];
860 481 mdecorde
          double b = c*e[i];
861 481 mdecorde
          r = Math.hypot(f, g);
862 481 mdecorde
          e[i+1] = r;
863 481 mdecorde
          if (r==0) {
864 481 mdecorde
            /*........ recover from underflow .........*/
865 481 mdecorde
            underflow = true;
866 481 mdecorde
            d[i+1] -= p;
867 481 mdecorde
            e[m] = 0.0;
868 481 mdecorde
            break;
869 481 mdecorde
          }
870 481 mdecorde
          s = f/r;
871 481 mdecorde
          c = g/r;
872 481 mdecorde
          g = d[i+1]-p;
873 481 mdecorde
          r = (d[i]-g)*s+2*c*b;
874 481 mdecorde
          p = s*r;
875 481 mdecorde
          d[i+1] = g+p;
876 481 mdecorde
          g = c*r-b;
877 481 mdecorde
          /* form vector */
878 481 mdecorde
          for (int k = 0; k<nm; k++) {
879 481 mdecorde
            f = z[i+1][k];
880 481 mdecorde
            z[i+1][k] = s*z[i][k]+c*f;
881 481 mdecorde
            z[i][k] = c*z[i][k]-s*f;
882 481 mdecorde
          }
883 481 mdecorde
        }
884 481 mdecorde
        if (!underflow) {
885 481 mdecorde
          d[l] -= p;
886 481 mdecorde
          e[l] = g;
887 481 mdecorde
          e[m] = 0.0;
888 481 mdecorde
        }
889 481 mdecorde
      }
890 481 mdecorde
    }
891 481 mdecorde
    /* order the eigenvalues and corresponding eigenvectors */
892 481 mdecorde
    DoubleArraysPlus.sort2(d, z, n, 0);
893 481 mdecorde
  }
894 481 mdecorde
895 481 mdecorde
  /* ------------------------
896 481 mdecorde
  Public Methods
897 481 mdecorde
   * ------------------------ */
898 481 mdecorde
  /** Return the left singular vectors
899 481 mdecorde
  @return     U
900 481 mdecorde
   */
901 481 mdecorde
  public Matrix getU() {
902 481 mdecorde
    return transpose ? (new Matrix(Vt, dim, cols)).transpose()
903 481 mdecorde
            : (new Matrix(Ut, dim, rows)).transpose();
904 481 mdecorde
  }
905 481 mdecorde
906 481 mdecorde
  /** Return the right singular vectors
907 481 mdecorde
  @return     V
908 481 mdecorde
   */
909 481 mdecorde
  public Matrix getV() {
910 481 mdecorde
    return transpose ? (new Matrix(Ut, dim, rows)).transpose()
911 481 mdecorde
            : (new Matrix(Vt, dim, cols)).transpose();
912 481 mdecorde
  }
913 481 mdecorde
914 481 mdecorde
  /** Return the one-dimensional array of singular values
915 481 mdecorde
  @return     diagonal of S.
916 481 mdecorde
   */
917 481 mdecorde
  public double[] getSingularValues() {
918 481 mdecorde
    return Arrays.copyOfRange(S, 0, dim);
919 481 mdecorde
  }
920 481 mdecorde
}