[system] / trunk / pg / lib / Value / Matrix.pm Repository:
ViewVC logotype

Diff of /trunk/pg/lib/Value/Matrix.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 6898 Revision 6899
6# 6#
7package Value::Matrix; 7package Value::Matrix;
8my $pkg = 'Value::Matrix'; 8my $pkg = 'Value::Matrix';
9 9
10use strict; no strict "refs"; 10use strict; no strict "refs";
11use Matrix; use Complex1;
11our @ISA = qw(Value); 12our @ISA = qw(Value);
12 13
13# 14#
14# Convert a value to a matrix. The value can be: 15# Convert a value to a matrix. The value can be:
15# a list of numbers or list of (nested) references to arrays of numbers, 16# a list of numbers or list of (nested) references to arrays of numbers,
18# 19#
19sub new { 20sub new {
20 my $self = shift; my $class = ref($self) || $self; 21 my $self = shift; my $class = ref($self) || $self;
21 my $context = (Value::isContext($_[0]) ? shift : $self->context); 22 my $context = (Value::isContext($_[0]) ? shift : $self->context);
22 my $M = shift; $M = [] unless defined $M; $M = [$M,@_] if scalar(@_) > 0; 23 my $M = shift; $M = [] unless defined $M; $M = [$M,@_] if scalar(@_) > 0;
24 $M = @{$M}[0] if ref($M) =~ m/^Matrix(Real1)?/;
23 $M = Value::makeValue($M,context=>$context) if ref($M) ne 'ARRAY'; 25 $M = Value::makeValue($M,context=>$context) if ref($M) ne 'ARRAY';
24 return bless {data => $M->data, context=>$context}, $class 26 return bless {data => $M->data, context=>$context}, $class
25 if (Value::classMatch($M,'Point','Vector','Matrix') && scalar(@_) == 0); 27 if (Value::classMatch($M,'Point','Vector','Matrix') && scalar(@_) == 0);
26 return $M if Value::isFormula($M) && Value::classMatch($self,$M->type); 28 return $M if Value::isFormula($M) && Value::classMatch($self,$M->type);
27 my @M = (ref($M) eq 'ARRAY' ? @{$M} : $M); 29 my @M = (ref($M) eq 'ARRAY' ? @{$M} : $M);
328 if ($M->isRow) {return if $i != 0 && $i != -1; return $M} 330 if ($M->isRow) {return if $i != 0 && $i != -1; return $M}
329 return $M->data->[$i]; 331 return $M->data->[$i];
330} 332}
331 333
332# 334#
333# Extract a given element from the matrix
334#
335sub element {
336 my $self = (ref($_[0]) ? $_[0] : shift);
337 my $M = $self->promote(shift);
338 return $M->extract(@_);
339}
340
341#
342# Extract a given column from the matrix 335# Extract a given column from the matrix
343# 336#
344sub column { 337sub column {
345 my $self = (ref($_[0]) ? $_[0] : shift); 338 my $self = (ref($_[0]) ? $_[0] : shift);
346 my $M = $self->promote(shift); my $j = shift; 339 my $M = $self->promote(shift); my $j = shift;
354 my @col = (); 347 my @col = ();
355 foreach my $row (@{$M->data}) {push(@col,$self->make($row->data->[$j]))} 348 foreach my $row (@{$M->data}) {push(@col,$self->make($row->data->[$j]))}
356 return $self->make(@col); 349 return $self->make(@col);
357} 350}
358 351
352#
353# Extract a given element from the matrix
354#
355sub element {
356 my $self = (ref($_[0]) ? $_[0] : shift);
357 my $M = $self->promote(shift);
358 return $M->extract(@_);
359}
360
361# @@@ assign @@@
359# @@@ removeRow, removeColumn @@@ 362# @@@ removeRow, removeColumn @@@
360# @@@ Minor @@@ 363# @@@ Minor @@@
361# @@@ Det, inverse @@@ 364
365
366##################################################
367#
368# Convert MathObject Matrix to old-style Matrix
369#
370sub wwMatrix {
371 my $self = (ref($_[0]) ? $_[0] : shift);
372 my $M = $self->promote(shift); my $j = shift; my $wwM;
373 return $self->{wwM} if defined($self->{wwM});
374 my @d = $M->dimensions;
375 Value->Error("Matrix must be two-dimensional to convert to MatrixReal1") if scalar(@d) > 2;
376 if (scalar(@d) == 1) {
377 $wwM = new Matrix(1,$d[0]);
378 foreach my $j (0..$d[0]-1) {
379 $wwM->[0][0][$j] = $self->wwMatrixEntry($M->data->[$j]);
380 }
381 } else {
382 $wwM = new Matrix(@d);
383 foreach my $i (0..$d[0]-1) {
384 my $row = $M->data->[$i];
385 foreach my $j (0..$d[1]-1) {
386 $wwM->[0][$i][$j] = $self->wwMatrixEntry($row->data->[$j]);
387 }
388 }
389 }
390 $self->{wwM} = $wwM;
391 return $wwM;
392}
393sub wwMatrixEntry {
394 my $self = shift; my $x = shift;
395 return $x->value if $x->isReal;
396 return Complex1::cplx($x->Re->value,$x->Im->value) if $x->isComplex;
397 return $x;
398}
399sub wwMatrixLR {
400 my $self = shift;
401 return $self->{lrM} if defined($self->{lrM});
402 $self->wwMatrix;
403 $self->{lrM} = $self->{wwM}->decompose_LR;
404 return $self->{lrM};
405}
406
407
408###################################
409#
410# From MatrixReal1.pm
411#
412
413sub det {
414 my $self = shift; $self->wwMatrixLR;
415 return $self->{lrM}->det_LR;
416}
417
418sub inverse {
419 my $self = shift; $self->wwMatrixLR;
420 return $self->new($self->{lrM}->invert_LR);
421}
422
423sub decompose_LR {
424 my $self = shift;
425 return $self->wwMatrixLR;
426}
427
428sub dim {
429 my $self = shift;
430 return $self->wwMatrix->dim();
431}
432
433sub norm_one {
434 my $self = shift;
435 return $self->wwMatrix->norm_one();
436}
437
438sub norm_max {
439 my $self = shift;
440 return $self->wwMatrix->norm_max();
441}
442
443sub kleene {
444 my $self = shift;
445 return $self->new($self->wwMatrix->kleene());
446}
447
448sub normalize {
449 my $self = shift;
450 my $v = $self->new(shift)->wwMatrix;
451 my ($M,$b) = $self->wwMatrix->normalize($v);
452 return ($self->new($M),$self->new($b));
453}
454
455sub solve_LR {
456 my $self = shift;
457 my $v = $self->new(shift)->wwMatrix;
458 my ($d,$b,$M) = $self->lrMatrix->solve_LR($v);
459 return ($d,$self->new($b),$self->new($M));
460}
461
462sub condition {
463 my $self = shift;
464 my $I = $self->new(shift)->wwMatrix;
465 return $self->new($self->wwMatrix->condition($I));
466}
467
468sub order_LR {
469 my $self = shift;
470 return $self->wwMatrixLR->order_LR;
471}
472
473sub solve_GSM {
474 my $self = shift;
475 my $x0 = $self->new(shift)->wwMatrix;
476 my $b = $self->new(shift)->wwMatrix;
477 my $e = shift;
478 my $v = $self->wwMatrix->solve_GSM($x0,$b,$e);
479 $v = $self->new($v) if defined($v);
480 return $v;
481}
482
483sub solve_SSM {
484 my $self = shift;
485 my $x0 = $self->new(shift)->wwMatrix;
486 my $b = $self->new(shift)->wwMatrix;
487 my $e = shift;
488 my $v = $self->wwMatrix->solve_SSM($x0,$b,$e);
489 $v = $self->new($v) if defined($v);
490 return $v;
491}
492
493sub solve_RM {
494 my $self = shift;
495 my $x0 = $self->new(shift)->wwMatrix;
496 my $b = $self->new(shift)->wwMatrix;
497 my $w = shift; my $e = shift;
498 my $v = $self->wwMatrix->solve_RM($x0,$b,$w,$e);
499 $v = $self->new($v) if defined($v);
500 return $v;
501}
502
503sub is_symmetric {
504 my $self = shift;
505 return $self->wwMatrix->is_symmetric;
506}
507
508###################################
509#
510# From Matrix.pm
511#
512
513sub trace {
514 my $self = shift;
515 return $self->wwMatrix->trace;
516}
517
518sub proj {
519 my $self = shift;
520 my $v = $self->new(shift)->wwMatrix;
521 return $self->new($self->wwMatrix->proj($v));
522}
523
524sub proj_coeff {
525 my $self = shift;
526 my $v = $self->new(shift)->wwMatrix;
527 return $self->new($self->wwMatrix->proj_coeff($v));
528}
529
530sub L {
531 my $self = shift;
532 return $self->new($self->wwMatrixLR->L);
533}
534
535sub R {
536 my $self = shift;
537 return $self->new($self->wwMatrixLR->R);
538}
539
540sub PL {
541 my $self = shift;
542 return $self->new($self->wwMatrixLR->PL);
543}
544
545sub PR {
546 my $self = shift;
547 return $self->new($self->wwMatrixLR->PR);
548}
549
362 550
363############################################ 551############################################
364# 552#
365# Generate the various output formats 553# Generate the various output formats
366# 554#

Legend:
Removed from v.6898  
changed lines
  Added in v.6899

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9