I had previously used AI::Prolog to create a hybrid Perl/Prolog solution to a Perl Weekly Challenge. This was not quite so arbitrary as it may have seemed! In fact, Prolog, Symbolic AI, and NLP are subjects taking up a good deal of my mental energy these days. So much so that there has been a discontinuity in my PWC submissions lasting the past several weeks! With the most recent weekly challenge there is once again a new opportunity to use AI::Prolog and hopefully get back into the swing of things as far as contributing solutions every week!
Part 1
Given an array @L of integers. Write a script to find all unique triplets such that a + b + c is same as the given target T. Also make sure a <= b <= c.
This week's Perl Weekly Challenge seems to be on the lighter and more fun side. Part One was to do a "Square Secret Code" and Part Two was to do a quine.
Part 1
The Problem
The square secret code mechanism first removes any space from the original message. Then it lays down the message in a row of 8 columns. The coded message is then obtained by reading down the columns going left to right.
For example, the message is “The quick brown fox jumps over the lazy dog”.
Then the message would be laid out as below:
tbjrd hruto eomhg qwpe unsl ifoa covz kxey
What I Did
Sample Run
$ perl perl/ch-1.pl "The quick brown fox jumps over the lazy dog" tbjrd hruto eomhg qwpe unsl ifoa covz kxey
In a separate entry I described the use of AI::Genetic to solve Part 2 of Perl Weekly Challenge 044. Here is a description of what I did for Part 1 of the same challenge. This ended up being slightly more complex than what was done for Part 2 so it seemed best to split them into two entries.
The Problem
You are given a string "123456789". Write a script that would insert "+" or "-" in between digits so that when you evaluate, the result should be 100.
What I Did
The code for this is much longer than the code for Part 2. What is not shown in the listing below are the definitions of the add, subtract, and no_op functions as well as get_X functions which take substrings of length X from the given string of numbers. Please click the code to be taken to the complete GitHub gist.
Although not shown here each of these functions has, for the convenience of providing a user friendly description of which function is being called, the following line:
return (caller(0))[3] if !defined($x);
This line simply returns the name of the function being called if no arguments are being passed.
ch-1.pl
This code ended up being more complex because more functions were required in order to express the possibilities for all genes. Well, it seems that way at first. At least one function, get_4, seems to be unnecessary given the solution that is learned by AI::Genetic. Eliminating it from consideration would certainly speed things up.
The core of any genetic programming project is the fitness function. Our function for this here has to take into account several things: substrings, substring lengths, and operands of the calculation. Still, ultimately we end of having a fairly sophisticated solution in just 132 lines!
Sample Run
$ perl perl/ch-1.pl 123 - 45 - 67 + 89 = 100
Notes
In the entry for Part 2 I noted how I relied on trial and error vs mathematical specificity or even any sort of intuition for the values of the genetic programming hyper parameters of number of individuals, number of generations, crossover, etc. The same applies here.
In the terminate function some extra accounting is necessary to present the results in the right way. Technically the first operation is 0 + 123 but care is taken to hide this detail.
Multiple solutions exist. After a sufficient number of generations we could inspect more than just one top individual and be reasonably confident we captured all possibilities. I think so anyway, I am familiar enough with the literature at this point to be sure what the theory says about this!
For Part 2 of this week's Perl WeeklyChallenge I took the approach of using the Artificial Intelligence technique of Genetic Programming. I will try and introduce the main concepts here but Genetic Programming is a large and complicated subject. I list some references for further reading at the end of this entry.
The Problem
You have only $1 left at the start of the week. You have been given an opportunity to make it $200. The rule is simple: with every move you can either double what you have or add another $1. Write a script to help you get $200 with the smallest number of moves.
First I define three function: add_one, double, and no_op.
For convenience of providing a user friendly description of which function is being called I added the following line to each of these functions:
return (caller(0))[3] if !defined($x);
This line simply returns the name of the function being called if no arguments are being passed.
Then we define a fitness function and a terminate function.Now, looking at the main part of the code we can see we configure our AI::Genetic with fitness and terminate and setup Genetic Programming hyper parameters of population size, crossover, and mutation. Furthermore we configure our genes: we set ourselves up with 9 genes each one can take on any of three values of executing add_one, executing double, or turning itself off (no_op). Finally we invoke evolve() by providing a strategy of tournamentUniform and setting the number of generations to 1000.
AI::Genetic will then create the 5000 individuals each with the given genes. At each generation each individual's fitness will be assessed. The higher the fitness score the better. Fitter individuals will have a greater chance of reproducing their genes. In this way, after many generations, we converge on a solution which satisfies our requirements.
Interestingly multiple solutions exist which satisfy the requirements and take the same number of moves. Here is another
The source of many of these values, say, for the number of individuals, number of generations, etc is simply trial and error! I do not claim to have a large amount of genetic programming experience and I personally do not have a good instinct as to what reasonable values should be used. My only criteria is that after several iterations a solution seems to converge reasonably fast.
An interesting article on genetic programming in Perl is Genetic Algorithms with Perl. This goes into detail in many of the concepts encapsulated by AI::Genetic.
Fellow Perl Weekly Challenge contributor JJ Merelo has done extensive research work in Genetic Programming with Perl. For the purposes of this challenge I kept with the small simple framework of AI::Genetic but I suspect a more serious practitioner would want to be familiar with his work in this area. See, for example, the paper Still doing evolutionary algorithms with Perl.
I also used a genetic programming approach to Part 1 of Perl Weekly challenge 044. That turned out to be slightly more complex than Part 2 and is written up in its own entry.
Part 1 of Perl Weekly Challenge 043 seemed like a natural fit for a logic programming approach. Still, this is a Perl challenge. What is the best approach then? Interestingly there is a Pure Perl Prolog interpreter AI::Prolog!
First off, the challenge:
Olympic rings with numbers.
There are 5 rings in the Olympic Logo as shown. They are color coded as in Blue, Black, Red, Yellow and Green. We have allocated some numbers to these rings as below: Blue: 8 Yellow: 7 Green: 5 Red: 9 The Black ring is empty currently. You are given the numbers 1, 2, 3, 4 and 6. Write a script to place these numbers in the rings so that the sum of numbers in each ring is exactly 11.
What I Did
The Perl code here is really just a wrapper around a Prolog program. The Prolog code is in the __DATA__ section which is read in and passed to the AI::Prolog constructor. We then make a single query and Prolog deduces the correct solution!
At a very high level this is what the Prolog program does:
member is a (recursively defined) function which determines if some variable X is a member of a list. member takes two arguments so in Prolog terminology it is said to have an arity of 2 and is referred to as member/2.
colors/5 is a function which states that each of the variables Blue, Yellow, Green, etc must be found in the list we were given.
Furthermore, we must satisfy the conditions that each ring must sum to 11. Each ring is given a one letter variable R, G, B, Y, and so forth.
Prolog will deduce the values for Red, Green, Black, ... and that is what will be returned to our Perl code.
Note: the above values are for the question marks as read from left to right in the figure.
Part 2
The second part of Challenge 043 was to generate so called self-descriptive numbers. The following code follows directly form the definition.
Sample Run
$ perl perl/ch-2.pl Base 4: 1210 Base 4: 2020 Base 5: 21200 Base 7: 3211000 Base 8: 42101000
Notes
For anyone interested in learning more on the subject, especially from a Perl perspective, the article Logic Programming with Perl and Prolog is a very nice introduction to going further with Prolog.
There is also no shortage of books on Prolog. A particularly fun one is Adventure in Prolog which instructs the reader in Prolog via the development of a simple text based adventure game.
Part 2 of the most recent Perl Weekly Challenge was to generate a random string of open and close parentheses and validate which strings were properly balanced. That is, which contained and equal number of open and closed parentheses.
Both parts this week were numerical computations. For Part 1 we generate so called attractive numbers which are numbers whose count of prime factors is itself prime. Part 2 generates Leonardo Numbers.
Wrote a function display() which takes as input any number of arrays references.
In display(): Find the maximum array index (Line 13). In this example the arrays are all the same size but we do not assume that will always be the case.
In display(): Loop over the arrays and print out the elements, separated by a tab. If an array does not have an element in that index, print an empty string.
Part 2
ch-2.pl
Sample Run
ch-2.pl output
What I Did
Set up some Readonly arrays to hold the example data.
Initialize @sorted to be the original array. Line 12
Obtain the specified elements and sort them. Line 13
Sort the indices. Line 14.
Put the sorted values in the right locations in @sorted.
Print the now partially sorted array, as specified.
Notes
Thank you to Mohammad S. Anwar for creating and continuously organizing the Perl Weekly Challenge! The PWC began in early 2019 and it has provided a great mental outlet throughout this past year, especially during lengthy interminable conference calls at work! Besides just Perl and Raku I have even been inspired to occasionally submit solutions in C++. Other members have also submitted guest language solutions in Haskell, Python, and, most heroically of all, Postscript.
Also, quite noteworthy, the PWC has spawned a small resurgence in Perl specific blogs as each week participants describe and elaborate on their solutions.
Over the course of the past year or so I have made use of Parse::Yapp for several solutions to the Perl Weekly Challenge. This most recent time, for Challenge 039, I thought that it may be helpful to others to dive deeper into this extremely useful module. My hope is to illustrate the use of Parse::Yapp with examples while taking note of the features being used, both in this blog post and in future postings. I am aiming for a slightly simpler and practical minded example based treatment than what is provided by the current module docs which, to the extent in which they document many of the modules's features, are already quite excellent.
To start, let's look at a specific problem, to implement a Reverse Polish Notation calculator.
Recall that Reverse Polish Notation, otherwise known as postfix notation, is simply the positioning of the operator after the operands. For example, in infix notation we would write 10 + 8 and in postfix notation we would write 10 8 +.
Here we are only concerned with the basic four functions (+, -, *, /).
The code for this is a small script (ch-2.pl) to create some examples and call the parser and the parser definition (Rpn.yp).
ch-2.pl The test script.
Rpn.yp The RPN calculator grammar.
Sample Run
$ perl -I. ch-2.pl 18 -48 80 26 4
What I Did
Define a grammar in Rpn.yp. Unless you really prefer writing your lexing functions elsewhere include them in this file as well.
Execute yapp -m Rpn Rpn.yp. This generates the parser and saves it to a file named Rpn.pm. Specifying an output filename with the -m option will allow you to give the generated parser a name which may make more sense then the default.
Write a wrapper to the parser, as I have done in ch-2.pl. Mine here is very small and straightforward since we're just parsing several strings. Larger projects will need more code to, say, stream larger bodies of text.
The use of -I. in the example above is so that Perl can find Rpn.pm, which happens to be in the same directory I am running the command in (the current working directory). You may have your Rpn.pm (or other generated module) located somewhere else.
The RPN Grammar in Detail
Header
Everything before the first %% is the header section. In Rpn.yp we have just a single line in the header section %token NUMBER which declares a token. In this case NUMBER can be thought of as a label for a whole group of tokens defined in the lexer. Look at line 24. There we can see that a regular expression is defined which identifies numbers and sends them to the parser. NUMBER can be used for any value returned on this line, this is much more convenient than trying to identify which combinations of digits we might want to accept! Technically this %token line is optional, since Yapp does not require this sort of explicit token declaration, however its use certainly helps readability of your grammar.
Rules
The next section, after the first %% is the rules section. This is the heart of the grammar, where we define what we understand to be the definition of the postfix rules are implemented.
Each rule is given a name or label, followed by a : and one or right hand side rule definitions separated by a | and terminated with a ;. Once defined the rule name can be used on the right hand side. In this way rules have a recursive definition.
On line 4 we define a line as being either nothing more than a newline (\n) or a rpn followed by a newline. But what is this rpn? Look to line 7. There the rpn rule is defined as either a NUMBER or an rpn followed by another rpn, followed by an operator. We have four different lines, one for each operator.
After the right hand side of the rule we define actions which are blocks of Perl code which do something according to the rules that have just been defined. For the four operator rules we take the two tokens and perform the expected operation, adding them, subtracting the, etc. We refer to the tokens by their position in the idiomatic Perl argument array @_. We can see, then, that we can think of each action as a subroutine with its own arguments. Inside @_ we can expect to find $_[1] to $_[n] to be the parameters matching the tokens in the rule with $_[0] saved for a reference to the parser object itself. What happens to the value of this action? You can consider them saved as the value of the left hand side! In this way we can see that just with our simple recursively defined rules we can evaluate a somewhat complicated looking postfix expression such as 2 2 + 3 3 + + 1 7 - + ! The answer is 4, by the way.
Note that our top level rule has the action of printing the answer once it sees a newline.
Footer
The final section, everything after the second %% is the footer section. This section is technically optional, however, unless your flexing function is particularly complicated it makes sense to usually place it here along with the error reporting and parse functions. sub lexer is our lexer function. The data is stored in a hash under the {INPUT} key. We loop over the input identifying tokens with regular expressions and sending them to the parser. Each token is sent as a pair where the first element is a name or label (remember NUMBER?) and the second is the value of the token. By using s// we are removing the token from the input, reducing it at each pass. When the input is finally empty, having been reduced in this way, the lexer function completes.
sub error is a simple error reporting function. We can customize the error reporting here, perhaps in an effort to provide something useful to the user so they can correct some syntax error. This is optional and if no function is provided for this then any errors will report the default Parser error.
sub parse is the entry point for the parser. See ch-2.pl where it is called by the test script. We can see that it gets passed in an input string, sets it to the value of the {INPUT} key, and calls YYParse (the actual parser generated by Yapp) with references to the lexer and error functions. Finally, the result from YYParse is returned.
Notes
Implementing an RPN calculator for the Perl Weekly Challenge provided what I considered to be the material for an easily digestible introductory example to Parse::Yapp. As other examples arise I will make additional posts here to further add to the body of documentation.
For the Perl Weekly Challenge 039 we are asked to compute the total time a light is on, based on some log entries.
Part 1
ch-1.pl
Sample Run
$ perl perl/ch-1.pl 1 hours 50 minutes
What I Did
I think this implementation is straightforward enough due to the use of DateTime and DateTime::Duration. Each entry in the log is parsed and the total time on is computed. The parsing itself is only complicated by the need to remove some spaces and unnecessary characters.
The main consideration, other than cleaning and parsing the input, is to detect the overlapping of times, which I use DateTime to do.
