~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to Basic/Matrix.pm

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
ImportĀ upstreamĀ versionĀ 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
=head1 NAME
 
2
 
 
3
PDL::Matrix -- a derived matrix class that implements column-major
 
4
constructors and methods
 
5
 
 
6
=head1 VERSION
 
7
 
 
8
This document refers to version PDL::Matrix 0.01 of PDL::Matrix
 
9
 
 
10
=head1 SYNOPSIS
 
11
 
 
12
  use PDL::Matrix;
 
13
 
 
14
  $m = mpdl [[1,2,3],[4,5,6]];
 
15
  $m = PDL::Matrix->pdl([[1,2,3],[4,5,6]]);
 
16
  $m = msequence(4,3);
 
17
  @dimsa = $a->mdims; # 'dims' is not overloaded
 
18
 
 
19
  $v = vpdl [0,1,2,3]
 
20
  $v = vzeroes(4);
 
21
 
 
22
=head1 DESCRIPTION
 
23
 
 
24
=head2 Overview
 
25
 
 
26
This package tries to help people who want to use PDL for 2D matrix
 
27
computation with lots of indexing involved . It provides a PDL
 
28
subclass so one- and two-dimensional piddles that are used as
 
29
vectors resp. matrices can be typed in using traditional matrix
 
30
convention.
 
31
 
 
32
The original pdl class refers to the first index as the first row,
 
33
the second index as the first column of a matrix. Consider
 
34
     
 
35
  print $B = sequence(3,2)
 
36
  [
 
37
   [0 1 2]
 
38
   [3 4 5]
 
39
  ]
 
40
  
 
41
which gives a 2x3 matrix in terms of the matrix convention, but the
 
42
constructor used (3,2). This might get more confusing when using
 
43
slices like sequence(3,2)->slice("1:2,(0)") : with traditional
 
44
matrix convention one would expect [2 4] instead of [1 2].
 
45
 
 
46
This subclass PDL::Matrix overloads the constructors and indexing
 
47
functions of pdls so that they are compatible with the usual matrix
 
48
convention, where the first dimension refers to the row of a
 
49
matrix. So now, the above example would be written as
 
50
 
 
51
  print $B = PDL::Matrix->sequence(3,2) # or $B = msequence(3,2)
 
52
  [
 
53
   [0 1]
 
54
   [2 3]
 
55
   [4 5]
 
56
  ]
 
57
 
 
58
Routines like eigenvalue or matrix inversion can be used without
 
59
any changes.
 
60
 
 
61
Furthermore one can construct and use vectors as n x 1 matrices
 
62
without mentioning the second index '1'.
 
63
 
 
64
=head2 Implementation
 
65
 
 
66
C<PDL::Matrix> works by overloading a number of PDL constructors
 
67
and methods such that first and second args (corresponding to
 
68
first and second dims of corresponding matrices) are effectively swapped.
 
69
It is not yet clear if PDL::Matrix achieves a consistent column
 
70
major look-and-feel in this way.
 
71
 
 
72
=head1 FUNCTIONS
 
73
 
 
74
=cut
 
75
 
 
76
package PDL::Matrix;
 
77
 
 
78
@EXPORT_OK = ();
 
79
 
 
80
 
 
81
#use PDL::Core;
 
82
use PDL::Slatec;
 
83
use PDL::Exporter;
 
84
 
 
85
@ISA = qw/PDL::Exporter PDL/;
 
86
 
 
87
$VERSION = "0.02";
 
88
 
 
89
#######################################################################=
 
90
#########
 
91
#
 
92
# overloads
 
93
 
 
94
# --------> constructors
 
95
 
 
96
=head2 mpdl, PDL::Matrix::pdl
 
97
 
 
98
=for ref
 
99
 
 
100
constructs an object of class PDL::Matrix which is a piddle child
 
101
class, where the first index refers to the first column of the
 
102
two-dimensional piddle.
 
103
 
 
104
=for example
 
105
 
 
106
    $m = mpdl [[1,2,3],[4,5,6]];
 
107
    $m = PDL::Matrix->pdl([[1,2,3],[4,5,6]]);
 
108
 
 
109
=cut
 
110
 
 
111
sub pdl {
 
112
  my $class = shift;
 
113
  my $pdl = $class->SUPER::pdl(@_);
 
114
  bless $pdl, ref $class || $class;
 
115
}
 
116
 
 
117
=head2 mzeroes, mones, msequence
 
118
 
 
119
=for ref
 
120
 
 
121
constructs a PDL::Matrix object similar to the piddle constructors
 
122
zeroes, ones, sequence
 
123
 
 
124
=cut
 
125
 
 
126
# for constructors with specified dimensions I only have to swap these
 
127
# dimensions
 
128
for my $func (qw /zeroes ones sequence/) {
 
129
  my $code = << "EOE";
 
130
 
 
131
sub $func {
 
132
  my \$class = shift;
 
133
  my \@arg = \@_;
 
134
  ref(\$arg[0]) ne 'PDL::Type' ? (\@arg >  1 ? (\@arg[1,0] = \@arg[0,1]) : 
 
135
                                  (\@arg[0,1] = (1,\$arg[0])) ) :
 
136
           (\@arg >  2 ? (\@arg[2,1] = \@arg[1,2]) :
 
137
            (\@arg[1,2] = (1,\$arg[1])) );
 
138
  my \$pdl = \$class->SUPER::$func(\@arg);
 
139
  bless \$pdl, ref \$class || \$class;
 
140
}
 
141
 
 
142
EOE
 
143
  # print "evaluating $code\n";
 
144
  eval $code;
 
145
}
 
146
 
 
147
# functions that construct a matrix pdl and that can be exported, very
 
148
# trivial, they just call its methods optional type argument is
 
149
# checked within these methods
 
150
for my $func (qw /pdl zeroes ones sequence/) {
 
151
  push @EXPORT_OK, "m$func";
 
152
  my $code = << "EOE";
 
153
 
 
154
sub m$func { PDL::Matrix->$func(\@_) }
 
155
 
 
156
EOE
 
157
# print "evaluating $code\n";
 
158
  eval $code;
 
159
}
 
160
 
 
161
=head2 vpdl 
 
162
 
 
163
=for ref
 
164
 
 
165
constructs an object of class PDL::Matrix which is of matrix
 
166
dimensions (n x 1)
 
167
 
 
168
=for example
 
169
 
 
170
    print $v = vpdl [0,1];
 
171
    [
 
172
     [0]
 
173
     [1]
 
174
    ]
 
175
 
 
176
=cut 
 
177
 
 
178
sub vpdl {
 
179
  my $pdl = transpose(PDL->pdl(@_));
 
180
  bless $pdl, PDL::Matrix;
 
181
}
 
182
push @EXPORT_OK, "vpdl";
 
183
 
 
184
=head2 vzeroes, vones, vsequence
 
185
 
 
186
=for ref
 
187
 
 
188
constructs a PDL::Matrix object with matrix dimensions (n x 1),
 
189
therefore only the first scalar argument is used.
 
190
 
 
191
=for example
 
192
 
 
193
    print $v = vsequence(2);
 
194
    [
 
195
     [0]
 
196
     [1]
 
197
    ]
 
198
 
 
199
=cut
 
200
 
 
201
for my $func (qw /zeroes ones sequence/) {
 
202
  push @EXPORT_OK, "v$func";
 
203
  my $code = << "EOE";
 
204
 
 
205
sub v$func {
 
206
  my \@arg = \@_;
 
207
  ref(\$arg[0]) ne 'PDL::Type' ? (\@arg = (\$arg[0],1)) :
 
208
                                 (\@arg = (\$arg[0],\$arg[1],1));
 
209
  PDL::Matrix->$func(\@arg);
 
210
}
 
211
 
 
212
EOE
 
213
# print "evaluating $code\n";
 
214
  eval $code;
 
215
}
 
216
 
 
217
 
 
218
 
 
219
=head2  PDL::Matrix::slice, PDL::Matrix::dice
 
220
 
 
221
=for ref
 
222
 
 
223
same as slice, dice for normal piddles, but reflecting the matrix
 
224
convention by swapping the first two arguments.
 
225
 
 
226
=for example
 
227
 
 
228
    print  sequence(3,2)->slice("1:2,(0)") # piddle
 
229
    [1 2]
 
230
    print msequence(3,2)->slice("1:2,(0)") # PDL::Matrix
 
231
    [2 4]
 
232
 
 
233
=cut
 
234
 
 
235
sub slice {
 
236
  my $self = shift;
 
237
  my $ind = shift;
 
238
  # add another dimension if slices has only one
 
239
  # convenient for vectors
 
240
  $ind =~ s/^([^,]*)$/$1,/;
 
241
  # swap first two arguments
 
242
  $ind =~ s/^([^,]*),([^,]*)(.*)/$2,$1$3/;
 
243
  $self->SUPER::slice($ind);
 
244
}
 
245
 
 
246
sub dice {
 
247
  my $self = shift;
 
248
  my @arg = @_;
 
249
 
 
250
  
 
251
  @arg >=2 ? @arg[1,0] = @arg[0,1] : ( (@arg == 1 && $self->dims == 2)  ?
 
252
                                       @arg = (0,$arg[0]) : 1 );
 
253
  $self->SUPER::dice(@arg);
 
254
}
 
255
 
 
256
 
 
257
=head2 PDL::Matrix::at 
 
258
 
 
259
=for ref
 
260
 
 
261
same as at for piddles, but reflecting the matrix convention by
 
262
swapping the first two arguments
 
263
 
 
264
If only one scalar argument is used, we assume the object to be a
 
265
vector and look only at the first column.
 
266
 
 
267
=cut
 
268
 
 
269
# swap arguments if number of arguments is greater than 1
 
270
# if its one, look at the first column, assuming it is a vector
 
271
sub at {
 
272
  my $self = shift;
 
273
  my @arg = @_;
 
274
  @arg >=2 ? @arg[1,0] = @arg[0,1] : ( (@arg == 1 && $self->dims == 2)  ?
 
275
       @arg = (0,$arg[0]) : 1 );
 
276
  $self->SUPER::at(@arg);
 
277
}
 
278
 
 
279
=head2 PDL::Matrix::set
 
280
 
 
281
=for ref
 
282
 
 
283
set a particular value in a PDL::Matrix object. Note that this has to
 
284
be called as an object method rather than a function
 
285
 
 
286
=for example
 
287
 
 
288
print msequence(3,3)->set(2,0,-1) # ok with PDL::Matrix convention
 
289
[
 
290
 [ 0  1  2]
 
291
 [ 3  4  5]
 
292
 [-1  7  8]
 
293
]
 
294
 
 
295
print set msequence(3,3), 2,0,-1 # does not conform with PDL::Matrix convention
 
296
[
 
297
 [ 0  1 -1]
 
298
 [ 3  4  5]
 
299
 [ 6  7  8]
 
300
]
 
301
 
 
302
 
 
303
=cut
 
304
 
 
305
# this does not work as the usual set, but can be used via
 
306
# $M->set(0,2,0.4) which sets the element in the first row and third
 
307
# column to 0.4
 
308
sub set{    # Sets a particular single value
 
309
    barf("Usage: set($pdl, $x, $y,.., $value)") if $#_<2;
 
310
    my $self  = shift; my $value = pop @_;
 
311
    my @arg = @_;
 
312
    @arg >=2 ? @arg[1,0] = @arg[0,1] : ( (@arg == 1 && $self->dims == 2)  ?
 
313
                                         @arg = (0,$arg[0]) : 1 );
 
314
    PDL::Core::set_c ($self, [@arg], $value);
 
315
    return $self;
 
316
}
 
317
 
 
318
=head2 PDL::Matrix::reshape
 
319
 
 
320
=for ref
 
321
 
 
322
same as reshape for piddles, but reflecting the matrix convention by
 
323
swapping the first two arguments
 
324
 
 
325
=cut
 
326
 
 
327
sub reshape {
 
328
  my $self = shift;
 
329
  my @arg = @_;
 
330
  @arg >=2 ? @arg[1,0] = @arg[0,1] : (@arg = (1,$arg[0]));
 
331
  $self->SUPER::reshape(@arg);
 
332
}
 
333
 
 
334
# this is needed because only doing
 
335
# > use overload '~' => \&PDL::transpose;
 
336
# would not give an object of type PDL::Matrix back
 
337
# => possible bug in transpose?!
 
338
sub transpose {
 
339
  my $self = shift;
 
340
  my $pdl = $self->PDL::transpose;
 
341
  bless $pdl, ref $self;
 
342
}
 
343
 
 
344
use overload '~' => \&PDL::Matrix::transpose;
 
345
 
 
346
=head2 mdims
 
347
 
 
348
=for ref
 
349
 
 
350
returns the dimensions of the PDL::Matrix object in matrix
 
351
convention
 
352
 
 
353
C<dims> is NOT overloaded by PDL::Matrix to make sure that
 
354
methods like PDL::transpose still work. So use C<mdims> to get
 
355
the dims in the PDL::Matrix notation.
 
356
 
 
357
=for example
 
358
 
 
359
    print msequence(3,2)->mdims
 
360
    3 2
 
361
 
 
362
=cut
 
363
 
 
364
# I cannot overload dims, because it is apparently used many times
 
365
# in methods like transpose! :-(
 
366
# this is not nice but I don't know how to avoid this
 
367
sub mdims {
 
368
  my $self = shift;
 
369
  my @res = $self->SUPER::dims;
 
370
  @res >=2 ? @res[1,0] = @res[0,1] : 1;
 
371
  return @res;
 
372
}
 
373
 
 
374
sub inv {
 
375
  my $self = shift;
 
376
  return matinv($self);
 
377
}
 
378
 
 
379
 
 
380
=head2 kroneckerproduct
 
381
 
 
382
=for ref
 
383
 
 
384
returns kroneckerproduct of two matrices. This is not efficiently
 
385
implemented.
 
386
 
 
387
=for example
 
388
print kroneckerproduct(msequence(2,2),mones(2,2))
 
389
[
 
390
 [0 0 1 1]
 
391
 [0 0 1 1]
 
392
 [2 2 3 3]
 
393
 [2 2 3 3]
 
394
]
 
395
 
 
396
=cut
 
397
 
 
398
# returns kroneckerproduct of two matrices
 
399
sub kroneckerproduct {
 
400
  my @arg = @_;
 
401
  
 
402
  my ($r0,$c0) = $arg[0]->mdims;
 
403
  my ($r1,$c1) = $arg[1]->mdims;
 
404
  
 
405
  my $out = mzeroes($r0*$r1,$c0*$c1);
 
406
  
 
407
  for (my $i=0;$i<$r0;$i++) {
 
408
    for (my $j=0;$j<$c0;$j++) {
 
409
      ($_ = $out->slice(($i*$r1).":".(($i+1)*$r1-1).",".
 
410
                        ($j*$c1).":".(($j+1)*$c1-1)) ) .= $arg[0]->at($i,$j) * $arg[1];
 
411
    }
 
412
  }
 
413
  
 
414
  return $out;
 
415
}
 
416
push @EXPORT_OK, "kroneckerproduct";
 
417
 
 
418
sub rotate {
 
419
  my ($self,@args) = @_;
 
420
  return $self->transpose->SUPER::rotate(@args)->transpose;
 
421
}
 
422
 
 
423
 
 
424
sub msumover {
 
425
  my ($mpdl) = @_;
 
426
  return PDL::sumover(transpose($mpdl)->xchg(0,2));
 
427
}
 
428
push @EXPORT_OK, "msumover";
 
429
 
 
430
 
 
431
=head2 det_general
 
432
 
 
433
=for ref
 
434
 
 
435
returns a generalized determinant of a matrix. If the matrix is not
 
436
regular, one can specify the rank of the matrix and the corresponding
 
437
subdeterminant is returned. This is implemented using the C<eigens>
 
438
function.
 
439
 
 
440
=for example
 
441
print msequence(3,3)->determinant(2) # determinant of 
 
442
                                     # regular 2x2 submatrix
 
443
-24
 
444
 
 
445
=cut
 
446
 
 
447
 
448
sub det_general {
 
449
  my ($mpdl,$rank) = @_;
 
450
  my $eigenvalues = (PDL::Math::eigens($mpdl))[1];
 
451
  my @sort = list(PDL::Ufunc::qsorti(abs($eigenvalues)));
 
452
  $eigenvalues = $eigenvalues->dice([@sort[-$rank..-1]]);
 
453
  PDL::Ufunc::dprod($eigenvalues);
 
454
}
 
455
 
 
456
=head2 trace
 
457
 
 
458
=for ref
 
459
 
 
460
returns the trace of a matrix (sum of diagonals)
 
461
 
 
462
=cut
 
463
 
 
464
sub trace {
 
465
  my ($mpdl) = @_;
 
466
  $mpdl->diagonal(0,1)->sum;
 
467
}
 
468
 
 
469
# this has to be overloaded so that the PDL::slice
 
470
# is called and not PDL::Matrix::slice :-(
 
471
sub dummy($$;$) {
 
472
   my ($pdl,$dim) = @_;
 
473
   $dim = $pdl->getndims+1+$dim if $dim < 0;
 
474
   barf ("too high/low dimension in call to dummy, allowed min/max=0/"
 
475
  . $_[0]->getndims)
 
476
     if $dim>$pdl->getndims || $dim < 0;
 
477
   $_[2] = 1 if ($#_ < 2);
 
478
   $pdl->PDL::slice((','x$dim)."*$_[2]");
 
479
}
 
480
 
 
481
 
 
482
# now some of my very own helper functions...
 
483
# stupid function to print a PDL::Matrix object in Maple code
 
484
sub stringifymaple {
 
485
  my ($self,@args) = @_;
 
486
 
 
487
  my ($dimR,$dimC) = mdims($self);
 
488
  my $s;
 
489
 
 
490
  $s .= $args[0].":=" unless $args[0] eq "";
 
491
  if (defined($dimR)) {
 
492
    $s .= "matrix($dimR,$dimC,[";
 
493
    for(my $i=0;$i<$dimR;++$i) {
 
494
      $s .= "[";
 
495
      for(my $j=0;$j<$dimC;++$j) {
 
496
        $s .= $self->at($i,$j);
 
497
        $s .= "," if $j+1<$dimC;
 
498
      }
 
499
      $s .= "]";
 
500
      $s .= "," if $i+1<$dimR;
 
501
    }
 
502
    $s .= "])";
 
503
  }
 
504
  else {
 
505
    $s = "vector($dimC,[";
 
506
    for(my $i=0;$i<$dimC;++$i) {
 
507
      $s .= $self->at($i);
 
508
      $s .= "," if $i+1<$dimC;
 
509
    }
 
510
    $s .= "])";
 
511
  }
 
512
  return $s;
 
513
}
 
514
sub printmaple {
 
515
  print stringifymaple(@_).";\n";
 
516
}
 
517
 
 
518
# stupid function to print a PDL::Matrix object in (La)TeX code
 
519
sub stringifyTeX {
 
520
  my ($self,@args) = @_;
 
521
 
 
522
  my ($dimR,$dimC) = mdims($self);
 
523
  my $s;
 
524
 
 
525
  $s .= $args[0]."=" unless $args[0] eq "";
 
526
  $s .= "\\begin{pmatrix}\n";
 
527
  for(my $i=0;$i<$dimR;++$i) {
 
528
    for(my $j=0;$j<$dimC;++$j) {
 
529
      $s .= $self->at($i,$j);
 
530
      $s .= " & " if $j+1<$dimC;
 
531
    }
 
532
    $s .= " \\\\ \n" if $i+1<$dimR;
 
533
  }
 
534
  $s .= "\n \\end{pmatrix}\n";
 
535
 
 
536
  return $s;
 
537
}
 
538
 
 
539
sub printTeX {
 
540
  print stringifyTeX(@_)."\n";
 
541
}
 
542
 
 
543
 
 
544
=head2  vcrossp, PDL::Matrix::crossp
 
545
 
 
546
=for ref
 
547
 
 
548
similar to PDL::crossp, however reflecting PDL::Matrix notations
 
549
 
 
550
=cut
 
551
 
 
552
# crossp for my special vectors
 
553
sub crossp {
 
554
  my ($pdl1,$pdl2) = @_;
 
555
  return transpose(PDL::crossp(~$pdl1,~$pdl2));
 
556
}
 
557
sub vcrossp { PDL::Matrix->crossp(\@_) }
 
558
push @EXPORT_OK, "vcrossp";
 
559
 
 
560
%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
 
561
 
 
562
1;
 
563
 
 
564
=head1 BUGS AND PROBLEMS
 
565
 
 
566
Because we change the way piddles are constructed, not all pdl
 
567
operators may be applied to piddle-matrices. The inner product is not
 
568
redefined. We might have missed some functions/methods. Internal
 
569
consistency of our approach needs yet to be established.
 
570
 
 
571
=head1 TODO
 
572
 
 
573
check all PDL functions, benchmarks, optimization, lots of other things ...
 
574
 
 
575
=head1 AUTHOR(S)
 
576
 
 
577
Stephan Heuel (stephan@heuel.org), Christian Soeller
 
578
(c.soeller@auckland.ac.nz).
 
579
 
 
580
=head1 COPYRIGHT
 
581
 
 
582
All rights reserved. There is no warranty. You are allowed to
 
583
redistribute this software / documentation under certain
 
584
conditions. For details, see the file COPYING in the PDL
 
585
distribution. If this file is separated from the PDL distribution, the
 
586
copyright notice should be included in the file.
 
587
 
 
588
=cut