DEV Community: Yozen Hernandez

Using cpanm to Install Perl Modules in a Conda Environment

Yozen Hernandez — Wed, 01 Jul 2020 01:30:11 +0000

As a devoted Perl programmer, I find myself making heavy use of the fantastic Perl module repository, CPAN. And I do my best to keep up with all the latest goings-on with Perl.

I also have recently gotten hooked on conda, a neat tool which combines package management and environment management. If you haven't checked that out yet, I suggest you give it a look to see if it suits your needs.

TL;DR

(Full post after this tl;dr)

# envname is the name of your (existing) conda env
conda activate envname
# cpanm is available on either conda-forge or
# bioconda, so add conda-forge (or look up
# how to set up bioconda if you need tools
# for bioinformatics)
conda config --add channels conda-forge
# Install cpanm
conda install perl-app-cpanminus
# packagename is the name of the Perl package you want
env PERL5LIB="" PERL_LOCAL_LIB_ROOT="" PERL_MM_OPT="" PERL_MB_OPT="" $CONDA_PREFIX/bin/cpanm packagename

If that didn't work:

# Make sure gcc is installed
# Replace gcc with gxx if you need to compile C++
conda install -n envname gcc_impl_linux-64
conda activate envname
declare perlarchloc=$($CONDA_PREFIX/bin/perl -V::installarchlib: | sed "s/[' ]//g")
for conffile in "Config_heavy.pl" "CORE/config.h" "Config.pm"
do
    sed -i -E 's%/tmp/build/[a-zA-Z0-9]+/perl_[0-9]+/_build_env%'"$CONDA_PREFIX"'%g' "$perlarchloc"/"$conffile"
done
unset perlarchloc

If that still didn't work, jump to the last section.

/tl;dr

Installing Perl and Python Packages

Conda is written in Python, and I think because of that there is a slight bias towards things in Python working well. Case in point, installing a python module which hasn't already been packaged in a conda channel is relatively simple:

# envname is the name of your (existing) conda env
conda activate envname
# Make sure pip is installed
conda install pip
# packagename is the name of the python package you want
pip install packagename

Cool. Now, how about a Perl package?

# envname is the name of your (existing) conda env
conda activate envname
# cpanm is available on either conda-forge or
# bioconda, so add conda-forge (or look up
# how to set up bioconda if you need tools
# for bioinformatics)
conda config --add channels conda-forge
# Install cpanm
conda install perl-app-cpanminus
# packagename is the name of the Perl package you want
cpanm packagename

If this worked for you, great! If it didn't, well let's see what could have gone wrong.

Problem 1: local::lib or other environment variables

A lot of us like to use local::lib for installing Perl packages locally, without needing to mess with system-level Perl. This works great in general. Not so much when you're letting conda take care of things.

There are a few reasons you want to use conda, and if you're reading this, you probably already know why (go ahead and look up more about conda if you really don't know how useful it can be). And as such, it's preferable for you to install your Perl modules for an environment only in that environment.

Maybe your environment uses a different version of perl than your system (or another environment). Maybe you share the conda environment with many users, and you want any user of it to have access to some specific module(s).

Unfortunately, having local::lib set up might mean that the cpanm command from earlier installed the module only for you, outside of the conda env:

$ perldoc -l packagename
$HOME/perl5/lib/perl5/packagename/packagename.pm

Ugh.

To avoid this, and any other environment variables that affect Perl modules from interfering, you might try this:

env PERL5LIB="" PERL_LOCAL_LIB_ROOT="" PERL_MM_OPT="" PERL_MB_OPT="" $CONDA_PREFIX/bin/cpanm packagename

The above worked for me, and its a bit ugly but I needed a solution in the moment. If you know of a better way, let me know in the comments and I'll update the post.

Problem 2: Modules using XS

It turns out that installing a module that uses XS (as many modules that need the speed of C, or access to Perl internals do) in this way does not work. It's a known bug in conda, too.

What happens is that the the configuration for cpanm retains some paths relative to the directory in which it was built, rather than to the conda environment (as you'll see in the last comment in that bug report).

That comment also explains how to fix the issue, but I will reproduce that solution here, a bit more generalized (this assumes the version of Perl you installed is 5.26.2, so make sure you check that first):

# Make sure gcc is installed
# Replace gcc with gxx if you need to compile C++
conda install -n envname gcc_impl_linux-64
conda activate envname
declare perlarchloc=$($CONDA_PREFIX/bin/perl -V::installarchlib: | sed "s/[' ]//g")
for conffile in "Config_heavy.pl" "CORE/config.h" "Config.pm"
do
    sed -i -E 's%/tmp/build/[a-zA-Z0-9]+/perl_[0-9]+/_build_env%'"$CONDA_PREFIX"'%g' "$perlarchloc"/"$conffile"
done
unset perlarchloc

Now just rerun your cpanm command(s) and that should work! Unless...

Problem 2a: compilerroot?!

Turns out that on some configurations, a variable, $compilerroot, is used to set the location of the compiler in the files above. It's not easy to automate (for me), so I suggest you manually open the "Config_heavy.pl" and "Config.pm" files under "$CONDA_PREFIX"/lib/5.26.2/x86_64-linux-thread-multi/ and look for the following line:

my $compilerroot = "";
# Some other code is here

Change that assignment, and remove the if/else code following that line that conditionally sets $compilerroot too. Make sure you use the correct path for your environment's conda prefix (ie, the value of $CONDA_PREFIX when your environment is active):

my $compilerroot = "/your/conda/env/prefix";

# Don't change this code below
local *_ = \my $a;

Now try using cpanm :).

I hope this helped someone. It took me a few hours before I figured this out. In retrospect, it might have been easier to just package the missing perl modules for conda myself!

Edit: Feb 20, 2021. Updated the code block showing how to change the paths in the conda perl headers. Now instead of the perl version being hardcoded, use the location of the arch lib location given by the conda perl installation. Also updated post so that call to conda cpanm use the $CONDA_PREFIX environment variable.

Perl Weekly Challenge 17: Writing Our Own URL Parser in Perl (But Should We?)

Yozen Hernandez — Sun, 21 Jul 2019 06:31:18 +0000

The second challenge in this week's Perl Weekly Challenge asks us to parse a URL:

Create a script to parse URL and print the components of URL. According to Wiki page, the URL syntax is as below:

scheme:[//[userinfo@]host[:port]]path[?query][#fragment]

For example: jdbc:mysql://user:password@localhost:3306/pwc?profile=true#h1

scheme:   jdbc:mysql
userinfo: user:password
host:     localhost
port:     3306
path:     /pwc
query:    profile=true
fragment: h1

Sounds good. Let's try to parse this out. Maybe we'll use a few regex's, and that'll be it.

sub parse_url_regex($url) {
    my %parsed;

    while ($url) {
        if ( !exists $parsed{scheme} ) {
            $url =~ s!^((?:[[:alnum:]]+:)?[[:alnum:]]+):!!;

            # MUST start with the scheme, format: "scheme:"
            croak "Invalid format: url must start with scheme." unless $1;
            $parsed{scheme} = $1;

            return \%parsed unless $url =~ s!^//!!;
        }
        elsif ( !exists( $parsed{host} )
            && $url
            =~ s!^(?:((?:[\d\w]+:)?(?:[\d\w]+)?)@)?([\d\w\.]+)(?::([\d]+))?!!u
            )
        {
            $parsed{userinfo} = $1 // "";
            $parsed{host} = $2 // "";
            $parsed{port} = $3 // "";
        }
        elsif ( !exists( $parsed{path} )
            && $url =~ s!^/((?:[\d\w\.\/]*)+)!!u )
        {
            $parsed{path} = "/" . ( $1 // "" );
        }
        elsif ( !exists( $parsed{query} )
            && $url =~ s!^\?((?:[\d\w\[\]%\"\']+)=(?:[\d\w\[\]%\"\']+))*!!u )
        {
            $parsed{query} = $1 // "";
        }
        elsif ( !exists( $parsed{fragment} )
            && $url =~ s!^#([\d\w\[\]%\"\']+)!!u )
        {
            $parsed{fragment} = $1 // "";
        }
        else {
            croak "Error: Invalid URL? $url";
        }
    }

    return \%parsed;
}

Well that's a lot of (els)ifs and regex's. I'm not sure I'd want to maintain that. Plus, I'm sure it's full of bugs.

sub print_parsed ($url_hash_ref) {
    for my $part (qw(scheme userinfo host port path query fragment)) {
        say "$part:\t" . $url_hash_ref->{$part}
            if exists $url_hash_ref->{$part}
            && defined $url_hash_ref->{$part};
    }
    say "";
}

print_parsed(
    parse_url_regex(
        q"jdbc:mysql://user:password@localhost:3306/pwc?profile=true#h1")
);
#scheme: jdbc:mysql                                      
#userinfo:       user:password
#host:   localhost
#port:   3306
#path:   /pwc
#query:  profile=true                         
#fragment:       h1
print_parsed(
    parse_url_regex(q"http://sri:foo@example.com:3000/foo?foo=bar#23") );
#scheme: http
#userinfo:       sri:foo
#host:   example.com
#port:   3000
#path:   /foo
#query:  foo=bar
#fragment:       23
print_parsed( parse_url_regex(q"https://example.com/") );
#scheme: https
#userinfo:
#host:   example.com
#port:
#path:   /
print_parsed(
    parse_url_regex(
        q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
    )
);
#scheme: http
#userinfo:
#host:   JP納豆.例.jp
#port:   80
#path:   /dir1/引き割り.html
#query:  q=クエリ
#fragment:       メイン

These all look correct. But there must be some errors. For one, blank fields should probably just be left as undef (like userinfo), but for now I've left them as empty strings. More seriously, this doesn't even try to be secure and I wouldn't recommend using it in production.

This is the sort of problem that I would rather reach for a well-established module if I ever needed to do this in production. So let's use a module I know that does that job well, Mojo::URL:

use Mojo::URL;
use Mojo::Util qw(decode url_unescape);

use Test::More tests => 7;
my $parsed_regex
    = parse_url_regex(
    q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
    );
my $parsed_mojo
    = Mojo::URL->new(
    q"http://JP納豆.例.jp:80/dir1/引き割り.html?q=クエリ#メイン"
    );
is( $parsed_mojo->scheme,
    $parsed_regex->{scheme},
    "Mojo and regex sub agree on 'scheme'"
);
is( $parsed_mojo->userinfo // '',
    $parsed_regex->{userinfo},
    "Mojo and regex sub agree on 'userinfo'"
);
is( $parsed_mojo->host, $parsed_regex->{host},
    "Mojo and regex sub agree on 'host'" );
is( $parsed_mojo->port, $parsed_regex->{port},
    "Mojo and regex sub agree on 'port'" );
is( decode( 'UTF-8', url_unescape( $parsed_mojo->path ) ),
    $parsed_regex->{path}, "Mojo and regex sub agree on 'path'" );
is( decode( 'UTF-8', url_unescape( $parsed_mojo->query ) ),
    $parsed_regex->{query},
    "Mojo and regex sub agree on 'query'"
);
is( $parsed_mojo->fragment,
    $parsed_regex->{fragment},
    "Mojo and regex sub agree on 'fragment'"
);

ok 1 - Mojo and regex sub agree on 'scheme'
ok 2 - Mojo and regex sub agree on 'userinfo'
ok 3 - Mojo and regex sub agree on 'host'
ok 4 - Mojo and regex sub agree on 'port'
ok 5 - Mojo and regex sub agree on 'path'
ok 6 - Mojo and regex sub agree on 'query'
ok 7 - Mojo and regex sub agree on 'fragment'

Looks like we did pretty well! You'll notice that since the URL I chose to use includes non-ASCII characters, and Mojo::URL returns strings that are URL-encoded, I had to unescape the URLs and then decode the unicode strings in order to compare them to what my code returned. Also, since I define missing fields as the empty string instead of setting them to undef, I had to use // '' for the userinfo attribute from Mojo::URL.

Ok so we don't seem to run into any errors, and we actually agree (where it counts?) with an established module. Surely there must be some performance cost to doing it this way, right? Let's go back to our trusty Benchmark::Forking module:

                       Rate               mojo from_scratch_regex
mojo                31204/s                 --               -72%
from_scratch_regex 110892/s               255%                 --

Whaaa? We do about 255% better than Mojo::URL? On second thought, that probably makes sense. I'm sure a whole lot more going on inside that module to make sure things are way safer than any thing my code does, and it implements a whole class with stringification, etc.

So, it passes all my tests, seems to agree with a well-established module, and even beats it in speed. This is ready to use in your, or my, next project right??

No way! First off, I did NOT run exhaustive tests. Also, I'm basically some random person off the internet who wrote this in a couple of hours.

Don't try to write your own URL parser for an important application unless you really understand what "RFC 3986, RFC 3987 and the URL Living Standard for Uniform Resource Locators with support for IDNA and IRIs" means. Go with something like Mojo::URL instead.

Fun side project? Sure.

See the full solution as a Gist, here.

Perl Weekly Challenge 16: Decoding a Bitcoin Address in Perl

Yozen Hernandez — Mon, 15 Jul 2019 12:43:13 +0000

Edit: Title (sigh)

Check this post out on my own blog where math text is rendered properly :), but you can't leave any comments :(.

The second challenge of this week's Perl Weekly Challenge deals with Bitcoin, that ubiquitous digital currency we all have heard of, few totally understand, and some wish we had never invested in when we did.

Write a script to validate a given bitcoin address. Most Bitcoin addresses are 34 characters. They consist of random digits and uppercase and lowercase letters, with the exception that the uppercase letter “O”, uppercase letter “I”, lowercase letter “l”, and the number “0” are never used to prevent visual ambiguity. A bitcoin address encodes 25 bytes. The last four bytes are a checksum check. They are the first four bytes of a double SHA-256 digest of the previous 21 bytes. For more information, please refer wiki page.

This sort of challenge was new to me. I never dealt with SHA hashes, decoding, or comparing checksums (at least not within Perl). I have done some programming involving byte-wise or bit-wise computation, but definitely not in Perl. It took a couple of hours reading things over in the wiki before I got a handle on what I needed to do.

Each bitcoin address is a number, though a rather large one, encoded in base-58 which just means there are 58 characters which are used to represent values (as opposed to just 10 in base 10, 0-9). The characters are, in increasing value:

123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz

As stated in the challenge, some characters are omitted since they can be visually confused for each other in some cases: capital letter "O", number "0", capital letter "I", and lowercase letter "l".

Now, having an idea of what characters represent what value, here are the steps, roughly, on decoding and validating a bitcoin address:

Iterate over each symbol in the input address string, convert to a numeric representation multiplied by the "place" of the symbol. Since addresses can be shorter or longer, iterate from right to left.
Add the value to a running total.
Post iteration, convert the numeric total to byte-representation.
If the address is shorter than the longest possible valid bitcoin address, left-pad with '0's.

Seems simple enough, right? Well I haven't read anyone else's blog posts yet, but I ran into a number of issues, which I will detail below.

As mentioned in point 1, we need to iterate over the string in the reverse sense, at least for clarity, since bitcoin addresses are at most 34 characters long, but can be shorter. Starting from the right lets us start a counter at 0 which increases with each leftward move along the string. That counter is used to multiply the value of the current character with the correct power of the base. If that's confusing, this is how you would do the same kind of decoding with base-10 numbers which seems so natural you probably don't realize you are doing it (unless you are a math/CS major I suppose): $1295 = 1\times10^3 + 2\times10^2 + 9\times10^1 + 5\times10^0$.

Now to keep track of the running total of our bitcoin address. In my decoding function:

    my $val;
    my $base = 58;
    my @btc_arr = reverse split( //, $btc_addr );

    while ( my ( $i, $v ) = each @btc_arr ) {
        croak("Invalid bitcoin address") unless (exists $b58{$v});
        $val += $b58{$v} * ($base**$i);
    }

So that doesn't work. Wait, what?

I test the output of my functions as I write them using Test::More. Using an online bitcoin address decoder and the pack/unpack functions (which I've only learned about thanks to these challenges), I compare what I get to the tool's output:

is(unpack("H*", b58_decode('1BvBMSEYstWetqTFn5Au4m4GFg7xJaNVN2')), lc'0077BFF20C60E522DFAA3350C39B030A5D004E839AF415766B', "b58 decode works");

unpack("H*", $blah) converts the whatever bytes are in $blah according to the template "H*", which means turn into a hex string (in big-endian order). The return value of the function is converted into hex and then compared to the hex string I know to be the decoded hex value. I use lowercase to convert it since unpack returns a lowercase string.

The numeric value is turned into bytes and returned in the function more or less like this:

    my $decoded;

    # Bytes are 8-bit == 256 values
    while ($val >= 256) {
        # Get next lowest byte
        my $mod = $val % 256;

        # Prefix chr value of $mod to byte string
        $decoded = chr($mod) . $decoded;
        $val = int($val / 256);
    }

    $decoded = chr($val) . $decoded;

    #0-padding
    $decoded = (0 x (25-length($decoded))) . $decoded;
    return $decoded;

You might notice there are actually two problems here. But the first one is that Perl does not support "big" numbers out of the box. And bitcoin address values are indeed very big numbers. Ok, let's use Math::BigInt. Problem solved, right?

sub b58_decode ($btc_addr) {
    my $val = Math::BigInt->new();
    my $base = Math::BigInt->new(58);
    my @btc_arr = reverse split( //, $btc_addr );

    while ( my ( $i, $v ) = each @btc_arr ) {
        croak("Invalid bitcoin address") unless (exists $b58{$v});
        $val = $base->copy()->bpow($i)->bmuladd($b58{$v}, $val);
    }

    # Decode value to bytes
    my $decoded = $val->to_bytes();

    # 0-padding
    $decoded = (0 x (25-length($decoded))) . $decoded;
    return $decoded;
}

Thanks to the to_byte method in Math::BigInt, I can quickly convert the value to the byte representation. But this still didn't work! Yeah, stupid mistake...I wanted the representation in bytes, and for that you have to use the chr function, not just a plain 0:

    $decoded = (chr(0) x (25-length($decoded))) . $decoded;

My tests finally pass! Now validating doesn't take much at all:

sub btc_valid ($btc_addr) {
    my $decoded = b58_decode($btc_addr);

  # The last four bytes are a checksum check. They are the first four bytes of
  # a double SHA-256 digest of the previous 21 bytes.
    my $checksum = substr $decoded, -4;
    my $data     = substr $decoded, 0, 21;

    return ( $checksum eq substr(sha256( sha256($data) ), 0, 4) ) ? substr($decoded, 0, 1) : undef;
}

The core module Digest::SHA provides the hashing function, sha256. We use substr on the string returned by my decoding function to extract the bytes we want (this turns out to be faster than split/slice/join'ing), and compare the last 4 bytes to the double hash of the first 21 bytes.

The return value of the function upon success came from me looking at this thread (suggested by the bitcoin wiki) and the solutions users there had in other languages. Personally, I think that the Perl solution using Math::BigInt looks a bit more compact than the solutions there, but I'm ready to be blown away by the answers from other challenge participants.

This was certainly a challenging problem to solve, but it forced me to use some parts of my brain and Perl I hadn't had to use before, and that might come in handy.

See the full solution, here.

Perl Weekly Challenge 15, Part 2: Encrypting/Decrypting With the Vigenère Cipher

Yozen Hernandez — Fri, 05 Jul 2019 04:26:36 +0000

Welcome to the second part of my posts on this week's Perl Weekly Challenge. You can find the first part of this post on either dev.to or my personal blog.

Challenge 2

Write a script to implement Vigenère cipher. The script should be able encode and decode. Checkout wiki page for more information.

This seemed like a cool challenge to tackle. Knowing next to nothing about encryption, I was worried that this would take me all week. I actually spent less time on this challenge than I did on part 1!

The idea behind the Vigenère cipher (which should probably be called the Bellaso cipher as Giovan Battista Bellaso was the first one to describe it), is that a message is encrypted using a key and each letter in the key changes the the "alphabet" of each letter of the message. The simplest form of such a cipher is the Caesar cipher, where a message is "encrypted" (because it can hardly be called encryption by today's standards) by picking a fixed shift length and then "rotating" the alphabet. Say you picked a left shift of 10, then "A" would be represented by "Q", "B" by "R", and so on. The Vigenère cipher uses a key to change the shift every letter.

Wikipedia's example gives a message of "ATTACKATDAWN" and a key "LEMON". The key is shorter than the message, so it will need to be repeated, cycling around as many times as needed to cover the message. Then, each corresponding letter in the key determines the alphabetic "shift" to encode the message. Since the key is needed to determine the shift of every letter, this cipher was long held as being "indecipherable" (though nothing lasts forever).

Plaintext:  ATTACKATDAWN
Key:        LEMONLEMONLE
Ciphertext: LXFOPVEFRNHR

The first "L" in "LEMON" indicates a shift of 11, since "L" is eleven letters away from "A". The "E" indicates a shift of 4, and so on. Looking at the "ciphertext" above, you might notice that "A"s always shift to the letter in the key, but this turns out not to be relevant to the solution, at least not my solution.

By now it becomes immediately obvious what must be done: using the numeric values for each letter in the alphabet, do some simple arithmetic to convert each letter in the message into a different letter determined by the numeric value of the key at a position. Since keys can be shorter than the message, you need to use modulo to wrap around the key when processing long messages.

Let's look at the code to see what I mean:

use v5.24;
use strict;
use warnings;
use feature qw(say state signatures);
no warnings "experimental::signatures";
use Carp;

my %tabula;
@tabula{ "A" .. "Z" } = ( 0 .. 25 );

sub encode_vigenere {
    my %args = @_;
    croak "Must supply the 'message' and 'key' arguments to this function.\n"
        unless ( exists $args{message} && exists $args{key} );

    my @message = split //, uc($args{message});
    my @key  = split //, uc($args{key});
    return join "", map {
        ( "A" .. "Z" )
            [ ( $tabula{ $message[$_] } + $tabula{ $key[ $_ % @key ] } ) %
            keys %tabula ]
    } ( 0 .. @message - 1 );
}

sub decode_vigenere {
    my %args = @_;
    croak "Must supply the 'message' and 'key' arguments to this function.\n"
        unless ( exists $args{message} && exists $args{key} );

    my @message = split //, uc($args{message});
    my @key  = split //, uc($args{key});
    return join "", map {
        ( "A" .. "Z" )
            [ ( $tabula{ $message[$_] } - $tabula{ $key[ $_ % @key ] } ) %
            keys %tabula ]
    } ( 0 .. @message - 1 );
}

my $message = $ARGV[0] // "ATTACKATDAWN";
my $key  = $ARGV[1] // "LEMON";

# Encrypt
my $encrypted = encode_vigenere( message => $message, key => $key );
say "Encrypted: $encrypted";

# Decrypt
my $decoded = decode_vigenere( message => $encrypted, key => $key );
say "Decrypted: $decoded";

I built a hash which mapped uppercase Latin letters to a numeric equivalent, and called that %tabula after the term tabula recta used by the people actually using this cipher. Now I've got a mapping between letters and numbers which matches the actual mapping used.

Next each function takes it's input, a message and a key, and splits each of these into arrays so we can iterate over them. A loop iterates over the message, and for each letter in the message we subtract (in the case of encryption) the value of the corresponding letter in the key. Again, since the key is usually shorter, we must use modulo arithmetic dependent on the length of the key to let us wraparound and reuse letters in the key. The new "shifted" value is used as an index into a list of uppercase letters from "A"-"Z", same as when we built the tabula. Another modulo is used, with the length of the alphabet (the keys in the tabula) as the divisor, to make sure the the result of the shift is a valid index. This works even for negative shift values.

Decryption works much the same, except that instead of subtracting the value obtained from the key, we add it. Knowing that, we could make the code even simpler, at the risk of making the interface a bit clunkier:

sub vigenere (%args) {
    croak "Must supply the 'message' and 'key' arguments to this function.\n"
        unless ( exists $args{message} && exists $args{key} );

    my @message = split //, uc($args{message});
    my @key  = split //, uc($args{key});
    my $decode = ( exists $args{decode} && $args{decode} != 0 ) || -1;
    return join "", map {
        ( "A" .. "Z" )[
            ( $tabula{ $message[$_] }
                    + ( ( -1 * $decode ) * $tabula{ $key[ $_ % @key ] } ) ) %
            keys %tabula
        ]
    } ( 0 .. @message - 1 );
}

my $message = $ARGV[0] // "ATTACKATDAWN";
my $key  = $ARGV[1] // "LEMON";

# Encrypt
my $encrypted = vigenere( message => $message, key => $key );
say "Encrypted: $encrypted";

# Decrypt
my $decoded = vigenere( message => $encrypted, key => $key, decode => 1 );
say "Decrypted: $decoded";

Supply any non-0 value to the decode option in the vigenere function to decode rather than encode. I think I would be happy with that, and we could always add wrapper functions to hide that away from the user and still cut down on code repetition:

sub encode_vigenere {
    my %args = @_;
    vigenere(%args, decode => 0);
}

sub decode_vigenere {
    my %args = @_;
    vigenere(%args, decode => 1);
}

Now, even if the user supplies some other value for decode, as long as they use the correct wrapper function, they will get the result they wanted.

See the full solution, here.

Perl Weekly Challenge 15, Part 1: Finding Strong and Weak Primes with Perl

Yozen Hernandez — Fri, 05 Jul 2019 04:26:07 +0000

This week's Perl Weekly Challenge touched on prime number sequences again, and some old-school cryptography (which was pretty exciting). This post is divided into two parts, one for each challenge. Find part 2 on dev.to or my blog on Github Pages.

Challenge 1

Write a script to generate first 10 strong and weak prime numbers.
For example, the *n*th prime number is represented by p(n).

p(1) = 2
p(2) = 3
p(3) = 5
p(4) = 7
p(5) = 11

Strong Prime number p(n) when p(n) > [ p(n-1) + p(n+1) ] / 2
Weak Prime number p(n) when p(n) < [ p(n-1) + p(n+1) ] / 2

Thanks to a previous challenge, I already had some code to generate prime numbers. However, that code only allowed me to iterate through a sequence, generating the next prime each time the iterator was called. This challenge requires either storing all of the values of the sequence, or quickly regenerating them, so that more than one value in the sequence can be tested.

Strong and weak prime numbers are defined by how close they are to their immediate neighbors in the sequence of prime numbers: strong primes are closer to the next number in the sequence, while weak primes are closer to the preceeding number (see the formulae above).

On my first attempt, I chose to generate the numbers on each strong/weak check. I used the Memoize module so that this wouldn't be too expensive, time-wise:

use v5.24;
use strict;
use warnings;
use feature qw(say state signatures);
no warnings "experimental::signatures";
use Memoize;
use List::Util qw(first);

memoize('prime_gen');

sub is_prime {
    my $n = shift;

    return 0 if grep { $n % $_ == 0 } ( 2 .. sqrt($n) );

    return 1;
}

sub prime_iterator {
    my $n = 1;
    return sub {
        1 until is_prime ++$n;
        return $n;
        }
}

sub prime_gen ($n) {
    my $prime_iter = prime_iterator();

    # Throw away the first n-1 values
    $prime_iter->() for (1 .. ($n-1));
    return $prime_iter->();
}

sub is_strong_prime ($n) {
    return ($n > 1) && prime_gen($n) > ((prime_gen($n-1)+prime_gen($n+1))/2);
}

sub strong_prime_gen ($n) {
    my @strong_primes;
    my $i = 1;

    while (@strong_primes < $n) {
        my $p = prime_gen($i);
        push @strong_primes, $p if is_strong_prime($i);
        $i++;
    }

    return pop @strong_primes;
}

sub is_weak_prime ($n) {
    return ($n > 1) && prime_gen($n) < ((prime_gen($n-1)+prime_gen($n+1))/2);
}

sub weak_prime_gen ($n) {
    my @weak_primes;
    my $i = 1;

    while (@weak_primes < $n) {
        my $p = prime_gen($i);
        push @weak_primes, $p if is_weak_prime($i);
        $i++;
    }

    return pop @weak_primes;
}

say "Strong primes: ", join(", ", map {strong_prime_gen($_)} (1 .. 10));
say "Weak primes: ", join(", ", map {weak_prime_gen($_)} (1 .. 10));

Basically, I would call the (strong|weak)_prime_gen functions with the index of the prime I wanted in the sequence. Those functions call things like the prime number generating function prime_gen, and another function which checks if the number is in fact strong or weak. Those checking functions ALSO made calls to the prime_gen function, so I memoized it. As I was writing it, I thought I was being pretty clever...

However, it's pretty clear there are a bunch of issues here. First, while it is nice to clearly separate things and then put them all together exactly how you might need them, a lot of this code could just be merged together -- it's not going to be reused elsewhere. Also, the (strong|weak)_prime_gen functions look really similar. The only difference is the direction of the inequality check which was hidden away in that separate checking function. Lastly, this wastes time iterating over the same prime numbers twice, since first I call the strong_prime_gen function and then the weak_prime_gen function.

I could just iterate over a sequence of prime numbers, all the while making both necessary checks above, and storing the numbers I want to keep in the appropriate lists. I could also have a list of prime numbers since I need those anyway. These are all just ints, and for the challenge I know I only need 10 strong/weak primes anyway, so I don't mind the space trade-off.

So now I just need to consider the cases. As I iterate through the primes, I need to make the inequality checks above. I know I need to have at least 3 elements in my prime numbers sequence to even make such a comparison, so we'll account for that (maybe an if (@primes > 2) or something). Next, is the result of the comparison. A prime can either be greater than (strong), less than (weak) or equal to (balanced) the mean of its immediate neighbors. Hm...sounds a lot like comparisons made using the <=> or cmp operators, which return 1, -1, or 0, respectively, for each of those cases.

sub is_prime ($n) {
    return 0 if grep { $n % $_ == 0 } ( 2 .. sqrt($n) );

    return 1;
}

sub prime_iterator {
    my $n = 1;
    return sub {
        1 until is_prime ++$n;
        return $n;
    }
}

my ( @primes, @strong_primes, @weak_primes, @bal_primes );
my @which_arr = ( \@bal_primes, \@strong_primes, \@weak_primes );
my $iter      = prime_iterator();
my $n         = 10;

while ( ( @strong_primes < $n ) || ( @weak_primes < $n ) ) {
    push @primes, $iter->();
    if ( @primes > 2 ) {
        push $which_arr[ ( $primes[-2] <=> ( $primes[-3] + $primes[-1] ) / 2 )
        ]->@*, $primes[-2];
    }
}

say "First 10 weak primes: " . join( ", ", @weak_primes );
say "First 10 strong primes: " . join( ", ", @strong_primes );

Oh this is much better: far less code, far less repetition, and I don't even need to memoize. I took advantage of the return value of <=> by making a list of the references to the lists I needed, which I called @which_arr. The order is important, because I'm using the return value of <=> as an index into that array, so a -1 (less than) result means that the value should go into the @weak_primes array, which means that the reference to it needs to be the last element of the array. That may be counterintuitive at first, but a -1 index is the same as the last index since negative indices start from the end of the array.

Also probably counterintuitive is that the value we save is not the last value in the @primes sequence, but the second-to-last value, $primes[-2] since that is the last value which can have both to an immediately preceding and an immediately succeeding value.

See the full solution, here.

Perl Weekly Challenge 14: van Eck’s sequence / Adventures in overthinking- making words from US state initials

Yozen Hernandez — Sun, 30 Jun 2019 18:08:58 +0000

Warning This post ended up being pretty long. A million thanks if you make it through to the end.

Original post: https://yzhernand.github.io/posts/perl-weekly-challenge-14/ since math text does not render well here.

This week's Perl Weekly Challenge offered two very nice challenges that I really had to think about. Later in the week, Neil Bowers, who is credited with suggesting the second challenge, posted about an additional challenge since his submission was misunderstood.

Now with that out of the way, let me walk you through how I approached these challenges.

Challenge 1

Write a script to generate Van Eck’s sequence starts with 0. For more information, please check out wikipedia page. This challenge was proposed by team member Andrezgz.

Another week, another numeric sequence :). van Eck's sequence is a bit trickier than other sequences I've generated in previous challenges (see my posts on challenge 9 where I simply generate squares, challenge 12 which discusses Euclid numbers, and challenge 13 which discusses Hofstadter Female and Male sequences), as we will see.

sub van_eck_seq ( $n, $init = 0 ) {

    # Base case. It should always be $init followed
    # by 0, given the definition.
    return ( $init, 0 ) if ( $n == 0 );

    my @seq = van_eck_seq( $n - 1, $init );
    my $m   = first { $seq[$_] == $seq[$n] } reverse( 0 .. ( $n - 1 ) );
    my $val = ( defined $m ) ? ( $n - $m ) : 0;

    return @seq, $val;
}

Going by the definition of the sequence on Wikipedia,

$a_0 = 0$. Then, for $n ≥ 0$, if there exists an $m < n$ such that $a_{m} = a_n$, take the largest such $m$ and set $a_{n+1} = n − m$; otherwise $a_{n+1} = 0$.

I thought of this as "each $n$th term generates the $n+1$th term". So, if you call the function I've written above with van_eck_seq(2) you would get the first 3 elements of the sequence, not the first 2. This is important because I've written the function to be recursive, and the code following the nested call expects that the list it gets back includes the "current" $n
$th term.

Also by that definition, it looks like $a_1 = 0$ since there is never an $m < n$ such that $a_{m} = a_n$. The base case of van_eck_seq(0), therefore, returns a list with items (0, 0).

Actually, that's not totally true: van Eck's sequence can have a different $a_0$ term, which changes the sequence. So my function definition allows an optional setting of that term as it's second argument, $init.

Continuing, for all $n \geq 1$, we make a nested call to the same function, passing it $n-1 and the value of $init (in case the caller changed it) and use the returned sequence to generate the next value.

This line:

my $m   = first { $seq[$_] == $seq[$n] } reverse( 0 .. ( $n - 1 ) );

lets us walk backward through the sequence we got from the nested call so we can find that $m < n$ mentioned in the definition, if any. The value of $val depends on whether or not such an $m$ was found, and then the combined sequence is returned. The function can be called like this:

local $, = ", ";
say van_eck_seq(10);

which gives as output:

0, 0, 1, 0, 2, 0, 2, 2, 1, 6, 0, 5

For this challenge, I used the Memoize module instead of caching myself (see my post on last week's challenge). I also documented the behavior that the function call returns a list of n+1 elements, as a person who would want to use that function might not expect that.

See the full solution, here.

Challenge 2

Using only the official postal (2-letter) abbreviations for the 50 U.S. states, write a script to find the longest English word you can spell? Here is the list of U.S. states abbreviations as per wikipedia page. This challenge was proposed by team member Neil Bowers.

Turns out that this challenge wasn't quite what Neil intended, but I think most of us participants are going to solve it as-is. Further below I write about my solution to his actually intended challenge.

my %longest_word = ( words => [], length => 0 );

#...
open my $wl, "<", "/usr/share/dict/words";
while ( my $w = <$wl> ) {

    # Chomp and drop apostrophes or any other
    # non-alphabetical characters
    chomp $w;
    my $w_alpha = $w;
    $w_alpha =~ s/[^[:alpha:]]//g;

    # Skip unless length is even: all US state codes are bigrams
    next unless ( length($w_alpha) % 2 == 0 );

    # Use unpack to split word into an array of bigrams
    # and use UC to make it all uppercase
    my @w_split = unpack "(a2)*", uc($w_alpha);

    # Skip if the set created from the word is not a
    # proper subset of the US state codes list.
    next unless all { exists $us_states_to_val{$_} } @w_split;

    # By now, we can be sure that the word is only
    # composed of elements in the us_states list.
    if ( length($w_alpha) > $longest_word{length} ) {
        @longest_word{qw(words length)} = ( [$w], length($w) );
    }
    elsif ( length($w_alpha) == $longest_word{length} ) {
        push $longest_word{words}->@*, $w;
    }
}

We start with a list of US states (not shown) and use a hash to store the length of the longest word seen and a list of those words, since there may be more than one. The length value is initialized to 0.

We skip all odd-length strings, because US state codes are all 2 letters long (bigrams). I tried using unpack for the first time ever because it looked like a nice way to generate a list of bigrams from a string. Then we reject any words which have a bigram which is not in the list of US state codes.

The final bit of code is just an if-elsif branch which checks if the word we found is longer than the longest seen so far. If it is, we basically reset the hash and store the word and new longest length. If it is the same, then we push the word onto the arrayref in the "words" value of the hash. Shorter words are just ignored.

I peeked at a few other solutions to this challenge after I was done. I think I like some of them better because they are more concise, but then I do like to break things up so that I can see what everything is doing a bit more easily. I suspect that performance is similar between the solutions, but I haven't done any benchmarking to check.

With the wordlist dictionary on Arch Linux, this script gives the following output:

Longest word(s) constructed using USPS state codes: armorial, calamari, calamine, coalmine, Concorde, Denmark's, Ganymede, landmine, mainland, malarial, Mandarin, mandarin, melamine, memorial, mescalin, moorland
with a length of 8 alphabetical characters

and using the alphabetic-only list from https://github.com/dwyl/english-words

Longest word(s) constructed using USPS state codes: cacogalactia
with a length of 12 alphabetical characters

See the full solution, here.

Additional Challenge 2

What's the longest word you can spell by traversing US states, taking the initial or initials of the states as you pass through them, without revisiting any states?

Ok so this one made me tear out my hair a little. I am a little jealous of others' solutions which seemed much simpler than mine. But I am also a bit proud of the overengineering since I got to use some concepts in CS that I haven't really used since my undergrad.

When I first read the problem statement, I immediately thought of a graph. Basically, a graph is a data structure where things (usually strings, or another object of some sort) are connected to other things in some way. The "things" are called "vertices" (sing, vertex) and the connections are called "edges". Graphs can have edges with, or without, direction, making traversal of the graphs different depending on the type of graph. Luckily there is a module, Graph, which is included in Perl which can represent these structures.

That takes care of the requirement that the states need to be adjacent. What about searching for words? In the previous challenge, we could just iterate over all words in the dictionary and check them to see if they could be made using the state codes. Here, we would actually need to generate words from the states, given their adjacency, and then check to see if that is a valid word.

Luckily, there is a data structure for that™: the Trie, a search tree which allows for the lookup of words by prefix. It is ideal for applications such as predictive text, where words are suggested to a user based on the first few letters typed so far. We can use this to check if a word we are generating from the graph is in the dictionary. And of course, there is also a Perl module! Tree::Trie.

sub get_paths ( $graph, $trie, $vertex, $data, %seen ) {
    $seen{$vertex} = 1 + ( keys %seen );

    my $string_so_far = fc(
        join( "",
            map { $data->{$_}->{initials} }
                ( sort { $seen{$a} <=> $seen{$b} } keys %seen ) )
    );

    # Filter out successive vertexes which have already been visited
    # and which would not produce a word in the trie
    my @pot_successors = grep {
        !( exists $seen{$_} )
            && $trie->lookup(
            $string_so_far . fc( $data->{$_}->{initials} ) );
    } sort { $a cmp $b } $graph->neighbors($vertex);

    # Base case: no more successors, done with this path
    if ( !@pot_successors ) {
        return ( join( "->", sort { $seen{$a} <=> $seen{$b} } keys %seen ),
            $string_so_far );
    }
    else {
        # Process successors
        return
            map { get_paths( $graph, $trie, $_, $data, %seen ) }
            @pot_successors;
    }

}

I'm not showing the code for initializing the graph or the trie here. You can check out the source code for that. The function above, however, lets us make several trips through the graph, given a starting point/vertex. We use a hash, %seen to keep track of the vertexes visited along the path so far. Each time a vertex is visited, it goes into the hash and gets a value based on the length of the path so far. I pay a penalty each time this function is called sorting that hash, but I'm willing to do so.

The next chunk of code gives us a list of potential next vertices to visit, both by eliminating already visited vertices, and by checking if visiting that vertex we are still building a valid word. If taking that path would be a "dead end", then we simply won't visit that vertex.

When there are no more potential successive nodes, we have reached the end of a path and build two strings: the path taken and the string generated. The former is just to make our output nicer and more informative. The latter is what we really want. These strings are returned as a two-element list which can be coerced into a hash by the first caller. Key collision should not be a problem since all the paths are different anyway.

If there are more nodes, we make a recursive call, starting at one of the potential vertices to visit next.

Note: the fact that the %seen hash is not a hash ref makes this all relatively painless: each successive call to this function can make changes all it wants to the hash. Those changes will only live in that call's copy. So if we are iterating over other potential vertices way up in the first vertex, we can go deep down one path, and when we move on to another vertex, the next call to the function will get a copy of the %seen hash with only the first vertex in it. And so on for other successive calls.

# Use a hash to save data on the longest word(s) found.
my %longest_word = ( paths => [], words => [], length => 0 );

# Iterate over all states in the graph.
for my $state ( sort $us_graph->vertices ) {

    # Finds all paths with strings that may be in the dictionary and
    # save them into a hash.
    my %paths = get_paths( $us_graph, $eng_words, $state, \%us_adj_data );

    # Set the trie to do exact string search only
    $eng_words->deepsearch("exact");

    # Iterate over all the path->word elements in the %paths hash
    while ( my ( $path, $search ) = each %paths ) {

        # Drop current path from the hash
        delete $paths{$path};

        # Do an exact string search for the word
        my $match = $eng_words->lookup($search);
        if ( $match && $match eq $search ) {

            # A word was found in the dictionary and its longer
            # than the longest seen so far. Clear the longest_word
            # hash and save the new data.
            if ( length($search) > $longest_word{length} ) {
                @longest_word{qw(paths words length)}
                    = ( [$path], [$match], length($search) );
            }
            elsif ( length($search) == $longest_word{length} ) {

                # A word of the same length as the longest seen
                # was found. Push the data onto the list members
                # of the longest_word hash.
                push $longest_word{paths}->@*, $path;
                push $longest_word{words}->@*, $match;
            }

            # last;
        }
    }

    # Change search setting again so we can do prefix searches on the
    # next iteration again.
    $eng_words->deepsearch("boolean");
}

Oh man this is a lot of stuff. The comments should help, however, and I will point out the important parts.

The code above iterates over all the states in the graph. For each state, we use the get_paths function to get all of the paths and generated words. The line

$eng_words->deepsearch("exact");

sets searching the trie to look for exact matches only. It seems that this function doesn't really work as intended, but I need more time to test it and maybe report a bug. Anyway, this means that we can check to see if the word we generated is really a valid word, and not just a valid prefix of some word in the dictionary. If we did find an exact match, we save it in a similar way to the original challenge 2, except that now we also save the path.

Before moving on to the next state, we set the search back to "boolean", which simply returns "true" if the prefix is in the trie.

Note 2: In Challenge 2, I allowed words with apostrophes to be matched, but for some reason this resulted in some flaky output when using the trie. So for the additional challenge, I drop such words from the dictionary.

I am positive I over-thought and over-engineered this one, but it was fun to do it...once I got over the frustration of trying to use Graph::Traversal. It didn't do what I wanted, and get_paths above was my solution. That ended up being better anyway as I had control over which paths not to take.

With the wordlist dictionary on Arch Linux, this script gives the following output:

Longest word(s) constructed using initials of US states: 
CO->OK->NM->AZ->NV = conman
with a length of 6 alphabetical characters

and using the alphabetic-only list from https://github.com/dwyl/english-words

Longest word(s) constructed using initials of US states: 
CA->AZ->NV->UT->CO->KS = canuck
MO->AR->LA->MS->AL->GA = malmag
with a length of 6 alphabetical characters

Cons: Besides being an overcomplicated solution, building the trie can take a while if it is very large. I am sure that a large enough graph would also be a problem.

See the full solution, here.

Perl Weekly Challenge 13: Last Friday of the month / Mutually recursive methods

Yozen Hernandez — Sun, 23 Jun 2019 16:46:22 +0000

This is my first post to dev.to. Normally, I post to my blog on Github Pages, but I wanted to try out posting to dev.to and this site has comments :).

This week's Perl Weekly Challenge had two fairly fun challenges, and a 3rd API challenge that unfortunately needed an additional step I wasn't willing to take to participate in (the website required credit card details to use their API at any level).

Challenge 1

Write a script to print the date of last Friday of every month of a given year.

I chose to go the easy route for this challenge and just use the widely recommended DateTime module. There are some tasks for which it is simply better to use existing libraries where all of the heavy lifting has been done for you. Working with dates and time are such a situation.

use DateTime;
use DateTime::Duration;

my $year = shift or die "Usage: $0 <year>\n";

my $dt = DateTime->new(
    month => 1,
    day   => 1,
    year  => $year
);
my $add_week = DateTime::Duration->new( weeks => 1 );
my $add_day  = DateTime::Duration->new( days  => 1 );

In my solution, I take a fairly simple approach. In the block above, I set up a few variables: the year comes from the user on the command line, the $dt variable is a DateTime object that I will use as a sort of "cursor" to keep track of where we are in the year, and the last two variables ($add_week and $add_day) are DateTime::Duration objects for my convenience. I will use those two variables to "walk" along the dates in a year. You'll see what I mean below.

while ( $dt->day_of_week() != 5 ) { $dt->add($add_day); }

In the set up block I showed earlier, $dt was initialized to be the first date in the given year, which is always January 1. The first while loop in this block adds (using DateTime::add) one day so long as the current date in $dt is not a Friday. So if January 1st was not a Friday, keep adding one day until we arrive at a Friday. If it was, we don't add any days at all.

That's what the $add_day variable is used for. The DateTime module provides an alternative way of calling that function, allowing us to give the same parameters we needed to create a new DateTime::Duration object (eg, $dt->add(days => 1)). This form of the call creates a new DateTime::Duration object on each invocation, which is why I decided to avoid it and instead keep an already initialized variable for this purpose. Even if some internal optimization were smart enough to eliminate any potential slowdown for me, I still prefer being explicit about what I am doing in the code.

my %last_fri;
while ( $dt->year == $year ) {
    $last_fri{ $dt->month } = $dt->ymd("/");
    $dt->add($add_week);
}

Now we walk along by weeks (using $add_week, with the same motivations for using a variable as above). I use a hash and save the string representation of the date, in "y/m/d" format, of every Friday in the year using the numeric value of the month as the key. This gives the nice side effect of only saving the last Friday for the month, as the previous Fridays get overwritten so long as the month is the same, which is what the challenge asked us to do.

We exit the loop when we move on to the next year.

Finally, we print the results:

{
    local $, = "\n";
    say @last_fri{ sort { $a <=> $b } keys %last_fri };
}

The above could have been a one-liner, but I wanted to make use of a feature that maybe not everyone is aware of. That is, the setting of the $, variable (also called $OFS) locally. The curly braces are used to start a new block, and we use the local keyword to tell perl that we want to use an existing variable name, but we will be making a local copy of it so we can safely change its value within this block. Now, printing with say will separate each of its arguments with "\n" (normally, $, is set to undef). Note that the above could have been achieved with a simple join using "\n" as the separator, but the above form would come in handy if we needed to print several lists with the same separator, and wanted to save on the keystrokes.

I numerically sort the keys of my hash so that the dates are printed out as specified in the challenge.

Challenge 2

Write a script to demonstrate Mutually Recursive methods. Two methods are
mutually recursive if the first method calls the second and the second calls
first in turn. Using the mutually recursive methods, generate Hofstadter Female and Male sequences.

Recursive methods can be fun to write, but I've never done mutually recursive methods. This was a deceptively easy challenge. Once I wrote it, I sort of thought to myself "that can't be all, right?". So of course, I jazzed it up a bit:

use feature qw(say state);

sub hofstadter_F {
    my $n = shift;
    state %cache = ( 0 => 1 );

    return $cache{$n} if exists $cache{$n};
    return $cache{$n} = $n - hofstadter_M( hofstadter_F( $n - 1 ) );
}

sub hofstadter_M {
    my $n = shift;
    state %cache = ( 0 => 0 );

    return $cache{$n} if exists $cache{$n};
    return $cache{$n} = $n - hofstadter_F( hofstadter_M( $n - 1 ) );
}

First thing to notice, is that the bodies of each function have calls to the other. This sort of thing just works. So...let's just leave it at that.

The more interesting thing, is the use of a hash which I uncreatively called %cache because it is...a cache! Without this cache, we must do all the work of calculating the intermediate values of the functions on each call. Why is that important?

The Hofstadter Female and Male functions produce sequences, which means that we might need to call them n times to get the first n terms. If we call them 10 times, you might not notice any need for improvement of performance. But if you wanted a sequence of the first 100 values, you'll notice you'll need to wait a while.

Enter state, which we enable using use feature 'state';. Similar to my previous blog post where I talked about closures, state is a way of keeping the state of a variable across function calls. Instead of returning an anonymous sub which keeps its own state, however, state allows us to keep the state of a variable in a named function, without needing to keep another reference to it.

In each function, I initialize the cache hashes to contain the value for the base call (F(0) or M(0)). Then, on each call, the hash is checked to see if we have already computed the value of the *n*th term in the sequence. If so, it is returned. Otherwise, we make the appropriate call to calculate it, and save it into the cache while also returning it.

my $n = shift or die "Usage: $0 <n>\n";

say "F: ", join( ", ", map { hofstadter_F($_) } ( 0 .. $n ) );
say "M: ", join( ", ", map { hofstadter_M($_) } ( 0 .. $n ) );

On my machine, without using a cache, calling both functions with $n = 100 results in a total runtime of nearly 31 seconds! With the cache, the program ran in under 40ms and was done in a literal blink of an eye. Bumping it up to 10000 took 90ms. I did not try that value of n without a cache.

A core module called Memoize does this sort of caching for you, under certain conditions. The POD page is well worth a read. I could have done the above by using Memoize, but then I might not have had the opportunity to provide an example to write about :).