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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5581 - (download) (as text) (annotate)
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;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9