My Parse::RecDescent skills are strong,...

That, in and of itself is impressive enough to me that I'll forgive your vector math skills being buried in cobwebs.

I wish I could confidently (and accurately) assert that my Parse::RecDescent skills were strong. ;)




Dave

Well said!!
Ikegami never fails to come up with an answer.

Hey there, So the gist is basically encoding looping over lists elegantly...so

{1,2,3}{4,5,6} #composing via dot-product =32 #=1*4 + 2*5 + 3*6

5(1,1,1,1,1} ={5,5,5,5,5}

{1,2,3}x{4,5,6} ={4,10,16}

What I *actually* want is a fair bit more complicated (like variable subsitution), but if I could see just dot cros and scalar mult..I think I could figure the rest out....

Is this just obvious to an expert recdescenter?

I went a little beyond what you said.

• Parentheses can be used to alter execution order.
• * can be used instead of no operator.
• Two scalars can be multiplied together.
• Whitespace can be used liberally.

Notes:

• The parser treats matrices and numbers identically. Type-checking is performed when an operation is performed on them.
• Parens have the higher precedence than anything else. Everything else has the same precedence.
• All binary operators are left-associative.

Todo:

• Add overflow checking when parsing a number and when doing arithmetic.
• Allow negatives and decimals.
• Indicate what caused an error.
• Convert from P::RD to faster system when done.

#!/usr/bin/perl

# make_grammar.pl: Creates Grammar.pm

use strict;
use warnings;

use Parse::RecDescent ();

my $grammar = <<'__END_OF_GRAMMAR__';

   {
      use strict;
      use warnings;

      use List::Util qw( sum );

      sub cross_prod {
         my ($l, $r) = @_;

         my $lt = $l->[0];
         my $rt = $r->[0];

         die("Type error\n") if $lt ne 'matrix';
         die("Type error\n") if $rt ne 'matrix';

         my $lm = $l->[1];
         my $rm = $r->[1];

         die("Size error\n") if @$lm != @$rm;

         return [ number => sum map { $lm->[$_] * $rm->[$_] } 0..$#$lm
+ ];
      }


      sub dot_prod {
         my ($l, $r) = @_;

         my $l_is_num = $l->[0] eq 'number';
         my $r_is_num = $r->[0] eq 'number';

         if ($l_is_num && $r_is_num) {
            my $ln = $l->[1];
            my $rn = $r->[1];
            return [ number => $ln * $rn ];
         }

         if (!$l_is_num && !$r_is_num) {
            my $lm = $l->[1];
            my $rm = $r->[1];

            die("Size error\n") if @$lm != @$rm;

            return [ matrix => [ map { $lm->[$_] * $rm->[$_] } 0..$#$l
+m ] ];
         }

         my ($n, $m) = ($l_is_num
            ? ($l->[1], $r->[1])
            : ($r->[1], $l->[1])
         );

         return [ matrix => [ map { $n * $_ } @$m ] ];
      }
   }

   parse  : expr EOF { $item[1] }

   #
   # expr and expr_ are used instead of the
   # following left-recursive rule (because
   # P::RD can't handle left-recursion):
   #
   #    expr : expr 'x' term { cross_prod($item[1], $item[3]) }
   #         | expr '*' term { dot_prod  ($item[1], $item[3]) }
   #         | expr     term { dot_prod  ($item[1], $item[2]) }
   #         |          term
   # 

   expr   : term expr_[ $item[1] ]

   expr_  : 'x'  <commit> term expr_[ cross_prod($arg[0], $item[3]) ]
          | '*'  <commit> term expr_[ dot_prod  ($arg[0], $item[3]) ]
          | term <commit>      expr_[ dot_prod  ($arg[0], $item[1]) ]
          | { $arg[0] }

   term   : '(' <commit> expr  ')' { $item[3] }
          | '{' <commit> mbody '}' { [ matrix => $item[3] ] }
          | NUMBER                 { [ number => $item[1] ] }

   mbody  : <leftop: NUMBER ',' NUMBER>


   # Tokens

   NUMBER : /\d+/ { 0+$item[1] }

   EOF    : /\Z/


__END_OF_GRAMMAR__

Parse::RecDescent->Precompile($grammar, 'Grammar')
   or die("Bad grammar\n");
[download]

#!/usr/bin/perl

# test.pl

use strict;
use warnings;

use Data::Dumper qw( Dumper );
use Grammar      qw( );

my $parser = Grammar->new();

foreach (
   '4',
   '4 5',
   '4 5 6',
   '4*5*6',
   '{1}',
   '{1,2}',
   '4{1,2}',
   '4{1,2}5',
   '{1,2}{3,4}',
   '{1,2}*{3,4}',
   '{1,2}{3,4}5',
   '{1,2}{3,4}{5,6}',
   '{1,2}x{3,4}',
   '3{1,2}x{3,4}',
   '3x5',
   '3x{1,2}',
   '{1,2}x3',
   '{1,2}x{3,4,5}',
   '{1,2}{3,4,5}',
   '{1,2}x3{4,5}',
   '{1,2}x(3{4,5})',
) {
   my $rv = eval { $parser->parse($_) };

   my $e = $@;
   if ($e) {
      $rv = "$_ = $e";
      $rv =~ s/\n\z//;
   } elsif (!defined($rv)) {
      $rv = "$_ = Bad Expression";
   } else {
      local $Data::Dumper::Indent = 0;
      $rv = Dumper($rv->[1]);
      substr($rv, -1, 1, '');
      substr($rv, 0, 5, $_);
   }

   print("$rv\n");
}
[download]

Output

4 = 4
4 5 = 20
4 5 6 = 120
4*5*6 = 120
{1} = [1]
{1,2} = [1,2]
4{1,2} = [4,8]
4{1,2}5 = [20,40]
{1,2}{3,4} = [3,8]
{1,2}*{3,4} = [3,8]
{1,2}{3,4}5 = [15,40]
{1,2}{3,4}{5,6} = [15,48]
{1,2}x{3,4} = '11'
3{1,2}x{3,4} = '33'
3x5 = Type error
3x{1,2} = Type error
{1,2}x3 = Type error
{1,2}x{3,4,5} = Size error
{1,2}{3,4,5} = Size error
{1,2}x3{4,5} = Type error
{1,2}x(3{4,5}) = '42'
[download]

Update: Since I calculate as I go along instead of build a parse tree, Grammar and parse should be renamed (possibly to Evaluator and evalutate).

Update: Added a test where parens make a difference.

• Generate a table of operators in order of precedence taking note of arity (number of "parameters") and associativity direction (evaluates left to right or right to left).
• Give each row in your table a name (this becomes the rule name).
• For each row generate a rule with a production for each operator in the row. Most such productions will refer to rules for higher precedence rows of the table. Look at the calculator parser examples for hints.
• The first rule (lowest precedence) is likely called something like 'Expression'. The last rule is likely called something like 'Constant'.

In other words, do it much the same way you might for generating a conventional calculator parser. Large parts of the calculator examples can be lifted directly and reused for a vector math calculator.

Give it a go. If you run into specific trouble come back for more advice. When you get it going post it to Cool Uses For Perl.

Parse::RecDescent::FAQ