[system] / trunk / pg / lib / Parser / BOP / multiply.pm Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5581 - (view) (download) (as text)

1 : sh002i 2558 #########################################################################
2 :     #
3 :     # Implement multiplication.
4 :     #
5 :     package Parser::BOP::multiply;
6 : dpvc 4994 use strict;
7 :     our @ISA = qw(Parser::BOP);
8 : sh002i 2558
9 :     #
10 :     # Check that operand types are compatible for multiplication.
11 :     #
12 :     sub _check {
13 :     my $self = shift;
14 : dpvc 5130 return if $self->checkStrings();
15 :     return if $self->checkLists();
16 :     return if $self->checkNumbers();
17 : sh002i 2558 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 : dpvc 5130 } elsif ($self->context->flag("allowBadOperands")) {
29 :     $self->{type} = $Value::Type{number};
30 : sh002i 2558 } 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 : dpvc 2796 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 : sh002i 2558 $self->swapOps
65 : dpvc 2796 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 : sh002i 2558 return $self;
68 :     }
69 :    
70 : dpvc 5581 sub makeNeg {
71 :     my $self = shift;
72 :     $self = $self->SUPER::makeNeg(@_);
73 :     $self->{op}{noParens} = 1;
74 :     return $self;
75 :     }
76 :    
77 : dpvc 2796 $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 : dpvc 5581 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 : dpvc 2796
99 : dpvc 5581 $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 : sh002i 2558 sub TeX {
108 : dpvc 2696 my ($self,$precedence,$showparens,$position,$outerRight) = @_;
109 : dpvc 3531 my $TeX; my $bop = $self->{def}; my $cdot;
110 :     $position = '' unless defined($position);
111 :     $showparens = '' unless defined($showparens);
112 : sh002i 2558 my $mult = (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string});
113 : dpvc 2696 ($mult,$cdot) = @{$mult} if ref($mult) eq 'ARRAY';
114 :     $cdot = '\cdot ' unless $cdot;
115 :    
116 :     my $addparens =
117 : dpvc 5581 defined($precedence) && !$self->{noParens} &&
118 : dpvc 2696 ($showparens eq 'all' || $precedence > $bop->{precedence} ||
119 :     ($precedence == $bop->{precedence} &&
120 :     ($bop->{associativity} eq 'right' || $showparens eq 'same')));
121 : dpvc 3369 $outerRight = !$addparens && ($outerRight || $position eq 'right');
122 : dpvc 2696
123 :     my $left = $self->{lop}->TeX($bop->{precedence},$bop->{leftparens},'left',$outerRight);
124 :     my $right = $self->{rop}->TeX($bop->{precedence},$bop->{rightparens},'right');
125 : dpvc 5013 $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 : dpvc 5131 $right = '\!'.$right if $mult eq '' && substr($right,0,5) eq '\left';
129 : dpvc 2696 $TeX = $left.$mult.$right;
130 :    
131 :     $TeX = '\left('.$TeX.'\right)' if $addparens;
132 :     return $TeX;
133 : sh002i 2558 }
134 :    
135 :     #########################################################################
136 :    
137 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9