RabbitFarm

2021-12-19

Stealthy Calculations

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

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 + - * ().

Solution

Main driver.


use strict;
use warnings;
##
# Write a script to implement a four function infix calculator.     
##
use TWCCalculator;
use constant ADD => "10 + 8";
use constant SUBTRACT => "18 - 66";
use constant ADD_SUBTRACT => "10 + 20 - 5";  
use constant MULTIPLY => "10 * 8";
use constant DIVIDE => "52 / 2";
use constant CALCULATE => "(10 + 20 - 5) * 2"; 

MAIN:{
    my $parser = new TWCCalculator();
    $parser->parse(ADD); 
    $parser->parse(SUBTRACT); 
    $parser->parse(ADD_SUBTRACT); 
    $parser->parse(MULTIPLY); 
    $parser->parse(DIVIDE);
    $parser->parse(CALCULATE);
}   

TWCCalculator.yp (the Parse::Yapp code). This file is used to generate a parser module, TWCCalculator.pm, which is used in the code above. This is where the actual parsing of the input and implementation of the calculator is.


%token NUMBER    
%left '+' '-' '*' '/'

%%

line: 
    | expression  {print $_[1] . "\n"} 
;

expression: NUMBER
    | expression '+' expression {$_[1] + $_[3]}
    | expression '-' expression {$_[1] - $_[3]}
    | expression '*' expression {$_[1] * $_[3]}
    | expression '/' expression {$_[1] / $_[3]}
    | '(' expression ')' {$_[2]}
;

%%

sub lexer{
    my($parser) = @_;
    $parser->YYData->{INPUT} or return('', undef);
    $parser->YYData->{INPUT} =~ s/^[ \t]//;
    ##
    # send tokens to parser
    ##
    for($parser->YYData->{INPUT}){
        s/^([0-9]+)// and return ("NUMBER", $1);
        s/^(\+)// and return ("+", $1);
        s/^(-)// and return ("-", $1);
        s/^(\*)// and return ("*", $1);
        s/^(\/)// and return ("/", $1);
        s/^(\()// and return ("(", $1);
        s/^(\))// and return (")", $1);
        s/^(\n)// and return ("\n", $1);
    }  
}

sub error{
    exists $_[0]->YYData->{ERRMSG}
    and do{
        print $_[0]->YYData->{ERRMSG};
            return;
    };
    print "syntax error\n"; 
}

sub parse{
    my($self, $input) = @_;
    $self->YYData->{INPUT} = $input;
    my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
    return $result;  
}

Sample Run


$ yapp TWCCalculator.yp
$ perl ch-1.pl
18
-48
25
80
26
50

Notes

In a long ago (almost exactly two years!) Challenge we were asked to implement a Reverse Polish Notation (RPN) Calculator. For that challenge I wrote a short introduction to the parser module, Parse::Yapp, that I used. See the references below, I think it still holds up.

For this challenge I was able to rely pretty heavily on that older code. I simply changed the expected position of the operators and that was about it!

I really like any excuse to use a parser generator, they're a powerful tool one can have at the disposal for a fairly small investment of learning time. Well, practical usage may be quick to learn. Depending on how deep one wants to go there is the possibility also of a lifetime of study of computational linguistics.

Part 2

You are given a positive number, $n. Write a script to find out if the given number is a Stealthy Number.

Solution


use strict;
use warnings;
use boolean; 

sub factor{
    my($n) = @_;
    my @factors = ();
    for  my $j (2 .. sqrt($n)){
        push @factors, [$j, $n / $j] if $n % $j == 0;
    }
    return @factors;  
}

sub stealthy{
    my($n) = @_;
    my @factors = factor($n);
    for(my $i = 0; $i < @factors; $i++){
        for(my $j = 0; $j < @factors; $j++){
            unless($i == $j){
                my($s, $t) = @{$factors[$i]}; 
                my($u, $v) = @{$factors[$j]}; 
                return true if $s + $t == $u + $v + 1; 
            }  
        }  
    }  
    return false; 
}

MAIN:{
    print stealthy(12) . "\n";
    print stealthy(36) . "\n";
    print stealthy(6)  . "\n";
}

Sample Run


$ perl perl/ch-2.pl
1
1
0

Notes

That factor subroutine makes another appearance! Well, here there is a slight modification to get it to return the factors in pairs, each pair an array reference. These are all checked in a loop for the desired property.

This is a classic "generate and test" approach. For an idea of what it would look like to instead constrain the variables to fit the property and then discover which values, if any, match these constraints then please do take a look at my Prolog solution for Challenge 143 which uses a Constraint Logic Programming over Finite Domains (clpfd) approach.

References

Challenge 143

Parse::Yapp

RPN Calculator for Challenge 039

posted at: 19:56 by: Adam Russell | path: /perl | permanent link to this entry

The Weekly Challenge 143 (Prolog Solutions)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

_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 + - * ().

Solution


:-initialization(main). 

expression(Answer) --> term(Answer).
expression(Answer) --> term(Answer0), [(+)], expression(Answer1), {Answer is Answer0 + Answer1}.
expression(Answer) --> term(Answer0), [(-)], expression(Answer1), {Answer is Answer0 - Answer1}.

term(Answer) --> operand(Answer).
term(Answer) --> operand(Answer0), [(*)], term(Answer1), {Answer is Answer0 * Answer1}.
term(Answer) --> operand(Answer0), [(/)], term(Answer1), {Answer is Answer0 / Answer1}.

operand(X) --> [X], {number(X)}.
operand(Answer) --> ['('],  expression(Answer), [')'].

calculator(Expression, Answer):-
    phrase(expression(Answer), Expression). 

main:-
    calculator([10, (+), 20, (-), 5], AnswerA),
    write(AnswerA), nl,
    calculator(['(', 10, (+), 20, (-), 5, ')', (*), 2], AnswerB),
    write(AnswerB), nl,
    halt.  

Sample Run


$ gplc prolog/ch-1.p 
$ prolog/ch-1   
25
50

Notes

This is the sort of problem which is just so clean and straightforward to implement in Prolog. A DCG is used to describe the expected infix notation of the calculator and that pretty much takes care of it.

Part 2

You are given a positive number, $n. Write a script to find out if the given number is a Stealthy Number.

Solution


:-initialization(main). 

stealthy(N):-
    fd_domain(S, 2, N),
    fd_domain(T, 2, N),
    fd_domain(U, 2, N),
    fd_domain(V, 2, N),
    S * T #= N,
    U * V #= N,
    S + T #= U + V + 1,
    fd_labeling([S, T, U, V]).

main:-
    (stealthy(36), format("~d~n", [1]);format("~d~n", [0])),
    (stealthy(12), format("~d~n", [1]);format("~d~n", [0])),
    (stealthy(6), format("~d~n", [1]);format("~d~n", [0])),
    halt. 

Sample Run


$ gplc prolog/ch-2.p 
$ prolog/ch-2  
1
1
0

Notes

Much like Part 1 of this weeks challenge Prolog really shines in terms of providing a short clean solution. Here we describe the desired property in terms of finite domain variables and Prolog let's us know if any values exist which match those constraints.

References

Challenge 143

posted at: 19:56 by: Adam Russell | path: /prolog | permanent link to this entry