PLEAC, for those unfamiliar with it, is the Programming Language Examples Alike Cookbook. This is a brilliant site which takes examples of Perl, given in Perl Cookbook by Christiansen and Torkington, and invites contributors to demonstrate how other languages implement the same functionality. Many languages are in the process of being compared and contrasted in this way, including Python, Ruby, Tcl and Haskell. All manner of functionality is covered, from Strings, Numbers, Dates and Times through to Internet Services, CGI Programming and Web Automation.
For the next few postings I am going to do a PLEAC for Protium. You won't find Protium on PLEAC's pages because PLEAC is limited to open-source languages. Protium is proprietary and closed-source (at present.)
The challenge with converting from Perl to Protium is similar to that faced by linguists translating from one human language to another: do you translate the sense of the utterance, or do you just translate word for word. For example, the Tok Pisin word rabisman literally means "rubbish man". However, it is almost never used that way. Instead it often carries the sense of "fool" or "good-for-nothing." So when converting the Perl to Protium, I've tried to give the sense of the Perl, rather than follow it line for line or word for word.
There will be the odd non-PLEAC posting, but I will try to work my way through the entire PLEAC, all 300K's worth.
Showing posts with label Perl. Show all posts
Showing posts with label Perl. Show all posts
Saturday, December 12, 2009
Tuesday, March 11, 2008
[Perl] How to do it better
There are some really helpful people in the Perl community. I advertised the original posting on comp.lang.perl.misc and received some very useful responses from John W. Krahn and Michele Dondi, as below.
With respect to the rules, John wrote:
John> Why [were] you converting the '|' character and the 'e' character to 'e'?
John> The . character class matches a lot more than just letters, or did you really mean "replace any first character except newline with 'n'".
John> The . character class matches a lot more than just letters.
Then, with respect to the string eval() of each rule, John said, "Ouch! Use a dispatch table instead of string eval()."
At this point Michele Dondi chipped in with, ">my %rule = (
> 1 => sub {
> ( my $arg = shift ) =~ tr/s//d;
> return $arg;
> },
> 2 => sub {
> return join '', sort split //, shift;
> },
Since the keys are numbers, an array may be appropriate."
So there you have it, better rules, anonymous subroutines, and hashes. Powerful stuff.
I wonder how Tcl and the other languages would have done it. Or Protium, for that matter. Any takers?
© Copyright Bruce M. Axtens, 2008
With respect to the rules, John wrote:
John> Why [were] you converting the '|' character and the 'e' character to 'e'?
John> The . character class matches a lot more than just letters, or did you really mean "replace any first character except newline with 'n'".
John> The . character class matches a lot more than just letters.
Then, with respect to the string eval() of each rule, John said, "Ouch! Use a dispatch table instead of string eval()."
At this point Michele Dondi chipped in with, ">my %rule = (
> 1 => sub {
> ( my $arg = shift ) =~ tr/s//d;
> return $arg;
> },
> 2 => sub {
> return join '', sort split //, shift;
> },
Since the keys are numbers, an array may be appropriate."
So there you have it, better rules, anonymous subroutines, and hashes. Powerful stuff.
I wonder how Tcl and the other languages would have done it. Or Protium, for that matter. Any takers?
© Copyright Bruce M. Axtens, 2008
Sunday, March 02, 2008
[Perl] How not to do it?
The header for this website says, "Some useful stuff and some examples of how not to do it." This may fall into the latter category.
One of my kids had been playing a computer-based game which used a variety of word puzzles. The question he posed to me was to take a word, apply a small set of rules to it, as many times as necessary, and come up with another word. He would supply the rules and both words, and I would supply the sequence of rule applications which would effect the conversion.
(I'm no guru when it comes to Perl, so if you see something that could be expressed in a more efficient manner, please let me know.)
These are the rules:
1. Remove all 's'
2. Sort the characters of the word into alphabetic order
3. Convert all vowels to 'e'
4. Replace the first letter with 'n'
5. Drop the last letter
6. Replace letter pairs with 'ow'
My son then said that the start word was 'first' (or 'ant') and the stop word was 'now'. After some fiddling, resulting in the code below, I said, "With these rules you can't get from 'first' to 'now'. Not even from 'ant' to 'now'. But from 'gnat', yes."
So here's the code, for what it's worth. It was assumed that this would be run as a command line tool, so I load up the start word (stored in $root) and a recursion management flag (stored in $managed). Recursion management is defaulted to true. The recursion level is marked with $level and there's a hash, called %deadends, to keep track of "solutions" that shouldn't be pushed any further as they have already been proved not to get any closer to the solution.
Everything else happens in the apply function which looks at every possible combination of rules in pursuit of the target word. After getting the word to check from @_ with shift, a couple of variables are declared and a for loop initiated, stepping through the rules.
Each rule is evaluated against the passed in value in $arg, and stored in $res. $reason is cleared and each test applied to $res.
If $res is the same as $arg, $reason is "equal". If the length of $res is less than 3, $reason is set to "too short". If $managed is 1, and $res is already in the %deadends hash, $reason is set to "deadend", and if $res is equal to "now" (the goal, as it happens) then $reason is set to "found".
If $reason is not empty and not "equal" then print a newline, as many spaces as there are levels of recursion, the rule that got us here, the incoming word and the result of the rule application. If $reason is "deadend" then print an exclamation mark to show that a deadend has been reached, otherwise print a full stop.
If we've actually reached "now", indicate that with an asterisk. (We could exit the script at this point, but I left it to show all the possible paths to the stop word.)
If managing recursion, store the value of $res in the deadends hash.
Now, if $reason is, for some reason, empty, print a newline, as many spaces as there are recursion levels, the rule, and the $arg and the $res. Then increase the value of $level and recursively call apply with the contents of $res. When it returns, decrease the value of $level.
Here's the first call to apply, with a newline displayed once processing returns from the call.
Keeping track of dead-ends proved useful. Without it, the 'first' to 'now' attempt generated at 406K file (redirecting the output). With it, I got a 5K file. Similarly, 'ant' to 'now' was 1.8K without, and 457 bytes with. When it came to starting with 'gnat', a managed conversion generated an 8K file. Without management the laptop slowed to a crawl. After about five minutes I got an "Out of memory!" on stderr, so I killed the perl processing resulting in a 902 Megabyte file.
This is the result of a managed attempt with 'ant' as the start word:
Sadly, no asterisks. Next, the log of a managed run starting with 'gnat'. Success came quite quickly: start with 'gnat' and apply rules 2, 3, 4, 2, 4, 5, 6 and 2. An even shorter path appears further down: 3, 4, 2, 5, 6, and 4. The shortest appears to be 4, 2, 5, 6, 4 -- nnat, annt, ann, aow, now.
Writing this makes me wonder if I should have found some way to jump from a successful traversal back to 'gnat' rather than applying the rules to instances of 'now' in search of an extended path to 'now'. I leave that as an exercise to the reader, and if you work out how to do it, please let me know.
© Copyright Bruce M. Axtens, 2008
One of my kids had been playing a computer-based game which used a variety of word puzzles. The question he posed to me was to take a word, apply a small set of rules to it, as many times as necessary, and come up with another word. He would supply the rules and both words, and I would supply the sequence of rule applications which would effect the conversion.
(I'm no guru when it comes to Perl, so if you see something that could be expressed in a more efficient manner, please let me know.)
These are the rules:
1. Remove all 's'
2. Sort the characters of the word into alphabetic order
3. Convert all vowels to 'e'
4. Replace the first letter with 'n'
5. Drop the last letter
6. Replace letter pairs with 'ow'
My son then said that the start word was 'first' (or 'ant') and the stop word was 'now'. After some fiddling, resulting in the code below, I said, "With these rules you can't get from 'first' to 'now'. Not even from 'ant' to 'now'. But from 'gnat', yes."
So here's the code, for what it's worth. It was assumed that this would be run as a command line tool, so I load up the start word (stored in $root) and a recursion management flag (stored in $managed). Recursion management is defaulted to true. The recursion level is marked with $level and there's a hash, called %deadends, to keep track of "solutions" that shouldn't be pushed any further as they have already been proved not to get any closer to the solution.
Everything else happens in the apply function which looks at every possible combination of rules in pursuit of the target word. After getting the word to check from @_ with shift, a couple of variables are declared and a for loop initiated, stepping through the rules.
Each rule is evaluated against the passed in value in $arg, and stored in $res. $reason is cleared and each test applied to $res.
If $res is the same as $arg, $reason is "equal". If the length of $res is less than 3, $reason is set to "too short". If $managed is 1, and $res is already in the %deadends hash, $reason is set to "deadend", and if $res is equal to "now" (the goal, as it happens) then $reason is set to "found".
If $reason is not empty and not "equal" then print a newline, as many spaces as there are levels of recursion, the rule that got us here, the incoming word and the result of the rule application. If $reason is "deadend" then print an exclamation mark to show that a deadend has been reached, otherwise print a full stop.
If we've actually reached "now", indicate that with an asterisk. (We could exit the script at this point, but I left it to show all the possible paths to the stop word.)
If managing recursion, store the value of $res in the deadends hash.
Now, if $reason is, for some reason, empty, print a newline, as many spaces as there are recursion levels, the rule, and the $arg and the $res. Then increase the value of $level and recursively call apply with the contents of $res. When it returns, decrease the value of $level.
Here's the first call to apply, with a newline displayed once processing returns from the call.
Keeping track of dead-ends proved useful. Without it, the 'first' to 'now' attempt generated at 406K file (redirecting the output). With it, I got a 5K file. Similarly, 'ant' to 'now' was 1.8K without, and 457 bytes with. When it came to starting with 'gnat', a managed conversion generated an 8K file. Without management the laptop slowed to a crawl. After about five minutes I got an "Out of memory!" on stderr, so I killed the perl processing resulting in a 902 Megabyte file.
This is the result of a managed attempt with 'ant' as the start word:
Sadly, no asterisks. Next, the log of a managed run starting with 'gnat'. Success came quite quickly: start with 'gnat' and apply rules 2, 3, 4, 2, 4, 5, 6 and 2. An even shorter path appears further down: 3, 4, 2, 5, 6, and 4. The shortest appears to be 4, 2, 5, 6, 4 -- nnat, annt, ann, aow, now.
Writing this makes me wonder if I should have found some way to jump from a successful traversal back to 'gnat' rather than applying the rules to instances of 'now' in search of an extended path to 'now'. I leave that as an exercise to the reader, and if you work out how to do it, please let me know.
© Copyright Bruce M. Axtens, 2008
Thursday, February 21, 2008
[Perl/PDK/PerlCtrl] Returning an array of arrays for VB6/VBScript
For the last few weeks I've been trying to get used to working with the Perl Development Kit (PDK 7.1) from ActiveState, particularly PerlCtrl.
One of the challenges I've been facing lately is how to return an array of arrays. That is, returning something that in VB6 or VBScript might be represented as Array( Item, Array( Item, Item ), Item ).
Kudos to Perl Monks, who have provided a function which converts a Perl array to a VB array. Interestingly, it also copes with said converted array being embedded in another array and with that array being converted as well. (Bodes well for other projects.)
So what we have below is some Perl code, a PerlCtrl wrapper around a WMI call to list System Services. The wrapper returns a two element array, the first element being an array of all the services which are running, and the second an array of all the services which have been stopped.
Note that without 'use Win32::OLE qw(in);' you can't access the elements of the $colItems collection, as it enables the use of 'in' in the foreach. Similarly, you need Win32::OLE::Variant for all the Variant() calls.
Please don't ask me to explain what's going on in the convertArrayToVBArray sub, because I have no idea. Anyone know?
The second bit of code is a VBScript testing the COM DLL. It's a assumed that you've run the above code through PerlCtrl, generated a DLL and registered it with RegSvr32.
I'm having a lot of fun with Perl. I've been able to take a lot of Perl functionality (Tree::Nary, Data::Trie, Lingua::EN::Inflect, Algorithm::LCSS, Algorithm::Knapsack, Algorithm::BinPack, Algorithm::Bucketizer, Algorithm::Permute, Algorithm::SetCovering, String::LCSS and Statistics::Benford) and turn it into something that VB6 and VBScript can use. I'm impressed. Would that every scripting language had this kind of power.
© Copyright Bruce M. Axtens, 2008
One of the challenges I've been facing lately is how to return an array of arrays. That is, returning something that in VB6 or VBScript might be represented as Array( Item, Array( Item, Item ), Item ).
Kudos to Perl Monks, who have provided a function which converts a Perl array to a VB array. Interestingly, it also copes with said converted array being embedded in another array and with that array being converted as well. (Bodes well for other projects.)
So what we have below is some Perl code, a PerlCtrl wrapper around a WMI call to list System Services. The wrapper returns a two element array, the first element being an array of all the services which are running, and the second an array of all the services which have been stopped.
Note that without 'use Win32::OLE qw(in);' you can't access the elements of the $colItems collection, as it enables the use of 'in' in the foreach. Similarly, you need Win32::OLE::Variant for all the Variant() calls.
Please don't ask me to explain what's going on in the convertArrayToVBArray sub, because I have no idea. Anyone know?
The second bit of code is a VBScript testing the COM DLL. It's a assumed that you've run the above code through PerlCtrl, generated a DLL and registered it with RegSvr32.
I'm having a lot of fun with Perl. I've been able to take a lot of Perl functionality (Tree::Nary, Data::Trie, Lingua::EN::Inflect, Algorithm::LCSS, Algorithm::Knapsack, Algorithm::BinPack, Algorithm::Bucketizer, Algorithm::Permute, Algorithm::SetCovering, String::LCSS and Statistics::Benford) and turn it into something that VB6 and VBScript can use. I'm impressed. Would that every scripting language had this kind of power.
© Copyright Bruce M. Axtens, 2008
Subscribe to:
Posts (Atom)