Ninja Numbers Hiding In Trees: The Weekly Challenge #143
The Weekly Challenge #143, or 11 * 13
I mean, there’s lots of fun number-theoretical problems in the Weekly Challenges, so might as well analyze the challenge numbers, right?
TASK #1 › Calculator
Submitted by: Mohammad S Anwar
You are given a string,$s, containing mathematical expression.Write a script to print the result of the mathematical expression. To keep it simple, please only accept
+ - * ().
First off, what’s the easiest way to do this?
Have something else do it, of course! When in doubt, shell it out, as the saying doesn’t go. In this case, qx{ "echo '$math' | bc" } is the core of letting previously solved problems do the work.
But, assuming we really do the work, how would we do the work?
The standard order of operations is Parentheses Exponents Multiplication Division Addition Subtraction, or PEMDAS. In this casem, we are instructed to only worry about P-M-AS.
And for the last three cases — Multiplication, Addition, and Subtraction — I really think that, instead of my favorite technique, Recursion, there’s a solid case for Iteration.
# multiplication
while ( $s =~ / \d+ \s* \* \s* \d+ /mx ) {
$s =~ s/( (\d+) \s* \* \s* (\d+) )/ $2 * $3 /emx;
}
I am aware that the DSL we call regex is a powerful aspect that causes cowards to hate and fear Perl and retire to less powerful and useful languages. (Hey, I don’t really mean that, but if they can throw spite, I do so to.)
There are three flags on the matches and substitutes: /e, /m and /x. As always, read perlre for more information, but:
/mallows multiline input, so if the given function looked like1\n*\n2, there’s nothing that would limit this regex from matching it all. Mostly an always add from Perl Best Practices/xallows you to add whitespace, which is good for readability. For example,$s =~ / \d+ \s* \* \s* \d+ /mxvs$s =~ /\d+\s*\*\s*\d+/mx, which is a bit more unreadable. We could do better, like:$s =~ / \d+ # a digit of one or more characters \s* # zero or more whitespace characters \* # a multiplication character \s* # zero or more whitespace characters \d+ # a digit of one or more characters /mx/emakes the second part of a substituted (s/a/b/, for example), executable. Honestly, there was a point where this was a regular thing I did, especially when I was trying to parse HTML with regular expressions, but let’s not speak of those times. Here’ we’re marking a whole A * B equation, identifying A and B so we can do math to them, and also A * B, so the result of the math can replace the whole equation with the result.
Maybe that should’ve been the commmenting-the-regex example…
So, that gives us MAS, but we want PMAS, so what’s next? We can extract the parentheticals, remove the surrounding parentheses, do the math as normal, then fill it in.
Or, rather…
This Looks Like A Job For RECURSION!
Show Me The Code
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{ say state postderef signatures };
no warnings qw{ experimental };
my @examples;
push @examples, '( 5 * 10 ) - ( 12 * 3 )';
push @examples, '10 + 20 - 5';
push @examples, '(10 + 20 - 5) * 2';
push @examples, '( ( 10 * 20 ) - 5) * 2';
for my $i (@examples) {
my $o = calculator($i);
my $o2 = bc($i);
say <<"END";
Input: \$i = $i
Output: $o
BC: $o2
END
}
sub calculator( $s) {
# parens
while ( $s =~ /\([\s\d\+\-\*]+\)/mix ) {
$s =~ s/\(([\s\d\+\-\*]+\))/calculator( unbracket( $1 ))/e;
}
# multiplication
while ( $s =~ / \d+ \s* \* \s* \d+ /mx ) {
$s =~ s/( (\d+) \s* \* \s* (\d+) )/ $2 * $3 /emx;
}
# addition
while ( $s =~ / \d+ \s* \+ \s* \d+ /mx ) {
$s =~ s/( (\d+) \s* \+ \s* (\d+) )/ $2 + $3 /emx;
}
# subtraction
while ( $s =~ / \d+ \s* \- \s* \d+ /mx ) {
$s =~ s/( (\d+) \s* \- \s* (\d+) )/ $2 - $3 /emx;
}
return $s;
}
sub unbracket( $s ) {
$s =~ s/^\(//;
$s =~ s/\)$//;
return $s;
}
# This is the easy way, using pre-existing code
sub bc( $s) {
my $cmd = qq{ echo '$s' | bc };
my $x = qx{$cmd};
chomp $x;
return $x;
}
$ ./ch-1.pl
Input: $i = ( 5 * 10 ) - ( 12 * 3 )
Output: 14
BC: 14
Input: $i = 10 + 20 - 5
Output: 25
BC: 25
Input: $i = (10 + 20 - 5) * 2
Output: 50
BC: 50
Input: $i = ( ( 10 * 20 ) - 5) * 2
Output: 390
BC: 390
TASK #2 › Stealthy Number
Submitted by: Mohammad S Anwar You are given a positive number,
$n.Write a script to find out if the given number is Stealthy Number.
A positive integer N is stealthy, if there exist positive integers a, b, c, d such that
a * b = c * d = Nanda + b = c + d + 1.
So, we’ve been working with divisors a lot, and we can get every X * Y = N pair fairly easily in one loop. A little bit of busy work and sorting give us arrays of unique pairs.
From there, we go with for my $i ( 0 .. -1 + scalar @factors ) and for my $j ( i + 1 .. -1 + scalar @factors ), and combining those, we should get no doubled indexes and O(nlogn). We then do the other test, which are strictly speaking 2 tests:
a + b + 1 = c + da + b - 1 = c + d
OF course, there is a quick-and-easy way to test — 1 = abs( ($a + $b) - ($c + $d) ) — and we only need one for a number to be stealthy.
Show Me The Code
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{ say postderef signatures state };
no warnings qw{ experimental };
my @examples = qw( 6 12 24 36 );
for my $i (@examples) {
my $o = stealthy_numbers($i);
say <<"END";
Input: \$n = $i
Output: $o
END
}
sub stealthy_numbers ( $n ) {
my @factors = get_factor_pairs($n);
for my $i ( 0 .. -1 + scalar @factors ) {
my ( $ix, $iy ) = $factors[$i]->@*;
for my $j ( $i + 1 .. -1 + scalar @factors ) {
my ( $jx, $jy ) = $factors[$j]->@*;
my $addi = $ix + $iy;
my $addj = $jx + $jy;
return 1 if abs( $addi - $addj ) == 1;
}
}
return 0;
}
sub get_factor_pairs( $n ) {
my %hash;
for my $x ( map { int $_ } 1 .. $n ) {
next unless $n % $x == 0;
my $y = $n / $x;
my $xy = join ',', sort { $a <=> $b } $x, $y;
$hash{$xy} = 1;
}
return map { [ split /,/, $_ ] } sort keys %hash;
}
$ ./ch-2.pl
Input: $n = 6
Output: 0
Input: $n = 12
Output: 1
Input: $n = 24
Output: 1
Input: $n = 36
Output: 1