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

View of /trunk/pg/lib/Parser/List.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2626 - (download) (as text) (annotate)
Mon Aug 16 19:44:26 2004 UTC (15 years, 3 months ago) by dpvc
File size: 7233 byte(s)
One more fix for handling intervals properly (I think it's really
right this time).  Also, named constants that end in numbers will
produce TeX output with the number as a subscript (this was already
true for variable names).

    1 #########################################################################
    2 #
    3 #  Implements base List class.
    4 #
    5 package Parser::List;
    6 use strict; use vars qw(@ISA);
    7 @ISA = qw(Parser::Item);
    8 
    9 #
   10 #  First, check to see if we might be forming an interval
   11 #    (true if the close paren is not the right one for the
   12 #     open paren, or if one of the coordinates is infinity).
   13 #  If we aren't forming an interval,
   14 #    See if we need to form a matrix (entry type is already a vector)
   15 #    Otherwise if we have mixed entry types (type is unknown)
   16 #      Form a list if we can
   17 #      Otherwise report an appropriate error
   18 #  Then create the appropriately typed list object
   19 #
   20 sub new {
   21   my $self = shift;
   22   my $equation = shift; my $coords = shift;
   23   my $constant = shift; my $paren = shift;
   24   my $entryType = shift || $Value::Type{unknown};
   25   my $open = shift || ''; my $close = shift || '';
   26   my $parens = $equation->{context}{parens}; my $list;
   27 
   28   if ($paren && $close && $paren->{formInterval}) {
   29     $paren = $parens->{interval}
   30       if ($paren->{close} ne $close || (scalar(@{$coords}) == 2 &&
   31            ($coords->[0]->{isInfinite} || $coords->[1]->{isInfinite})) ||
   32            (scalar(@{$coords}) == 1 && $coords->[0]->{isInfinite}));
   33   }
   34   my $type = Value::Type($paren->{type},scalar(@{$coords}),$entryType,
   35                                 list => 1, formMatrix => $paren->{formMatrix});
   36   if ($type->{name} ne 'Interval') {
   37     if ($paren->{formMatrix} && $entryType->{formMatrix}) {$type->{name} = 'Matrix'}
   38     elsif ($entryType->{name} eq 'unknown') {
   39       if ($paren->{formList}) {$type->{name} = 'List'}
   40       elsif ($type->{name} eq 'Point') {
   41         $equation->Error("Entries in a Matrix must be of the same type and length")}
   42       else {$equation->Error("Entries in a $type->{name} must be of the same type")}
   43     }
   44   }
   45   $list = bless {
   46     coords => $coords, type => $type, open => $open, close => $close,
   47     paren => $paren, equation => $equation, isConstant => $constant
   48   }, $equation->{context}{lists}{$type->{name}}{class};
   49   $list->checkInterval;
   50   $list->_check;
   51 #  warn ">> $list->{type}{name} of $list->{type}{entryType}{name} of length $list->{type}{length}\n";
   52   if ($list->{isConstant}) {
   53     my $saveCBI = $list->{canBeInterval};
   54     $list = Parser::Value->new($equation,[$list->eval]);
   55     $list->{type} = $type; $list->{open} = $open; $list->{close} = $close;
   56     $list->{value}->{open} = $open, $list->{value}->{close} = $close
   57       if ref($list->{value});
   58     $list->{canBeInterval} = $saveCBI if $saveCBI;
   59   }
   60   return $list;
   61 }
   62 
   63 sub checkInterval {
   64   my $self = shift;
   65   if ((($self->{open} eq '(' || $self->{open} eq '[') &&
   66        ($self->{close} eq ')' || $self->{close} eq ']') && $self->length == 2) ||
   67       ($self->{open}.$self->{close} eq '[]' && $self->length == 1))
   68           {$self->{canBeInterval} = 1}
   69 }
   70 
   71 sub _check {}
   72 
   73 ##################################################
   74 
   75 #
   76 #  Evaluate all the entries in the list
   77 #    then process the results
   78 #
   79 sub eval {
   80   my $self = shift; my @p = ();
   81   foreach my $x (@{$self->{coords}}) {push(@p,$x->eval)}
   82   $self->_eval(@p);
   83 }
   84 
   85 #
   86 #  Call the appropriate creation routine from Value.pm
   87 #  (Can be over-written by sub-classes)
   88 #
   89 sub _eval {
   90   my $self = shift;
   91   my $type = 'Value::'.$self->type;
   92   my $value = $type->new(@_);
   93   $value->{open} = $self->{open}; $value->{close} = $self->{close};
   94   return $value;
   95 }
   96 
   97 #
   98 #  Reduce all the entries in the list
   99 #  Mark the result as a zero or constant vector as appropriate
  100 #  Do any sub-class defined reductions.
  101 #
  102 sub reduce {
  103   my $self = shift;
  104   my @coords = (); my $zero = 1; my $constant = 1;
  105   foreach my $x (@{$self->{coords}}) {
  106     $x = $x->reduce; return if $self->{equation}{error};
  107     $zero = 0 unless $x->{isZero};
  108     $constant = 0 unless $x->{isConstant};
  109   }
  110   $self->{isZero} = 1 if $zero and scalar(@coords) > 0;
  111   $self->{isConstant} = 1 if $constant;
  112   ## check matrix for being identity
  113   return Parser::Value->new($self->{equation},[$self->eval]) if $constant;
  114   $self->_reduce;
  115 }
  116 #
  117 #  Stub for sub-classes.
  118 #
  119 sub _reduce {shift}
  120 
  121 #
  122 #  Substitute in each coordinate
  123 #  Mark the result as a zero or constant vector as appropriate
  124 #
  125 sub substitute {
  126   my $self = shift;
  127   my @coords = (); my $zero = 1; my $constant = 1;
  128   foreach my $x (@{$self->{coords}}) {
  129     $x = $x->substitute; return if $self->{equation}{error};
  130     $zero = 0 unless $x->{isZero};
  131     $constant = 0 unless $x->{isConstant};
  132   }
  133   $self->{isZero} = 1 if $zero and scalar(@coords) > 0;
  134   $self->{isConstant} = 1 if $constant;
  135   ## check matrix for being identity
  136   return Parser::Value->new($self->{equation},[$self->eval]) if $constant;
  137   return $self;
  138 }
  139 
  140 #
  141 #  Copy all the list entries as well as the list object.
  142 #
  143 sub copy {
  144   my $self = shift; my $equation = shift;
  145   my $new = $self->SUPER::copy($equation);
  146   $new->{coords} = [];
  147   foreach my $x (@{$self->{coords}}) {push(@{$new->{coords}},$x->copy($equation))}
  148   return $new;
  149 }
  150 
  151 ##################################################
  152 
  153 #
  154 #  Return the coordinate array reference
  155 #
  156 sub coords {(shift)->{coords}}
  157 
  158 #
  159 #  Get the variables from all the coordinates
  160 #
  161 sub getVariables {
  162   my $self = shift; my $vars = {};
  163   foreach my $x (@{$self->{coords}}) {$vars = {%{$vars},%{$x->getVariables}}}
  164   return $vars;
  165 }
  166 
  167 #
  168 #  Convert the list to a matrix with given open and close parens
  169 #  (Used my Matrix to convert the rows from points and vectors to
  170 #   matrices so they print properly.  Probably a mistake.)
  171 #
  172 sub makeMatrix {
  173   my $self = shift;
  174   my ($name,$open,$close) = @_;
  175   bless $self, $self->{equation}{context}{lists}{$name}{class};
  176   $self->{type}{name} = $name;
  177   $self->{open} = $open; $self->{close} = $close;
  178 }
  179 
  180 ##################################################
  181 #
  182 #  Generate the various output formats.
  183 #
  184 
  185 #
  186 #  Produce a string version.
  187 #
  188 sub string {
  189   my $self = shift; my $precedence = shift; my @coords = ();
  190   foreach my $x (@{$self->{coords}}) {push(@coords,$x->string)}
  191   return $self->{open}.join(',',@coords).$self->{close};
  192 }
  193 
  194 #
  195 #  Produce TeX version.
  196 #
  197 #  Use stretchable open and close delimiters (quoting braces)
  198 #
  199 sub TeX {
  200   my $self = shift; my $precedence = shift; my @coords = ();
  201   my ($open,$close) = ($self->{open},$self->{close});
  202   $open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
  203   $open  = '\left' .$open  if $open  ne '';
  204   $close = '\right'.$close if $close ne '';
  205   foreach my $x (@{$self->{coords}}) {push(@coords,$x->TeX)}
  206   return $open.join(',',@coords).$close;
  207 }
  208 
  209 #
  210 #  Produce perl version
  211 #
  212 sub perl {
  213   my $self = shift; my $parens = shift; my $matrix = shift;
  214   my $perl; my @p = ();
  215   foreach my $x (@{$self->{coords}}) {push(@p,$x->perl)}
  216   $perl = $self->type.'('.join(',',@p).')';
  217   $perl = 'Closed('.$perl.')'
  218     if $self->{canBeInterval} && $self->{open}.$self->{close} eq '[]';
  219   $perl = '('.$perl.')' if $parens;
  220   return $perl;
  221 }
  222 
  223 #########################################################################
  224 #
  225 #  Load the subclasses.
  226 #
  227 
  228 use Parser::List::Point;
  229 use Parser::List::Vector;
  230 use Parser::List::Matrix;
  231 use Parser::List::List;
  232 use Parser::List::Interval;
  233 use Parser::List::AbsoluteValue;
  234 
  235 #########################################################################
  236 
  237 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9