RogerBW's Blog

I’ve been doing the Perl Weekly Challenges Last week’s was about demonstrating specific coding techniques.

Specifically, the call was for something to use array/hash slices, and something to use a dispatch table. I took a while to come up with something that would be well-handled by slices, but eventually settled on a moving-average calculation; each number is accompanied by the average of itself, the previous number in the list, and the next.

use List::Util qw(sum);

my @data=map {rand()} (1..10);

my @ma=map {sum(@data[$_-1..$_+1])/3} (1..$#data-1);

and similarly in Perl6 (where sum is now built in):

my @data=map {rand}, (1..10);

my @ma=map {sum(@data[$_-1..$_+1])/3}, (1..@data.end-1);

For the dispatch table I built a toy RPN calculator.

my @stack=();

my %op=(
  add => \&add,
  '+' => \&add,
  sub => \&sub,
  '-' => \&sub,
  mul => \&mul,
  '*' => \&mul,
  div => \&div,
  '/' => \&div,
  neg => \&neg,
  dup => \&dup,
  pop => \&pop,
  exch => \&exch,
    );

There's some genuine point to using a dispatch table here, because we actually have multiple references to the same thing.

Then it's just a matter of looping through the input parameters and processing them. No stack underflow detector, which is a pity.

foreach my $p (@ARGV) {
  if (exists $op{$p}) {
    $op{$p}->();
  } elsif ($p =~ /^[.0-9]+$/) {
    push @stack,$p;
  } else {
    die "Unknown input $p\n";
  }
  print join(' ',@stack),"\n";
}

And then the operators.

sub add {
  push @stack,(pop @stack) + (pop @stack);
}
sub sub {
  push @stack,-((pop @stack) - (pop @stack));
}
sub mul {
  push @stack,(pop @stack) * (pop @stack);
}
sub div {
  push @stack,1/((pop @stack) / (pop @stack));
}
sub neg {
  push @stack,-(pop @stack);
}
sub dup {
  push @stack,$stack[-1];
}
sub pop {
  pop @stack;
}
sub exch {
  ($stack[-1],$stack[-2])=($stack[-2],$stack[-1]);
}

In perl6, this is the first time I've got any kind of reference to come out right…

my @stack=();

my %op=(
  add => &add,
  '+' => &add,
  sub => &sub,
  '-' => &sub,
  mul => &mul,
  '*' => &mul,
  div => &div,
  '/' => &div,
  neg => &neg,
  dup => &dup,
  pop => &pop,
  exch => &exch,
    );

And the rest is pretty much the same except for syntax differences.

for @*ARGS -> $p {
  if (%op{$p}:exists) {
    %op{$p}.();
  } elsif ($p ~~ /^<[.0..9]>+$/) {
    push @stack,$p;
  } else {
    die "Unknown input $p\n";
  }
  say join(' ',@stack);
}

sub add {
  push @stack,(@stack.pop) + (@stack.pop);
}
sub sub {
  push @stack,-((@stack.pop) - (@stack.pop));
}
sub mul {
  push @stack,(@stack.pop) * (@stack.pop);
}
sub div {
  push @stack,1/((@stack.pop) / (@stack.pop));
}
sub neg {
  push @stack,-(@stack.pop);
}
sub dup {
  push @stack,@stack[* -1];
}
sub pop {
  @stack.pop;
}
sub exch {
  (@stack[* -1],@stack[* -2])=(@stack[* -2],@stack[* -1]);
}

I generally prefer "solve a problem by whatever means you see fit" to "demonstrate this particular technique" questions.