Part 1

Write a script that accepts a number and returns the Excel Column Name it represents and vice-versa.

Excel columns start at A and increase lexicographically using the 26 letters of the English alphabet, A..Z. After Z, the columns pick up an extra “digit”, going from AA, AB, etc., which could (in theory) continue to an arbitrary number of digits.

Suppose we are asked the following: Write a script to partition the linked list such that all nodes less than k come before nodes greater than or equal to k. 

For example the linked list: 1 → 4 → 3 → 2 → 5 → 2

with k = 3

would be changed to 1 → 2 → 2 → 4 → 3 → 5.

This question was one of two parts to Perl Weekly Challenge 059. My solution can be outlined as

1. Walk the linked list and identify which nodes are less than k.
2. Push each of these nodes into an array.
3. Each node pushed to the array is also removed from the list.
4. The array is sorted by node value (optional).
5. The nodes from the array are added to the beginning of the list.

In Perl this is what the above steps look like.

When run with the example above we have the following

$ perl -Iperl perl/ch-1.pl
Original: 1 -> 4 -> 3 -> 2 -> 5 -> 2
Partitioned: 1 -> 2 -> 2 -> 4 -> 3 -> 5

Notes

• The main code is in LinkedList.pm, with a small test driver called ch-1.pl. Both are in the GitHub gist linked to by the code excerpt.
• Class::Struct was used for the Linked List itself, as well as the nodes. This way of representing classes in Perl is not as popular as it once was but it is still a favorite of mine. I have used it for past PWC challenges, most relatedly for Priority Queues.
• Also, another core module, Tie::RefHash was used in order to conveniently use the list nodes as hash keys.

Count The Different Bits

Part  Two of this week's challenge was a smaller problem involving counting the number of complementary bits in the binary representations of pairs of numbers. The difference counts are all then summed.

Notes

• This works by comparing the bit on the far right in each number to each other. This bit is then shifted off and the next bit checked and so on.
• I found this Bitwise Operator Calculator very helpful to refresh my memory on working with bits. It is not something I have done in a long time!

Suppose we are asked to write a script to invert the tree, by mirroring the children of every node, from left to right, as was the subject of Perl Weekly Challenge 057. How is this done? It turns out the procedure is quite simple and can be expressed quite concisely in terms of a recursion.

1. invert() the left subtree
2. invert() the right subtree
3. swap the left and right subtrees

The code below is based on some previous code, in fact it is virtually identical to that from Graph Visualization (for small graphs) with the addition of an invert() function. Also, the edge labels were added to the graph visualization.

For the full code listing read the GitHub Gist that is linked to.

The Graph module is useful in that it provides convenient helper functions and allows for easy integration with graph visualization packages such as Graphviz, among others.

Here is the original binary tree, shown using Graphviz.

And here is the same tree inverted.

Visualizing graphs is somewhat surprisingly complex when the size of the graph (i.e. the number of vertices and edges) gets very large. Even relatively small graphs become unreadable balls of spaghetti unless the layout is well done. Happily, there are many great packages for visualizing graphs. Perhaps the oldest and most widely used is Graphviz. Sometimes even Graphviz is a bit much of the graph is very small, sometimes you'd be happy with just some console output. As in many situations, it turns out there is a CPAN module for that! In this case the module is Graph::Easy which provides support for a variety of input and output formats. Let's see how it is used with Perl Weekly Challenge 056.

The Challenge

You are given a binary tree and a sum, write a script to find if the tree has a path such that adding up all the values along the path equals the given sum. Only complete paths (from root to leaf node) may be considered for a sum.

What I Did

Graph::Easy is used here in display_path(). There we take our graph and highlight the path vertices with an asterisk and then format it in Graph::Easy's own markup format. We could have also used another input format (such as GraphViz dot format or GDL) if the situation needed.

If we use the above functions with the following code
my $graph = new Graph(multivertexed => true);
my @a = (11, 6, 8, 19, 4, 10, 5, 17, 43, 49, 31);     
my $root;     
for my $a (@a){          
   if(!$root){             
       $root = insert($graph, $root, $a)         
   }
   else{
            insert($graph, $root, $a)         
   }     
}     
while($graph->has_vertex("left") && $graph->has_vertex("right")){
   $graph->delete_vertices("left", "right");     
}     
my $path = find_path_sum($graph, SUM, [$root]);     
display_path($graph, $path); 

Then we would have something that looks like this!

The path showing the sum of 35 is highlighted in this console output.

If we prefer something a little nicer than we can output a Graphviz dot file and then if we run the command
$ dot -Tpng ch-2.dot -o ch-2.png
We'd get this:

Notes

• Obviously this would not be a great method of visualizing graphs of any size but for small graphs this sort of formatted console output is perfect for quick debugging!
• Graph::Easy also installs a command line tool graph-easy. This is convenient for command line pipes and scripts, especially if you just want to quickly displays someone else's data.

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 

Part 2

The Problem

Write a script that dumps its own source code. 

What I Did

Sample Run

$ perl perl/ch-2.pl
print<<''x2,"\n"
print<<''x2,"\n"

$ perl perl/ch-2.pl | diff - perl/ch-2.pl
$

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.

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.

What I Did

Sample Run

$ perl perl/ch-2.pl
Start:  $1
Double: $2
Add One:  $3
Double: $6
Double: $12
Double: $24
Add One:  $25
Double: $50
Double: $100
Double: $200

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

$ perl perl/ch-2.pl
Start:  $1
Add One:  $2
Add One:  $3
Double: $6
Double: $12
Double: $24
Add One:  $25
Double: $50
Double: $100
Double: $200

Notes

• 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.
• The most cited reference on Genetic Programming seems to be Koza's Genetic Programming: On the Programming of Computers by Means of Natural Selection
• 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:

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.

Sample Run

$ perl perl/ch-1.pl
Red: 2
Green: 4
Black: 6
Yellow: 1
Blue: 3

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

1. 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.
2. 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.