[system] / trunk / pg / lib / Parser / BOP / multiply.pm Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

View of /trunk/pg/lib/Parser/BOP/multiply.pm

Tue Nov 6 16:23:33 2007 UTC (12 years, 2 months ago) by dpvc
File size: 5192 byte(s)
When (-x)*y or x*(-y) reductions are performed, don't print extra
parentheses in string and TeX version.  I.e., display as -xy not
-(xy).  This makes reduction with polynomials work better.


    1 #########################################################################
2 #
3 #  Implement multiplication.
4 #
5 package Parser::BOP::multiply;
6 use strict;
7 our @ISA = qw(Parser::BOP);
8
9 #
10 #  Check that operand types are compatible for multiplication.
11 #
12 sub _check {
13   my $self = shift; 14 return if$self->checkStrings();
15   return if $self->checkLists(); 16 return if$self->checkNumbers();
17   my ($ltype,$rtype) = $self->promotePoints('Matrix'); 18 if ($ltype->{name} eq 'Number' && $rtype->{name} =~ m/Vector|Matrix/) { 19$self->{type} = {%{$rtype}}; 20 } elsif ($ltype->{name} =~ m/Vector|Matrix/ && $rtype->{name} eq 'Number') { 21$self->{type} = {%{$ltype}}; 22 } elsif ($ltype->{name} eq 'Matrix' && $rtype->{name} eq 'Vector') { 23$self->checkMatrixSize($ltype,transposeVectorType($rtype));
24   } elsif ($ltype->{name} eq 'Vector' &&$rtype->{name} eq 'Matrix') {
25     $self->checkMatrixSize(Value::Type('Matrix',1,$ltype),$rtype); 26 } elsif ($ltype->{name} eq 'Matrix' && $rtype->{name} eq 'Matrix') { 27$self->checkMatrixSize($ltype,$rtype);
28   } elsif ($self->context->flag("allowBadOperands")) { 29$self->{type} = $Value::Type{number}; 30 } else {$self->Error("Operands of '*' are not of compatible types")}
31 }
32
33 #
34 #  Return the type of a vector as a column vector.
35 #
36 sub transposeVectorType {
37   my $vtype = shift; 38 Value::Type('Matrix',$vtype->{length},
39      Value::Type('Matrix',1,$vtype->{entryType},formMatrix => 1), 40 formMatrix =>1 ); 41 } 42 43 # 44 # Do the multiplication. 45 # 46 sub _eval {$_[1] * $_[2]} 47 48 # 49 # Remove multiplication by one. 50 # Reduce multiplication by zero to appropriately sized zero. 51 # Factor out negatives. 52 # Move a number from the right to the left. 53 # Move a function apply from the left to the right. 54 # 55 sub _reduce { 56 my$self = shift;
57   my $reduce =$self->{equation}{context}{reduction};
58   return $self->{rop} if$self->{lop}{isOne} && $reduce->{'1*x'}; 59 return$self->{lop} if $self->{rop}{isOne} &&$reduce->{'x*1'};
60   return $self->makeZero($self->{rop},$self->{lop}) if$self->{lop}{isZero} && $reduce->{'0*x'}; 61 return$self->makeZero($self->{lop},$self->{rop}) if $self->{rop}{isZero} &&$reduce->{'x*0'};
62   return $self->makeNeg($self->{lop}{op},$self->{rop}) if$self->{lop}->isNeg && $reduce->{'(-x)*y'}; 63 return$self->makeNeg($self->{lop},$self->{rop}{op}) if $self->{rop}->isNeg &&$reduce->{'x*(-y)'};
64   $self->swapOps 65 if (($self->{rop}->class eq 'Number' && $self->{lop}->class ne 'Number' &&$reduce->{'x*n'}) ||
66         ($self->{lop}->class eq 'Function' &&$self->{rop}->class ne 'Function' && $reduce->{'fn*x'})); 67 return$self;
68 }
69
70 sub makeNeg {
71   my $self = shift; 72$self = $self->SUPER::makeNeg(@_); 73$self->{op}{noParens} = 1;
74   return $self; 75 } 76 77$Parser::reduce->{'1*x'} = 1;
78 $Parser::reduce->{'x*1'} = 1; 79$Parser::reduce->{'0*x'} = 1;
80 $Parser::reduce->{'x*0'} = 1; 81$Parser::reduce->{'(-x)*y'} = 1;
82 $Parser::reduce->{'x*(-y)'} = 1; 83$Parser::reduce->{'x*n'} = 1;
84 $Parser::reduce->{'fn*x'} = 1; 85 86 sub string { 87 my ($self,$precedence,$showparens,$position,$outerRight) = @_;
88   my $string; my$bop = $self->{def}; 89$position = '' unless defined($position); 90$showparens = '' unless defined($showparens); 91 my$extraParens = $self->context->flag('showExtraParens'); 92 my$addparens =
93       defined($precedence) && !$self->{noParens} &&
94       ($showparens eq 'all' || (($showparens eq 'extra' || $bop->{fullparens}) &&$extraParens > 1) ||
95        $precedence >$bop->{precedence} || ($precedence ==$bop->{precedence} &&
96         ($bop->{associativity} eq 'right' || ($showparens eq 'same' && $extraParens)))); 97$outerRight = !$addparens && ($outerRight || $position eq 'right'); 98 99$string = $self->{lop}->string($bop->{precedence},$bop->{leftparens},'left',$outerRight).
100             $bop->{string}. 101$self->{rop}->string($bop->{precedence},$bop->{rightparens},'right');
102
103   $string =$self->addParens($string) if$addparens;
104   return $string; 105 } 106 107 sub TeX { 108 my ($self,$precedence,$showparens,$position,$outerRight) = @_;
109   my $TeX; my$bop = $self->{def}; my$cdot;
110   $position = '' unless defined($position);
111   $showparens = '' unless defined($showparens);
112   my $mult = (defined($bop->{TeX}) ? $bop->{TeX} :$bop->{string});
113   ($mult,$cdot) = @{$mult} if ref($mult) eq 'ARRAY';
114   $cdot = '\cdot ' unless$cdot;
115
116   my $addparens = 117 defined($precedence) && !$self->{noParens} && 118 ($showparens eq 'all' || $precedence >$bop->{precedence} ||
119       ($precedence ==$bop->{precedence} &&
120         ($bop->{associativity} eq 'right' ||$showparens eq 'same')));
121   $outerRight = !$addparens && ($outerRight ||$position eq 'right');
122
123   my $left =$self->{lop}->TeX($bop->{precedence},$bop->{leftparens},'left',$outerRight); 124 my$right = $self->{rop}->TeX($bop->{precedence},$bop->{rightparens},'right'); 125$mult = $cdot if$right =~ m/^\d/ ||
126      ($left =~ m/\d+$/ && $self->{rop}{isConstant} && 127$self->{rop}->type eq 'Number' && $self->{rop}->class ne 'Constant'); 128$right = '\!'.$right if$mult eq '' && substr($right,0,5) eq '\left'; 129$TeX = $left.$mult.$right; 130 131$TeX = '\left('.$TeX.'\right)' if$addparens;
132   return \$TeX;
133 }
134
135 #########################################################################
136
137 1;