RabbitFarm
2025-06-05
Incremental Taxation
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1: Increment Decrement
You are given a list of operations. Write a script to return the final value after performing the given operations in order. The initial value is always 0.
Let’s entertain ourselves with an over engineered solution! We’ll use Parse::Yapp to handle incrementing and decrementing any single letter variable. Or, to put it another way, we’ll define a tiny language which consists of single letter variables that do not require declaration, are only of unsigned integer type, and are automatically initialized to zero. The only operations on these variables are the increment and decrement operations from the problem statement. At the completion of the parser’s execution we will print the final values of each variable.
The majority of the work will be done in the .yp yapp grammar definition file. We’ll focus on this file first.
The declarations section will have some token definitions and a global variable declaration.
For our simple language we’re just going to define a few tokens: the increment and decrement operators, our single letter variables.
We’re going to define a single global variable which will be used to track the state of each variable.
The rules section defines the actions of our increment and decrement operations in both prefix and postfix form. We’ll also allow for a completely optional variable declaration which is just placing a single letter variable by itself
-
program: statement {$variable_state}
| program statement
;
statement: variable_declaration
| increment_variable
| decrement_variable
;
variable_declaration: LETTER {$variable_state->{$_[1]} = 0}
;
increment_variable: INCREMENT LETTER {$variable_state->{$_[2]}++}
| LETTER INCREMENT {$variable_state->{$_[1]}++}
;
decrement_variable: DECREMENT LETTER {$variable_state->{$_[2]}--}
| LETTER DECREMENT {$variable_state->{$_[1]}--}
;
◇
The final section of the grammar definition file is, historically, called programs. This is where we have Perl code for the lexer, error handing, and a parse function which provides the main point of execution from code that wants to call the parser that has been generated from the grammar.
The parse function is for the convenience of calling the generated parser from other code. yapp will generate a module and this will be the module’s method used by other code to execute the parser against a given input.
Notice here that we are squashing white space, both tabs and newlines, using tr. This reduces all tabs and newlines to a single space. This eases further processing since extra whitespace is just ignored, according to the rules we’ve been given.
Also notice the return value from parsing. In the rules section we provide a return value, a hash reference, in the final action code block executed.
-
sub parse{
my($self, $input) = @_;
$input =~ tr/\t/ /s;
$input =~ tr/\n/ /s;
$self->YYData->{INPUT} = $input;
my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
return $result;
}
◇
-
Fragment referenced in 6.
This is really just about the most minimal error handling function there can be! All this does is print “syntax error”when the parser encounters a problem.
-
sub error{
exists $_[0]->YYData->{ERRMSG}
and do{
print $_[0]->YYData->{ERRMSG};
return;
};
print "syntax␣error\n";
}
◇
-
Fragment referenced in 6.
The lexer function is called repeatedly for the entire input. Regular expressions are used to identify tokens (the ones declared at the top of the file) and pass them along for the rules processing.
-
sub lexer{
my($parser) = @_;
$parser->YYData->{INPUT} or return(q//, undef);
$parser->YYData->{INPUT} =~ s/^[ \t]//g;
##
# send tokens to parser
##
for($parser->YYData->{INPUT}){
s/^(\s+)// and return (q/SPACE/, $1);
s/^([a-z]{1})// and return (q/LETTER/, $1);
s/^(\+\+)// and return (q/INCREMENT/, $1);
s/^(--)// and return (q/DECREMENT/, $1);
}
}
◇
-
Fragment referenced in 6.
There’s one more function we should add. The reason for it is a little complex. Variables defined in the declarations section are considered static and are stored in the lexical pad of the package. So each new invocation of the parse() method will re-use the same variables. They are not cleared or reset. So, we’ll define a subroutine which will clear this for us manually.
Let’s define a small file to drive some tests.
The preamble to the test driver sets the minimum perl version to be the most recent one, to take advantage of all recent changes. We also include the generated module file whihc yapp creates. For test purposes we’ll define some constants, taken from TWC’s examples.
-
use constant TEST0 => q/--x x++ x++/;
use constant TEST1 => q/x++ ++x x++/;
use constant TEST2 => q/x++ ++x --x x--/;
use constant COMPLEX_TEST => <<~END_TEST;
a b c
a++ b++ c++
++a ++b ++c
--a --b --c
a-- b-- c--
a++ ++b c++
END_TEST
◇
-
Fragment referenced in 12.
For printing the results in a nice way we’ll define a small subroutine to display the return value from the parser.
-
sub print_variables{
my($results) = @_;
for my $k (keys %{$results}){
print $k;
say qq/:\t$results->{$k}/;
}
}
◇
-
Fragment referenced in 11.
-
MAIN:{
my $parser = IncrementDecrement->new();
say TEST0;
say print_variables $parser->parse(TEST0);
say TEST1;
$parser->clear();
say print_variables $parser->parse(TEST1);
say TEST2;
$parser->clear();
say print_variables $parser->parse(TEST2);
say COMPLEX_TEST;
$parser->clear();
say print_variables $parser->parse(COMPLEX_TEST);
}
◇
-
Fragment referenced in 11.
Sample Run
$ yapp -m IncrementDecrement perl/IncrementDecrement.yp; mv IncrementDecrement.pm perl; perl -Iperl perl/ch-1.pl --x x++ x++ x: 1 x++ ++x x++ x: 3 x++ ++x --x x-- x: 0 a b c a++ b++ c++ ++a ++b ++c --a --b --c a-- b-- c-- a++ ++b c++ b: 1 a: 1 c: 1
Part 2: Tax Amount
You are given an income amount and tax brackets. Write a script to calculate the total tax amount.
After over doing the complexity for the first part, we’ll make this one quite a bit shorter.
The main section is just some basic tests.
-
MAIN:{
say calculate_tax 10, [[3, 50], [7, 10], [12,25]];
say calculate_tax 2, [[1, 0], [4, 25], [5,50]];
say calculate_tax 0, [[2, 50]];
}
◇
-
Fragment referenced in 16.
-
{
my $tax_bracket = shift @{$tax_brackets};
if($tax_bracket->[0] <= $income){
$taxable = $tax_bracket->[0] - $taxable;
$tax += ($taxable * ($tax_bracket->[1]/100));
$taxed += $taxable;
}
else{
$tax += (($income - $taxed) * ($tax_bracket->[1]/100));
$taxed = $income;
}
redo unless $taxed >= $income || @{$tax_brackets} == 0;
}
◇
Sample Run
$ perl perl/ch-2.pl 2.65 0.25 0
References
posted at: 22:52 by: Adam Russell | path: /perl | permanent link to this entry