File Coverage

blib/lib/PDL/SVDLIBC.pm
Criterion Covered Total %
statement 39 39 100.0
branch 19 28 67.8
condition n/a
subroutine 8 8 100.0
pod 3 4 75.0
total 69 79 87.3


line stmt bran cond sub pod time code
1              
2             #
3             # GENERATED WITH PDL::PP! Don't modify!
4             #
5             package PDL::SVDLIBC;
6              
7             @EXPORT_OK = qw( PDL::PP _svdccsencode svdlas2a PDL::PP svdlas2 svdlas2aw PDL::PP svdlas2w svdlas2ad PDL::PP svdlas2d );
8             %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
9              
10 2     2   704279 use PDL::Core;
  2         4  
  2         14  
11 2     2   598 use PDL::Exporter;
  2         4  
  2         12  
12 2     2   44 use DynaLoader;
  2         21  
  2         171  
13              
14              
15              
16             $PDL::SVDLIBC::VERSION = 0.14;
17             @ISA = ( 'PDL::Exporter','DynaLoader' );
18             push @PDL::Core::PP, __PACKAGE__;
19             bootstrap PDL::SVDLIBC $VERSION;
20              
21              
22              
23              
24             =pod
25              
26             =head1 NAME
27              
28             PDL::SVDLIBC - PDL interface to Doug Rohde's SVD C Library
29              
30             =head1 SYNOPSIS
31              
32             use PDL;
33             use PDL::SVDLIBC;
34              
35             ##---------------------------------------------------------------------
36             ## Input matrix (dense)
37             ##---------------------------------------------------------------------
38             $n = 100; ##-- number of columns
39             $m = 50; ##-- number of rows
40             $a = random(double,$n,$m); ##-- random matrix
41              
42             ##---------------------------------------------------------------------
43             ## Output pdls
44             ##---------------------------------------------------------------------
45             $d = $n; ##-- max number of output dimensions
46             $ut = zeroes(double,$m,$d); ##-- left singular components
47             $s = zeroes(double,$d); ##-- singular values (diagnonal vector)
48             $vt = zeroes(double,$n,$d); ##-- right singular components
49              
50             ##---------------------------------------------------------------------
51             ## Singular Value Decomposition (dense)
52             ##---------------------------------------------------------------------
53             svdlas2d($a, $maxiters, $end, $kappa, $ut, $s, $vt);
54              
55             ##---------------------------------------------------------------------
56             ## Singular Value Decomposition (sparse, using direct whichND()-encoding)
57             ##---------------------------------------------------------------------
58             $which = whichND($a)->qsortvec();
59             $nzvals = indexND($a,$which);
60              
61             svdlas2w($which, $nzvals, $n, $m, $maxiters, $end, $kappa, $ut, $s, $vt);
62              
63             ##---------------------------------------------------------------------
64             ## Singular Value Decomposition (sparse, using PDL::CCS encoding)
65             ##---------------------------------------------------------------------
66             use PDL::CCS;
67             ($ptr,$rowids,$nzvals) = ccsencode($a);
68             $ptr->reshape($ptr->nelem+1);
69             $ptr->set(-1, $rowids->nelem);
70              
71             svdlas2($ptr, $rowids, $nzvals, $m, $maxiters, $end, $kappa, $ut, $s, $vt);
72              
73              
74             =head1 DESCRIPTION
75              
76             PDL::SVDLIBC provides a PDL interface to the SVDLIBC routines
77             for singular value decomposition of large sparse matrices.
78             SVDLIBC is available from http://tedlab.mit.edu/~dr/SVDLIBC/
79              
80             =cut
81              
82              
83              
84              
85              
86              
87              
88             =head1 FUNCTIONS
89              
90              
91              
92             =cut
93              
94              
95              
96              
97              
98 2     2   10 use strict;
  2         2  
  2         1269  
99              
100             =pod
101              
102             =head1 SVDLIBC Globals
103              
104             There are several global data structures still lurking in the
105             SVDLIBC code, so expect problems if you are trying to run more
106             than one 'las2' procedure at once (even in different processes).
107              
108             PDL::SVDLIBC provides access to (some of) the SVDLIBC globals
109             through the following functions, which are not exported.
110              
111             =cut
112              
113              
114              
115             =pod
116              
117             =head2 PDL::SVDLIBC::verbosity()
118              
119             =head2 PDL::SVDLIBC::verbosity($level)
120              
121             Get/set the current SVDLIBC verbosity level.
122             Valid values for $level are between 0 (no messages) and
123             2 (many messages).
124              
125             =cut
126              
127              
128              
129              
130             =pod
131              
132             =head2 PDL::SVDLIBC::svdVersion()
133              
134             Returns a string representing the SVDLIBC version
135             this module was compiled with.
136              
137             =cut
138              
139              
140              
141              
142             =pod
143              
144             =head1 SVD Utilities
145              
146             =cut
147              
148              
149              
150              
151              
152             =head2 _svdccsencode
153              
154             =for sig
155              
156             Signature: (double a(n,m); indx [o]ptr(n1); indx [o]rowids(nnz); double [o]nzvals(nnz))
157              
158              
159             =for ref
160              
161             info not available
162              
163              
164             =for bad
165              
166             _svdccsencode does not process bad values.
167             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
168              
169              
170             =cut
171              
172              
173              
174              
175              
176              
177             *_svdccsencode = \&PDL::_svdccsencode;
178              
179              
180              
181              
182             =pod
183              
184             =head2 svdlas2a
185              
186             =for sig
187              
188             indx ptr(nplus1);
189             indx rowids(nnz);
190             double nzvals(nnz);
191             indx m(); ##-- default: max($rowids)+1
192             int d(); ##-- default: max(nplus1-1,m)
193             int iterations(); ##-- default: 2*$d
194             double end(2); ##-- default: [-1e-30,1e-30]
195             double kappa(); ##-- default: 1e-6
196             double [o]ut(m,d); ##-- default: new
197             double [o] s(d); ##-- default: new
198             double [o]vt(n,d); ##-- default: new
199              
200             Uses a variant of the single-vector Lanczos method (Lanczos, 1950)
201             to compute the singular value decomposition of a sparse matrix with
202             $m() rows and data encoded
203             in Harwell-Boeing sparse format in the input parameters $ptr(), $rowids(),
204             and $nzvals(). See L<"PDL::CCS"> for a way to acquire these parameters
205             from a dense input matrix, but note that for svdlas2(), the
206             column pointer $ptr() is of size ($n+1) for a dense matrix $a with
207             $n columns, where $ptr($n)==$nnz is the total number of nonzero
208             values in $a.
209              
210             $iterations() is the maximum number of Lanczos iterations to perform.
211              
212             $end() specifies two endpoints of an interval within which all unwanted
213             eigenvalues lie.
214              
215             $kappa() is a double containing the relative accuracy of Ritz
216             values acceptable as eigenvalues.
217              
218             The left singular components are returned in the matrix $ut(),
219             the singular values themselved in the vector $s(), and the
220             right singular components in the matrix $vt(). Note that
221             $ut() and $vt() are transposed, and must be specified explicitly
222             in the call, so that the degree of reduction (the size parameter $d)
223             can be determined. If $d==$n, then a full decomposition
224             will be computed, and on return, $ut() and $vt() should be transposed
225             instances of the matrices $u() and $v() as returned by PDL::MatrixOps::svd().
226              
227             The Lanczos method as used here seems to be consistently the
228             fastest. This algorithm has the drawback that the low order singular
229             values may be relatively imprecise, but that is not a problem for most
230             users who only want the higher-order values or who can tolerate some
231             imprecision.
232              
233             See also: svdlas2aw(), svdlas2d()
234              
235             =cut
236              
237             ## ($iters,$end,$kappa,$ut,$s,$vt) = svddefaults($n=$nrows,$m=$ncols,$d, $iters,...)
238             ## + returns default values
239             ## + changed calling conventions in v0.14
240             ## - WAS: svddefaults($nrows,$cols, $d,$iters,...) ##-- SVDLIBC-style (col-primary)
241             ## ~ svddefaults($m, $n, $d,$iters,...) ##-- SVDLIBC-style (for dense $a(n,m))
242             ## - NOW: svddefaults($n, $m, $d,$iters,...) ##-- pdl-style
243             sub svddefaults {
244 7     7 0 20 my ($n,$m,$d, $iters,$end,$kappa,$ut,$s,$vt) = @_;
245 7 50       41 $n = $n->at(0) if (UNIVERSAL::isa($n,'PDL'));
246 7 50       26 $m = $m->at(0) if (UNIVERSAL::isa($m,'PDL'));
247 7 50       29 $d = ($n >= $m ? $n : $m) if (!defined($d));
    100          
248 7 50       25 $iters = 2*$d if (!defined($iters));
249 7 50       36 $end = pdl(double,[-1e-30,1e-30]) if (!defined($end));
250 7 50       280 $kappa = pdl(double,1e-6) if (!defined($kappa));
251 7 50       490 $ut = PDL->zeroes(double,$m,$d) if (!defined($ut));
252 7 50       660 $s = PDL->zeroes(double, $d) if (!defined($s));
253 7 50       519 $vt = PDL->zeroes(double,$n,$d) if (!defined($vt));
254 7         579 return ($iters,$end,$kappa,$ut,$s,$vt);
255             }
256              
257             sub svdlas2a {
258 2     2 1 185277 my ($ptr,$rowids,$nzvals, $m,$d, @args) = @_;
259 2 100       12 $m = $rowids->flat->max+1 if (!defined($m));
260 2         76 @args = svddefaults($ptr->dim(0)-1,$m,$d,@args);
261 2         185 svdlas2($ptr,$rowids,$nzvals,$m,@args);
262 2         31 return @args[3..5];
263             }
264              
265              
266              
267              
268              
269             =head2 svdlas2
270              
271             =for sig
272              
273             Signature: (
274             indx ptr(nplus1);
275             indx rowids(nnz);
276             double nzvals(nnz);
277             indx m();
278             int iterations();
279             double end(2);
280             double kappa();
281             double [o]ut(m,d);
282             double [o] s(d);
283             double [o]vt(n,d);
284             )
285              
286              
287             Guts for svdlas2a().
288             No default instantiation, and slightly different calling conventions.
289              
290              
291             =for bad
292              
293             svdlas2 does not process bad values.
294             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
295              
296              
297             =cut
298              
299              
300              
301              
302              
303              
304             *svdlas2 = \&PDL::svdlas2;
305              
306              
307              
308              
309             =pod
310              
311             =head2 svdlas2aw
312              
313             =for sig
314              
315             indx which(nnz,2); ##-- sorted indices of non-zero values
316             double nzvals(nnz); ##-- non-zero values
317             indx n(); ##-- default: max($indx(0,:))+1
318             indx m(); ##-- default: max($indx(1,:))+1
319             int d(); ##-- default: max(n,m)
320             int iterations(); ##-- default: 2*$d
321             double end(2); ##-- default: [-1e-30,1e-30]
322             double kappa(); ##-- default: 1e-6
323             double [o]ut(m,d); ##-- default: new
324             double [o] s(d); ##-- default: new
325             double [o]vt(n,d); ##-- default: new
326              
327             As for svdlas2a(), but implicitly converts the index-encoded matrix
328             ($which(),$nzvals()) to an internal CCS-like sparse format
329             before computing the decomposition.
330             Should be slightly more efficient than using PDL::CCS::ccsencode()
331             or similar if you already have $which() and $nzvals() available.
332             These can be attained for a dense matric $a() e.g. by:
333              
334             $which = $a->whichND->qsortvec->xchg(0,1);
335             $nzvals = $a->indexND($which->xchg(0,1));
336              
337             See also: svdlas2a(), svdlas2d()
338              
339             =cut
340              
341             sub svdlas2aw {
342 3     3 1 4380 my ($which,$nzvals, $n,$m,$d, @args) = @_;
343 3 100       39 $which = $which->xchg(0,1) if ($which->dim(1) > $which->dim(0));
344 3 100       22 $n = $which->slice(":,0")->max+1 if (!defined($n));
345 3 100       211 $m = $which->slice(":,1")->max+1 if (!defined($m));
346 3         187 @args = svddefaults($n,$m,$d,@args);
347 3         496 svdlas2w($which,$nzvals,$n,$m,@args);
348 3         84 return @args[3..5];
349             }
350              
351              
352              
353              
354              
355             =head2 svdlas2w
356              
357             =for sig
358              
359             Signature: (
360             indx whichi(nnz,Two);
361             double nzvals(nnz);
362             indx n();
363             indx m();
364             int iterations();
365             double end(2);
366             double kappa();
367             double [o]ut(m,d);
368             double [o] s(d);
369             double [o]vt(n,d);
370             )
371              
372              
373             Guts for svdlas2a().
374             No default instantiation, and slightly different calling conventions.
375              
376              
377             =for bad
378              
379             svdlas2w does not process bad values.
380             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
381              
382              
383             =cut
384              
385              
386              
387              
388              
389              
390             *svdlas2w = \&PDL::svdlas2w;
391              
392              
393              
394              
395             =pod
396              
397             =head2 svdlas2ad
398              
399             =for sig
400              
401             double a(n,m);
402             int d(); ##-- default: max($n,$m)
403             int iterations(); ##-- default: 2*$d
404             double end(2); ##-- default: [-1e-30,1e-30]
405             double kappa(); ##-- default: 1e-6
406             double [o]ut(m,d); ##-- default: new
407             double [o] s(d); ##-- default: new
408             double [o]vt(n,d); ##-- default: new
409              
410             As for svdlas2(), but implicitly converts the dense input matrix
411             $a() to sparse format before computing the decomposition.
412              
413             =cut
414              
415             sub svdlas2ad {
416 2     2 1 2451 my ($a,$d, @args) = @_;
417 2         23 @args = svddefaults($a->dim(0),$a->dim(1),$d,@args);
418 2         297 svdlas2d($a,@args);
419 2         37 return @args[3..5];
420             }
421              
422              
423              
424              
425              
426             =head2 svdlas2d
427              
428             =for sig
429              
430             Signature: (
431             double a(n,m);
432             int iterations();
433             double end(2);
434             double kappa();
435             double [o]ut(m,d);
436             double [o] s(d);
437             double [o]vt(n,d);
438             )
439              
440              
441             Guts for _svdlas2d().
442              
443              
444             =for bad
445              
446             svdlas2d does not process bad values.
447             It will set the bad-value flag of all output piddles if the flag is set for any of the input piddles.
448              
449              
450             =cut
451              
452              
453              
454              
455              
456              
457             *svdlas2d = \&PDL::svdlas2d;
458              
459              
460              
461              
462             ##---------------------------------------------------------------------
463             =pod
464              
465             =head1 ACKNOWLEDGEMENTS
466              
467             Perl by Larry Wall.
468              
469             PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others.
470              
471             SVDLIBC by Dough Rohde.
472              
473             SVDPACKC by Michael Berry, Theresa Do, Gavin O'Brien, Vijay Krishna and Sowmini Varadhan.
474              
475             =cut
476              
477             ##----------------------------------------------------------------------
478             =pod
479              
480             =head1 KNOWN BUGS
481              
482             Globals still lurk in the depths of SVDLIBC.
483              
484             =cut
485              
486              
487             ##---------------------------------------------------------------------
488             =pod
489              
490             =head1 AUTHOR
491              
492             Bryan Jurish Emoocow@cpan.orgE
493              
494             =head2 Copyright Policy
495              
496             Copyright (C) 2005-2015, Bryan Jurish. All rights reserved.
497              
498             This package is free software, and entirely without warranty.
499             You may redistribute it and/or modify it under the same terms
500             as Perl itself.
501              
502             =head1 SEE ALSO
503              
504             perl(1), PDL(3perl), PDL::CCS(3perl), SVDLIBC documentation.
505              
506             =cut
507              
508              
509              
510             ;
511              
512              
513              
514             # Exit with OK status
515              
516             1;
517              
518