In which we bravely overcome ambiguity, and dodge two approaches in the face of (O³).

TWC Task #1, Truncatable Prime

Observations:

"Left-truncatable prime" is not fully defined by the task; are leading zeros valid?
e.g. 103 -> 03 -> 3 ; all are prime, but is 03 considered a "number"?

UPDATE: SF.pm's Raku Study Group just pointed out that task description does say "contains no 0", so the task was fully defined, and I had no need for the "filter" half of the solutions below. Mea culpa!

OEIS has separate pages for each definition, but both start with:
(2, 3, 5, 7, 13, 17, 23, 37, 43, 47):

A033664 …, 53, 67, 73, 83, 97, 103, 107, 113, …
A024785 …, 53, 67, 73, 83, 97, 113, …

Since one definition is more easily written as a filter, and the other definition is best written as a generator, I wrote both.

Raku

My Raku program starts with the "filter" approach:

sub is-left-truncatable-prime ( UInt \N --> Bool ) {
    return (0 ..^ N.chars)          # Start of each substring
        .map(  { N.substr($_) })    # All left-truncated substrings
        .first({ .is-prime.not })   # Find the first non-prime
        .defined.not;               # If no non-primes, then True
}
constant @LTP_A033664 = grep &is-left-truncatable-prime, ^Inf;

The .first method, combined with the laziness of the .map method, allows an early return without .substr having to generate every single substring. Rephrasing to use .all is only slightly clearer, so I used .first.

The "generator" approach starts with the single digit primes as the first "generation", and pre-pends 1..9 to each element of gen#1 (and filters out non-primes) to create all-double-digit gen#2. Gen#3 will all be triple-digits, and so on.

my @LTP_A024785 = lazy gather loop {
    state @current_gen = grep &is-prime, ^10;
    .take for @current_gen;
    @current_gen = grep &is-prime, ((1..9) X~ @current_gen);
}

Since each number in a generation has the same number digits, and the first generation is in numeric order, each subsequent (1..9) X~ @current_gen generation will also be in order.

Both arrays are lazy, so they get their elements populated on demand. Final output is just:

put @LTP_A033664.head(20);
put @LTP_A024785.head(20);

2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 103 107 113 137 167
2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197

Perl

My Perl program is just a conversion of the Raku, with adaptations to loosely replace the laziness that Perl lacks.

The ntheory (Number Theory) module has is_prime, which saves me much code.

TWC Task #2, Pentagon Numbers

Observations:

Some obvious problems:

• Not only do we need to scan all 2-combinations (O²) of a list, we also have to scan the list of pents to find the difference and the sum (O³ and bigger, unless we binary search and/or hash).
• Unless we pre-build the list to a pre-known limit (which we could only do if we already knew the answer), then at the time that we want to check A+B for presence in the list of pents, the value will not exist in the list yet.
• We need all 2-combinations, and Raku has a .combinations method that we can invoke with (2), but it will not work with the lazy infinite list that idiomatic for @pents.

If we did already know how big to pre-build the pents, then the solution would be simple:

constant @pents = map { $_ * (3 * $_  -  1) div 2 }, 1..*;
my %p = @pents.head(2400).Set;
say @pents.head(2400).combinations(2).first: {
    %p{  [+] .list } and
    %p{ [R-] .list }
};

I don't want to do that.

If we "solve" the pent equation of n(3n-1)/2 = P via quadratic formula (a=3,b=-1,c=-2P), we can write a is_pentagon_number sub, which would solve the first two problems!

sub is-pentagon-number ( \p ) {
    my \inner = 24 * p + 1;
    my \near_root = inner.sqrt.round;

    return near_root ** 2 == inner
        && near_root %  6 == 5
}

This would work perfectly.
I chose not to do that, either.

Instead, let's call the sum of the two pents "A", and the difference "D". Then re-arrange like so:

# Where A,B,C,D are all pentagonal numbers:
# B + C == A      ,  B - C == D     Original problem statement
#     C == A - B  ,  B - C == D     Rearranged as two differences
#     C == A - B  ,  B-(A-B)==D     (C,D), expressed only in A and B

So, if we find any two pentagonal numbers A,B where A-B is pentagonal and B-(A-B) is pentagonal, then we have a solution. The desired numbers will be the inner two: (B,C).

With this reorganization, we will always be "looking backwards" into parts of @pent that have already been generated. The cost will be in generating all the way to A; a solution using is-pentagon-number would only need to generate to B.

Raku

My Raku program uses for @pents.kv as a outer loop, and for @pents.head(i) as the inner loop, to replicate the disallowed .combinations(2).

sub find-first-plus-and-minus-pentagon_numbers ( ) {
    constant @pents = map ->\n { n *(3*n - 1) div 2 }, 1..*;

    my %p;
    for @pents.kv -> \i, \A {
        %p{A} = 1;

        for @pents.head(i) -> \B {
            my \D = A - B;
            my \C = B - D;
            return B, C if %p{C} and %p{D};
        }
    }
}
put find-first-plus-and-minus-pentagon_numbers();

The three body lines of the inner loop could be replace with one line (return B, C if %p{A - B} and %p{B - (A - B)}), and then the whole inner loop could become a return … with first {…} statement, but then I suspect it would "spark joy" in no one.

Aside: SF.pm's Raku Study Group just pointed out that the constant line uses a sigil-less n, which means it gets defined as -> \n, which confusingly looks like a newline character. Good point!

Perl

My Perl solution needed almost no structural changes from the Raku, because the lazy generation of the pents can just be appended at the same pace as the outer loop.

sub find_first_plus_and_minus_pentagon_numbers ( ) {
    my @pents;
    my %p;
    for ( my $i = 1 ; ; $i++ ) {
        my $A = $i * (3*$i - 1) / 2; # Pentagon number

        for my $B (@pents) {
            my $D = $A - $B;
            my $C = $B - $D;
            return $B, $C if $p{$C} and $p{$D};
        }

        $p{$A} = 1; 
        push @pents, $A;
    }
}
say join ' ', find_first_plus_and_minus_pentagon_numbers();

Five is right out. -- Monty Python and the Holy Grail

Hi,

Learning a programming language is not easy, but have you tried learning a human language? You don't have a compiler to tell you when you make a syntax error. You have a lot more words and rules and a lot more exceptions than in a programming language. Mostly however, the lack of quick feedback is what makes it hard. However, after a few months work you start to be able to speak to people in their native language.

As you might have read I've started to learn Ladino - the language spoken by the Jews who were expelled from the Iberian peninsula more than 500 years ago. It is a mix of medieval Spanish, Portuguese, Italian, French, Turkish, Serb, Arabic, and Hebrew. It is a fantastic exercise and it involves programming as well. Join me!

Something else: In Israel every Saturday evening, once the Shabbat ends, and throughout Sunday people say 'have a good week'. Referring to the week that starts on Sunday, the first day of our work-week. I don't recall ever hearing that or anything similar in Hungary. Not even on Sunday or Monday. I wonder, do you use any similar expression in whatever country and language environment you live in? Let me know and...

Have a good week!

Please go here instead.

These are some answers to the Week 147 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 16, 2022 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Truncatable Prime

Write a script to generate first 20 left-truncatable prime numbers in base 10.

In number theory, a left-truncatable prime is a prime number which, in a given base, contains no 0, and if the leading left digit is successively removed, then all resulting numbers are primes.

Example:

9137 is one such left-truncatable prime since 9137, 137, 37 and 7 are all prime numbers.

Truncatable Prime in Raku

We first build an infinite lazy list (@el-primes) of primes with no 0 digit. For each integer in the list, we then try to truncate the left-most digit and check whether the truncated number is prime, and so one until we get to the last digit. The process stops when 20 such primes have been generated.

my @truncatables;
my $count = 0;
my @el-primes = grep {.is-prime and not /0/}, 2..Inf;
for @el-primes -> $candidate {
    my $length = $candidate.chars;
    my $is-truncatable = True; 
    for 1..$length -> $i {
        my $truncated = substr $candidate, $length - $i;
        $is-truncatable = False, last unless $truncated.is-prime;
    }
    if $is-truncatable {
        push @truncatables, $candidate;
        $count++;
    }
    last if $count >= 20;
}
say @truncatables;

This program displays the following output:

raku ./truncatable.raku
[2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197]

Truncatable Prime in Perl

This Perl program is based on essentially the same idea as the Raku implementation, except that we build a hash of primes along the way. We need to check primality only when we meet a new number the first time: for the truncated numbers, we simply check their primality by looking up into the hash.

use strict;
use warnings;
use feature "say";
use constant MAX => 20;

my @primes = (2, 3, 5);
my %primes_h = map {$_ => 1} @primes;
my @truncatables = @primes;;
my $candidate = $primes[-1];
my $count = scalar @truncatables;;
while ($count < MAX) {
    $candidate += 2;
    my $not_prime = 0;
    next if $candidate =~ /0/;
    my $sq_cand = sqrt $candidate;
    for my $i (@primes) {
        $not_prime = 1, last unless $candidate % $i;
        last if $i > $sq_cand;
    }
    next if $not_prime;
    push @primes, $candidate;
    $primes_h{$candidate} = 1;
    # now check if truncatable prime
    my $length = length $candidate;
    my $is_truncatable = 1; 
    for my $i (1..$length) {
        my $truncated = substr $candidate, $length - $i;
        $is_truncatable = 0, last unless exists $primes_h{$truncated};
    }
    if ($is_truncatable) {
        push @truncatables, $candidate;
        $count++;
    }
}
say "@truncatables";

This program displays the following output:

$ perl  ./truncatable.pl
2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197

Truncatable Prime in Ring

I continue here my exploration of Ring, a quite recent programming language. The program below is a port to Ring of the Perl program above.

max = 20
primes = [2, 3, 5]
primes_h = []
count = len(primes)
for i = 1 to count
    primes_h[string(primes[i])] = i
next
truncatables = primes
candidate = primes[count]
while count < max
    candidate += 2
    not_prime = false
    pos = substr(string(candidate), "0")
    if pos > 0 loop ok
    sq_cand = floor(sqrt(candidate))
    for i in primes
        if candidate % i = 0
            not_prime = true
            exit
        ok
        if i > sq_cand exit ok
    next
    if not_prime loop ok
    add (primes, candidate)
    primes_h[string(candidate)] = 1
    // We've found a prime, now check if truncatable prime
    length = len(string(candidate))
    is_truncatable = true
    for i = 1 to length
        truncated = right(string(candidate), i)
        if isnull(primes_h[truncated])
            is_truncatable = false
            exit
        ok
    next
    if is_truncatable
        add(truncatables, candidate);
        count += 1
    ok

end
for val in truncatables see "" + val + " " next
see " " + nl

Output:

$ ring ./truncatable.ring
2 3 5 7 13 17 23 37 43 47 53 67 73 83 97 113 137 167 173 197

Task 2: Pentagon Numbers

Write a script to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number.

Pentagon numbers can be defined as P(n) = n(3n - 1)/2.

Example:

The first 10 Pentagon Numbers are: 1, 5, 12, 22, 35, 51, 70, 92, 117 and 145.

P(4) + P(7) = 22 + 70 = 92 = P(8)
but
P(4) - P(7) = |22 - 70| = 48 is not a Pentagon Number.

Pentagon Numbers in Raku

We’ve decided to use the built-in combinations method to generate the pairs of pentagon numbers. Note that we cannot use an infinite list of pentagon numbers because the combinations routine cannot operate on an infinite list. So I just tried various increasing values for the $max variable until I obtained a result satisfying the criteria. Note that I use a %penta hash to store the pentagon values, so the verifying whether and sum and the difference values are pentagon number is just a matter of a fast hash lookup.

my $max = 4000;
my @pentanums = map { (3 * $_² - $_)/2 }, 1..$max;
my %penta = map {@pentanums[$_] => $_+1}, 0..$max-1;
for @pentanums.combinations(2) -> $comb {
    next unless %penta{$comb.sum}:exists;
    next unless %penta{$comb[1]-$comb[0]}:exists;
    say $comb, " = Pentagon numbers N° %penta{$comb[0]} and %penta{$comb[1]}";
    say "Sum is ", $comb.sum, " (Pentagon number ", %penta{$comb.sum}, ")";
    say "Difference is ", $comb[1]-$comb[0], " (Pentagon number ", %penta{$comb[1]-$comb[0]}, ")";
    last;
}
say now - INIT now, " seconds";

This script displays the following output:

raku ./pentanums.raku
(1560090 7042750) = Pentagon numbers N° 1020 and 2167
Sum is 8602840 (Pentagon number 2395)
Difference is 5482660 (Pentagon number 1912)
101.7166579 seconds

This program is relatively slow (101 seconds execution time). I found that using two nested loops (as in the Perl program below) rather than the combinations routine make the program at least 20 times faster (only a few seconds). So it seems that the combinations routine is quite slow. This is a bit unfortunate as combinations is really useful and makes the code simpler and cleaner. I still prefer to present this version, but if you need better performance, then use two nested loops as in the Perl implementation below.

Pentagon Numbers in Perl

This is essentially the same idea as the Raku program above. However, as mentioned above, we don’t have combinations routine in Perl, so we use two nested loops to generate all the combinations. The advantage is that this runs much faster.

use strict;
use warnings;
use feature "say";
use constant MAX => 4000;

my @pentanums = map { $_ * (3 * $_ - 1)/2 } 1..MAX;
my %penta_h = map {$pentanums[$_] => $_+1 } 0..MAX-1;
# say Dumper \%penta_h;

OUTER: for my $i (0..MAX-1) {
    for my $j ($i+1..MAX-1) {
        my $sum = $pentanums[$i] + $pentanums[$j];
        next unless exists $penta_h{$sum};
        my $diff = $pentanums[$j] - $pentanums[$i];
        next unless exists $penta_h{$diff};
        say "First pair of pentagon numbers is $pentanums[$i] (rank ", $i+1, ") and $pentanums[$j] (rank ", $j+1, ")";
        say "Sum is $sum (rank $penta_h{$sum}) and difference is $diff (rank $penta_h{$diff})";
        last OUTER;
    }
}

This program displays the following output:

$ time perl  ./pentanums.pl
First pair of pentagon numbers is 1560090 (rank 1020) and 7042750 (rank 2167)
Sum is 8602840 (rank 2395) and difference is 5482660 (rank 1912)

real    0m2,043s
user    0m1,703s
sys     0m0,108s

Pentagon Numbers in Ring

Again a port to Ring of the Perl implementation:

max = 3000
pentanums = []
for i = 1 to max 
    add (pentanums,  i * (3 * i - 1) / 2)
next
// see pentanums + nl
penta_h = []
for i = 1 to max
    penta_h[ string(pentanums[i])] = i
next
for i = 1 to max
    for j = i+1 to max
        diff = pentanums[j] - pentanums[i]
        diff_s = string(diff)
        if isnull(penta_h[diff_s]) loop ok
        sum = pentanums[i] + pentanums[j]
        sum_s = string(sum)
        if isnull(penta_h[sum_s]) loop ok
        see "" + diff + " " + sum + " " + pentanums[i] + " " + pentanums[j] + nl
    next
next

Output:

$ ring ./pentanums.ring
5482660 8602840 1560090 7042750

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on January 23, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

Write a script to generate first 20 left-truncatable prime numbers in base 10.

Solution

use strict;
use warnings;

use boolean;
use constant N => 10_000; 

sub sieve_atkin{
    my($n) = @_;
    my @primes = (2, 3, 5);
    my $upper_bound = int($n * log($n) + $n * log(log($n)));
    my @atkin = (false) x $upper_bound;    
    my @sieve = (1, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 49, 53, 59);
    for my $x (1 .. sqrt($upper_bound)){
        for(my $y = 1; $y <= sqrt($upper_bound); $y+=2){
            my $m = (4 * $x ** 2) + ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (1, 13, 17, 29, 37, 41, 49, 53) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    } 
    for(my $x = 1; $x <= sqrt($upper_bound); $x += 2){
        for(my $y = 2; $y <= sqrt($upper_bound); $y += 2){
            my $m = (3 * $x ** 2) + ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (7, 19, 31, 43) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    }   
    for(my $x = 2; $x <= sqrt($upper_bound); $x++){
        for(my $y = $x - 1; $y >= 1; $y -= 2){
            my $m = (3 * $x ** 2) - ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (11, 23, 47, 59) if $m <= $upper_bound;
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    } 
    my @m;
    for my $w (0 .. ($upper_bound / 60)){
        for my $s (@sieve){
            push @m, 60 * $w + $s;  
        }
    }
    for my $m (@m){
        last if $upper_bound < ($m ** 2);
        my $mm = $m ** 2;
        if($atkin[$m]){
            for my $m2 (@m){
                my $c = $mm * $m2;
                last if $c > $upper_bound;
                $atkin[$c] = false;
            }
        }
    }
    map{ push @primes, $_ if $atkin[$_] } 0 .. @atkin - 1;
    return @primes; 
}

sub truncatable{
    my($prime, $primes) = @_;
    return false if $prime =~ m/0/;
    my @truncatable = map { my $p = substr($prime, -1 * $_, $_); grep {$p == $_} @{$primes}} 1 .. length($prime);
    return @truncatable == length($prime);
}

sub first_n_truncatable_primes{
    my($n) = @_;
    my @primes = sieve_atkin(N);
    my @truncatable;
    for my $prime (@primes){
        push @truncatable, $prime if truncatable($prime, \@primes);
        last if @truncatable == $n;
    }
    return @truncatable;
}

MAIN:{
    print join(", ", first_n_truncatable_primes(20)) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 113, 137, 167, 173, 197

Notes

First off, I am re-using the Sieve of Atkin code I wrote for a previous challenge. These challenges somewhat frequently have a prime number component so, if I get a chance, I'll compose that code into it's own module. If it weren't for the copy/paste of the Sieve of Atkin code then this solution would be very short! This sort of string manipulation is where Perl excels and the determination of whether a number is left truncatable takes only a few lines.

Part 2

Write a script to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number.

Solution

use strict;
use warnings;

use constant N => 10_000;

sub n_pentagon_numbers{
    my($n) = @_;
    my @pentagon_numbers;
    my $x = 1;
    my %h;
    do{
        my $pentagon = $x * (3 * $x - 1) / 2;
        push @pentagon_numbers, $pentagon;
        $h{"$pentagon"} = $x;
        $x++;
    }while(@pentagon_numbers < $n);
    return (\@pentagon_numbers, \%h);
}

sub pairs_pentagon{
    my($n) = @_;
    my($pentagons, $lookup) = n_pentagon_numbers(N);
    my @pairs;
    for my $x (0 .. @{$pentagons} - 1){
        for my $y (0 .. @{$pentagons} - 1){
            unless($x == $y){
                my($sum, $difference) = ($pentagons->[$x] + $pentagons->[$y], abs($pentagons->[$x] - $pentagons->[$y]));
                 if($lookup->{$sum} && $lookup->{$difference}){
                     my($s, $t) = ($x + 1, $y + 1);
                     push @pairs, ["P($s)", "P($t)"]
                 }
            }
            last if @pairs == $n;
        }
        last if @pairs == $n;
    }
    return @pairs;
}

sub first_pair_pentagon{
    return [pairs_pentagon(1)];
}

MAIN:{
    print join(", ", @{first_pair_pentagon()->[0]}) . "\n";
}

Sample Run

$ perl perl/ch-2.pl
P(1020), P(2167)

Notes

This second part of the challenge proceeds in mostly the same way as the first. We generate a large list of candidates and then search for those exhibiting the property in question. It is somewhat unexpected that the first pair of Pentagonal Numbers that have this property are so deeply located. Many times in these challenges the solution is emitted without quite as much searching!

References

Challenge 147

Left Truncatable Primes

Pentagonal Numbers

1. GraphQL - Perl implementation of GraphQL
   • Version: 0.53 on 2022-01-15
   • Votes: 18
   • Previous version: 0.52 was 4 months, 12 days before
2. JSON - JSON (JavaScript Object Notation) encoder/decoder
   • Version: 4.05 on 2022-01-14
   • Votes: 96
   • Previous version: 4.04 was 28 days before
3. Net::SSLeay - Perl bindings for OpenSSL and LibreSSL
   • Version: 1.92 on 2022-01-12
   • Votes: 20
   • Previous version: 1.90 was 11 months, 22 days before
4. PDL - Perl Data Language
   • Version: 2.068 on 2022-01-14
   • Votes: 43
   • Previous version: 2.019 was 3 years, 8 months, 9 days before
5. PDL::Stats - a collection of statistics modules in Perl Data Language, with a quick-start guide for non-PDL people.
   • Version: 0.81 on 2022-01-11
   • Votes: 14
   • Previous version: 0.80 was 3 months, 9 days before
6. Redis - Perl binding for Redis database
   • Version: 1.999 on 2022-01-14
   • Votes: 40
   • Previous version: 1.998 was 1 year, 4 months, 27 days before
7. SPVM - Static Perl Virtual Machine. Fast Calculation, Fast Array Operation, and Easy C/C++ Binding.
   • Version: 0.9120 on 2022-01-14
   • Votes: 21
   • Previous version: 0.9112 was 7 days before
8. Sys::Virt - libvirt Perl API
   • Version: v8.0.0 on 2022-01-14
   • Votes: 15
   • Previous version: v7.10.0 was 1 month, 13 days before
9. Test::LWP::UserAgent - A LWP::UserAgent suitable for simulating and testing network calls
   • Version: 0.035 on 2022-01-15
   • Votes: 13
   • Previous version: 0.034 was 1 year, 10 months, 9 days before

This is the weekly favourites list of CPAN distributions. Votes count: 56

Week's winners (+3):  Crypt::Passphrase

Build date: 2022/01/15 20:43:56 GMT

Clicked for first time:

• Crypt::Bcrypt - A modern bcrypt implementation
• Crypt::OpenSSL::Verify - OpenSSL Verify certificate verification in XS.
• Data::CompactReadonly - a description of CompactReadonly data format, version 0.
• Feature::Compat::Defer - make defer syntax available
• MojoX::Log::Dispatch::Simple - Simple Log::Dispatch replacement of Mojo::Log
• ReturnValue - A structured return value for failure or success
• String::Interpolate::Named - Interpolated named arguments in string
• Tree::RB::XS - Red/Black Tree container with similar API to Tree::RB
• Util::H2O - Hash to Object: turns hashrefs into objects with accessors for keys
• YAML::Parser - Generated Reference Parser for YAML 1.2

Increasing its reputation:

• Alien::Build (+1=20)
• AnyEvent::Promises (+1=5)
• App::cpm (+1=56)
• autocroak (+1=2)
• Autoload::AUTOCAN (+1=4)
• Chart::Clicker (+1=33)
• Code::TidyAll (+1=37)
• Crypt::Passphrase (+3=12)
• Data::PathSimple (+1=2)
• Devel::IPerl (+1=21)
• File::Fetch (+1=3)
• File::Slurper (+1=40)
• File::XDG (+2=7)
• Gazelle (+1=24)
• GD (+1=24)
• HTML::HTML5::Parser (+1=5)
• JSON::Path (+1=9)
• List::Keywords (+1=8)
• List::MoreUtils (+1=110)
• Log::Dispatch (+1=43)
• Math::BigInt (+1=10)
• Minilla (+1=54)
• Mojolicious (+1=466)
• Moose (+1=320)
• Open::This (+1=9)
• Parse::nm (+1=2)
• Path::Tiny (+1=167)
• perl (+1=388)
• Perl::Tidy (+1=123)
• PerlPowerTools (+1=30)
• PLS (+1=9)
• Pod::Markdown (+1=31)
• Pod::Markdown::Github (+1=6)
• RxPerl (+1=10)
• Sentry::SDK (+1=2)
• Syntax::Construct (+1=9)
• Syntax::Keyword::Defer (+1=7)
• Text::Amuse (+1=2)
• Text::CSV_XS (+1=94)
• Type::Tiny (+1=128)
• Unicode::LineBreak (+1=9)
• Unicode::Normalize (+1=8)
• YAML::PP (+1=12)

These are the five most rated questions at Stack Overflow last week.
Between brackets: [question score / answers count]
Build date: 2022-01-15 20:42:04 GMT

1. Using Perl look-ahead assertion to find individual list - [3/1]
2. Perl - Correcting char encoding on command line input - [2/2]
3. Using foreach instead of map and grep in perl - [2/2]
4. How to interrupt a read of a lexical filehandle in Perl? - [2/1]
5. Appropriate way to return an arrayref from a sub with optional sorting in Perl version 5.20 - [2/1]

The TPF Marketing Committee wants to raise USD$100,000 to fund Perl and Raku development and make 2022 the year of Perl and Raku. But we can only do this with community support.

In 2022 the Perl Foundation Marketing Committee aims to: * Achieve a fundraising target of $100,000 through improved fundraising efforts * Improve and sustain the perception of Perl * Address feature gaps from community feedback * Demonstrate why people should use Perl * Increase adoption of the language

These goals are just words without your help.

We need everyone in the community to share our news and updates via your social media and other channels.

We ask you to use Amazon Smile when purchasing from Amazon, providing a percentage donation at no extra cost.

Can you ask your employer to make a donation, or maybe you could make a personal donation to The Perl Foundation?

Please get involved and coordinate activities at the monthly committee meetings. Come along with your ideas and willing hands so we can take action together.

The meeting dates for 2022 are listed below - all at 1730UTC via Zoom - join the Marketing Slack channel to keep up to date.

• 10 February
• 10 March
• 7 April
• 12 May
• 9 June
• 7 July
• 11 August
• 8 September
• 13 October
• 10 November
• 8 December

Thank you for your help and we look forward to seeing you!

1. Roles Definition

A role is a set of methods that provide extra behavior to a class. Roles can't be used independently they need a class to consume them. Roles are a good alternative to inheritance.

2. A sample role

A role is declared in a *.pm file.

package Role::JSON;
use Moose::Role;

use JSON 'encode_json';

requires qw( data );

sub to_json {
  my $self = shift;

  return encode_json( $self->data() );
}

1;

3. Consuming a role

In the previous example the Role::JSON requires
the consuming class to have a method named data().

package Foo;
use Moose;
with "Role::JSON";

sub data {
 my $self = shift;
 return { foo => 'bar' }; 
}

__PACKAGE__->meta->make_immutable;

1;

Then you could just call the method defined in the role in your program:

my $obj = Foo->new();

print $obj->to_json();

# And that prints the following JSON
# { foo : 'bar' }

4. Checking if class consumes a role

Because roles are not inherited you cannot use isa() to check if a class consumes a role instead you should use does():

$object->does("Role::JSON");

5. Roles without Moose/Moo

Cpan module Role::Tiny allows you to use roles with vanilla OOP not just with Moose or Moo. Like Moose or Moo, Role::Tiny applies strict and warnings to the caller.

package Role::Foo;
use Role::Tiny;
sub data { 
 my $self = shift; 
 return { foo => 'bar' };
}
1;

package Bar;
use lib 'lib';
use Role::Tiny::With;
with  'Role::Foo';
....
1;

Role::Tiny makes available to your role the following method modifiers: before, around and after.
In this example when $self->data is called the around block executes and you get JSON returned.

package Role::JSON;
use Role::Tiny;
use JSON 'encode_json';

requires qw( data );

around data => sub  {
  my $orig = shift;
  my $self = shift;

  return encode_json( $self->$orig() );
};  

6. Compositional safety

Roles attempt to guarantee compositional safety. So, if two roles have the same method defined and you try to consume them in the same class, you will get an error message.

 Due to method name conflicts in roles ....

Just remember that in order to trigger the error message you need to consume all the roles at once:

# good
package Foo;
use lib 'lib';
use Role::Tiny::With;
with  'Role::XML', 'Role::JSON';

# bad second method is ignored
package Foo;
use lib 'lib';
use Role::Tiny::With;
with  'Role::XML'; 
with  'Role::JSON';

7. How to fix method collision

• implement the methods yourself in your class, thus causing the corresponding role methods to be ignored

• For Moose use the excludes key word
  

package Role::JSON;
use Moose::Role;

sub serialize { ... }

package Role::XML;
use Moose::Role;

sub serialize { ... }

package Foo;
use Moose;
with Role::Serializable::JSON,
     Role::Serializable::XML => { excludes => 'serialize' };

• For Role::Tiny use namespace::clean

package Role::XML;

use Role::Tiny;

sub serialize { my $self = shift; print 'test'  };
# serialize() will not be imported in the consuming class
use namespace::clean;

1;

8. Bibliography

• Beginning Perl by Curtis 'Ovid' Poe
• Modern Perl by Chromatic
• Use roles in object oriented Perl with Role::Tiny by David Farrell

Weekly Challenge 147

Challenge, My solutions

Unless I'm mistaken, this is the first week where both challenges have had no inputs. It is always tempted to use a single print statement, but that defeats the purpose of why we do them, isn't it?

TASK #1 › Truncatable Prime

Task

Write a script to generate first 20 left-truncatable prime numbers in base 10.

In number theory, a left-truncatable prime is a prime number which, in a given base, contains no 0, and if the leading left digit is successively removed, then all resulting numbers are primes.

My solution

Let's start off with the straight forward task. I use the is_prime method that I've used in previous tasks, slightly tweaked because zero is not a prime.

I then have a is_trunc_prime method that works out if every left truncated number of the number supplied is a prime, and it contains no zeros. To make things as quick as possible, I start with the most truncated number first. As Python treats integers and strings differently, I turn the input into a string to perform the truncation.

The main method then has a loop that exits when the solutions list when there are 20 items. Each iteration of the loop increments the number we check by one.

The Perl code is a transliteration of the Python code.

Examples

$ ./ch-1.py
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 113, 137, 167, 173, 197

$ ./ch-1.pl 
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 113, 137, 167, 173, 197

TASK #2 › Pentagon Numbers

Task

Write a sript[sic] to find the first pair of Pentagon Numbers whose sum and difference are also a Pentagon Number.

Pentagon numbers can be defined as P(n) = n(3n - 1)/2.

My solution

Let's clear one thing up first. The first solution is likely to be P(0) and P(0) as 0 + 0 and 0 - 0 is zero, which is also P(0). However, I don't think that is the solution we are actually looking for. For the same reason, I'm not comparing identical pentagonal numbers in my solution.

Thanks to Wikipedia's page on Pentagonal Numbers, we learn out we can use the calculation below to find out if the number is Pentagonal, and what it's index is.

Now I don't even believe how you get the opposite of (3n2 - n) ÷ 2 to be the above, but it does work. I can tell you after I've done my pull request, I'm straight over to Abigail's blog to see the number theory behind this one :-)

For this task, I have two methods. The first is pentagon_number. This turns the index into a number, so 4 into 22 for example. The other method is is_pentagon_number and does the opposite using the calculation mentioned in the Wikipedia page, so 22 into 4 for example.

It then becomes a task of finding the first pair. For this I have a counter p1 that starts at two. I then have an inner loop p2 that goes from one to p1 - 1. I work out if the sum and subtraction of the two numbers are also pentagonal values, and if so display the results and exit the loops.

The Perl solution is also a transliteration of the Python one, with one caveat. In Perl x % y is always in integer even if x isn't. Therefore I needed to add an addition check to make sure x is an integer.

Examples

 ./ch-2.py 
P(2167) + P(1020) = 7042750 + 1560090 = 8602840 = P(2395)
P(2167) - P(1020) = 7042750 - 1560090 = 5482660 = P(1912)

$ ./ch-2.pl 
P(2167) + P(1020) = 7042750 + 1560090 = 8602840  = P(2395)
P(2167) - P(1020) = 7042750 - 1560090 = 5482660  = P(1912)

One of the reasons I have not "moved on" from Perl to some other more "modern" language is that Perl gives me such great access to its inner workings. The Do-It-Yourself Lexical Pragmas post from a couple weeks ago is an example of this. Another example is that Perl lets you tie your own code into its warnings system.

Tying into the warnings machinery requires a module. That is, the interface assumes you are reporting problems relative to another name space that invoked your code. Your module can either add diagnostics to existing Perl warning categories or actually create new categories. In either case your diagnostics are sensitive to the enablement or disablement of the category, as well as its fatalization.

In addition to enabling or disabling warning categories, use warnings ... and no warnings ...; make some subroutines available which can be used to issue your own diagnostics. These are reported relative to the file and line that called into your module (sort of like carp()). A useful subset of the warnings:: subroutines is:

warnings::enabled( $category )

This subroutine returns a true value if the given warnings category is enabled by the calling package, or a false value if it is not.

warnings::warn( $category, $message )

This subroutine issues the given $message as a warning in the given $category, or as a fatal (though trappable) error if the category has been fatalized.

warnings::warnif( $category, $message )

This convenience subroutine is equivalent to warnings::warn( $category, $message ) if warnings::enabled( $category ).

The deprecated warning was the subject of one of my blog posts a couple months ago. That post described its use by Perl itself, but module authors need to deprecate code as well. You can issue your own deprecated diagnostics like this:

warnings::warnif( deprecated => 'This feature is deprecated' );

This will be fatal if deprecated has been fatalized, or suppressed if it has been disabled. The file and line number appended will be those of the most-recent call into your module, not necessarily the caller of the subroutine that contains this code. This means you can centralize your deprecation code without worrying about the depth of the call tree.

In order to create a new warning category named after your module, all you have to do is

use warnings::register;

Once Perl compiles this, you can treat it just like a built-in category. If your module is named My::Module, users of it can

use warnings 'My::Module';

or

no warnings 'My::Module';

The latter example may be more to the point, since use warnings; enables custom categories as well.

Your module generates diagnostics in the new category using the same interface as for the built-ins. For example,

warnings::warnif( __PACKAGE__, 'Danger, Will Robinson!' );

You can actually omit the $category argument in this case, simplifying the above to

warnings::warnif( 'Danger, Will Robinson!' );

If your module needs more than one new warning category, you can give their base names as arguments to use warnings::register;.

package My::Module;
use warnings::register qw{ fu bar };

will create warning categories My::Module, My::Module::fu, and My::Module::bar.

Somewhat to my surprise, I found no documented restrictions on the names of packages that can be made into warnings categories. From the standpoint of Perl's warning machinery,

package deprecated;
use warnings::register;

is not a problem, at least under Perl 5.34.0. Nevertheless, from the standpoint of both users and maintainers of such a module, this looks to me like a Very Bad Thing.

This past year of blogging has introduced me to a wide variety of people in the Perl community. Some I’ve admired from afar for years due to their published work, and even more I’ve “met” interacting on social media and other forums. So this will be the first in an occasional series highlighting not just the code, but the people that make up the Perl family.

Paul “LeoNerd” Evans

I first came across Paul’s work during his series last year on writing a core Perl feature; he’s responsible for Perl v5.32’s isa operator and v5.34’s experimental try/catch exception handling syntax. I interviewed him about the latter for Perl.com in March 2021. He’s been active on CPAN for so much longer, though, and joined the Perl Steering Council in July. He’s also often a helpful voice on IRC.

Elliot Holden

Renowned author and trainer Randal L. “merlyn” Schwartz linked over the weekend in a private Facebook group to Elliot’s impassioned YouTube video about his day job as a Perl web application developer. Through his alter ego Urban Guitar Legend Elliot is also a passionate musician; besides gigging and recording he’s been posting videos for nine years. (I’m a bit envious since I took a break from music almost twenty years ago and haven’t managed to recapture it.) Elliot seems like the quintessential needs-to-get-shit-done developer, and Perl is perfect for that.

Gábor Szabó

Gábor is a polyglot (both in human and computer languages) trainer, consultant, and author, writing about programming and devops on his Code Maven and Perl Maven websites. He’s also the founder and co-editor of Perl Weekly and recipient of a Perl White Camel award in 2008 thanks to his organizational and support contributions. Last year he introduced me to the world of live pair programming, working on a web application using the Mojolicious framework.

If you’re on Twitter and looking to connect with other Perl developers, please consider participating in the Perl community I’ve set up there. Twitter Communities are topic-specific moderated discussion groups, unlike the freewheeling #hashtags system that can be diluted by spam or topics that share the same name. Unfortunately, they’re still read-only on the Twitter Android app, but you can participate fully on iOS/iPadOS and the website.

Perl is a highly influential "kitchen sink" language. Languages like that see an idea that might potentially be useful or just cool, and just add it to the language because why not.

Other languages with similar design philosophy (or one might say lack of design philosophy) are C++ and Scala. And it's not a coincidence that kitchen sink languages place really high on the charts of most hated languages of all times. They can be quite productive to write code in, but reading someone else's code, not so much.

I very much support the "kitchen sink" language design, including new ones like Raku. Among all those features there's usually a few gems that earn their place in more mainstream languages. For example Perl spearheaded first class regular expression support, and that's now simply common sense. Or even such simple things like having hashes (or "dictionaries") and hash literal syntax, or string interpolation (somewhat limited in Perl). These features proved themselves and are now everywhere.

To celebrate Perl's weirdness, this episode will be mainly about the weird parts of Perl, that never got far.

I won't get too much into the WATs. Perl is the WAT factory like no other, and it gets very well deserved criticism for that.

FizzBuzz

But first, the FizzBuzz.

#!/usr/bin/perl

# $\ specifies what gets printed at the end of print automatically
$\ = "\n";

# If we don't specify any variable, Perl will use topic variable $_
for (1..100) {
  if ($_ % 3 == 0 && $_ % 5 == 0) {
    print "FizzBuzz"
  } elsif ($_ % 3 == 0) {
    print "Fizz"
  } elsif ($_ % 5 == 0) {
    print "Buzz"
  } else {
    # print also defaults to printing topic variable
    # (followed by $\ as always)
    print
  }
}

This already demonstrates a lot of Perl's unusual features:

• variables have sigils (prefixes) - $ means scalar, @ means list, % means hash (dictionary), and there are a few less common ones.
• special variables like $\ can control a lot of Perl's behavior
• $_ topic variable to save you some typing - this feature is seen to limited degree in many languages
• ranges 1..100 go from 1 to 100 as they ought to, without the +1 weirdness. You can do 1...100 in Perl too, but that just means the same thing as 1..100. In Ruby 1...100 is same as 1..99.

Say Hello

Let's write code that does this:

$ ./hello.pl
Hello Alice Smith
Hello ALICE SMITH! 🎉🎉🎉
Hello Alice Smith

#!/usr/bin/perl

$\ = "\n";

# Say hello to %person
sub say_hello {
  # Interpolation only works with variables and
  # a few expressions like $variable{key}
  print "Hello $person{name} $person{surname}";
}

# Hash variable
%person = (
  name => "Alice",
  surname => "Smith",
);

say_hello;

# Be more excited this time!
# local changes are reverted once we exit the block
do {
  local $\ = "! 🎉🎉🎉\n";
  local $person{name} = uc$person{name};
  local $person{surname} = uc$person{surname};
  say_hello;
};

# Back to the usual
say_hello;

There's a lot going on here!

%person is a hash variable describing a person. However its elements are not hashes, they're just scalars, so the name of the person is $person{name} and the surname is $person{surname}. People find this sigil system very nonintuitive, and in Raku it switched to %person{"name"}.

One quite unusual feature in Perl is "dynamic scoping" - we can define something local to a block - it works sort of like a global variable, but it gets reverted to what it was before once the block ends.

This way we can change line ending $\ (and honestly without dynamic scoping, those globals changing stuff all over the place would be really bad). But we can also change individual elements of a hash, or current ENV, or many other things.

Perl has also usual local variables with my keyword. And a few other kinds, obviously.

Contexts

The $, @, and so on are not some tiny things. They're actually core to how Perl works. Everything in Perl is in "scalar context" or "list context" (or one of the other contexts).

Here's an example:

#!/usr/bin/perl

$first_person = <STDIN>;
@other_people = <STDIN>;

chomp $first_person;
chomp @other_people;

print "Special welcome to $first_person!\n";
print "Also welcome to ", join(", ", @other_people), "!\n";

And here's what it does:

$ ./contexts.pl
Alice
Bob
Charlie
Dave
Special welcome to Alice!
Also welcome to Bob, Charlie, Dave!

<STDIN> reads lines from STDIN. Annoyingly they always come with the extra \n and there are no special variables to chop that off, that's such a weird omission. But <STDIN> does a different thing depending on being in scalar context or list context.

When we use it in scalar context $first_person = <STDIN> - it reads one line. When we use in in list context @other_people = <STDIN> - it reads all the remaining lines.

A lot of APIs have a lot of pairs of functions getOneX and getManyXs. Perl can simplify this with some context awareness.

Something vaguely similar was done by jQuery where $(selector) could be used to return one thing or many, while modern browser APIs turned that into .querySelector and .querySelectorAll, but jQuery was based on completely different principles.

If you want your function to support contexts you can check wantarray keyword, which return true for list context, false for scalar context, and undef for void context when value is not used. Perl documentation also lists two other contexts, because things are always more complicated than they first seem in Perl.

Golf

Code Golf is a competition to write a program to do a given task in the fewest characters. Before custom languages for golfing got created, it was dominated by Perl, Ruby, and occasionally APL.

Here's such "golfed" code for FizzBuzz, from a Code Golf site:

print+(Fizz)[$_%3].(Buzz)[$_%5]||$_,$/for 1..100

For some explanations:

• words without quotes are treated as strings if there's no better interpretation, so (Fizz) is a list of one string ("Fizz").
• $_%3 return 0, 1, or 2 depending on remainder of $_ modulo 3
• so (Fizz)[$_%3] returns "Fizz" or undef
• and likewise (Buzz)[$_%5] returns "Buzz" or undef
• . is string concatenation and undefined values become empty strings, so (Fizz)[$_%3].(Buzz)[$_%5] returns "Fizz", "Buzz", "FizzBuzz", or ""
• stuff||$_ means stuff if it's true, otherwise $_. As empty string is false in Perl, it gets us "Fizz", "Buzz", "FizzBuzz", or $_, as by FizzBuzz rules
• that extra + is a precedence hack to save on some parentheses
• $/ is \n by default
• so we have print(fizz_buzz_stuff, $/) for 1..100 or for (1..100) { print(fizz_buzz_stuff, "\n") }

As far as golfs go, it's not too bad.

Weirdly Ruby is about equally good for golfing at Perl, without any of the readability issues.

Rename

I still use Perl for one thing on a regular basis, and that's the rename script, which used to be bundled with most Linux distributions, and which I included in my unix-utilities package.

rename takes a Perl script as argument, and then a list of file names. Then it runs that Perl script, with $_ set to the file name. If it changed, it then renames the file.

It of course does sensible things, like dry run mode, verbose mode, checking that it won't accidentally overwrite things, and so on.

Some random examples of rename:

Replace all spaces by underscores:

$ rename 's/ /_/g' *.txt

Flatten nested directory structure by one level:

$ rename 's!/! - ! */*'

Rename all .txt to .md:

$ rename 's/\.txt$/.md/' *.txt

And so on. Most of the time a single regexp replace will do, but sometimes you can run real code there. And for such cases rename --dry-run is amazing.

Autovivification

Normally if you want to build up something iteratively, you need to initialize it first to an empty value. Not in Perl. Because each variable knows if it's a scalar, array, or hash; and each operation knows if it's a string or number operation, Perl can initialize things automatically.

For example in this script:

#!/usr/bin/perl

while(<>) {
  $counts{lc$_}++ for /\w+/g;
}

my @top = sort { $counts{$b} <=> $counts{$a} || $a cmp $b } keys %counts;
for (@top[0..9]) {
  print "$_: $counts{$_}\n";
}

And we can see top ten words in the KJV version of the Bible:

$ curl -s https://www.gutenberg.org/cache/epub/10/pg10.txt | ./wordcount.pl
the: 64305
and: 51762
of: 34843
to: 13680
that: 12927
in: 12727
he: 10422
shall: 9840
for: 8997
unto: 8997

There are so many interesting things going on here:

• autovivification with $counts{lc$_}++ - we didn't have to do %counts={} and $counts{lc$_} ||= 0 like we would in most other languages
• in Perl scalars work as strings or numbers depending on context, which makes things awkward for sorting. Inside sort{ } $a and $b are elements being compared. In this case we compare values numerically with <=> (which returns -1, 0, or +1), and then (|| only runs right side if left is false, and 0 being equal is false) compare keys as strings with cmp (which returns -1, 0, or +1). It can work, but I much prefer Ruby version counts.sort_by{|k,v| [-v, k]}.
• $top[...] is one element of @top, but @top[...] is a list of elements, corresponding to list of indexes we pass.

Function Prototypes

Perl is really committed to not having to do parentheses. For example you can declare that a function takes exactly one scalar argument with ($). Take a look:

#!/usr/bin/perl

sub titleize ($) {
  my ($word) = (@_);
  $word = lc$word;
  $word =~ s/\b./uc$&/eg;
  $word;
}

print "Hello ", titleize "alice SMITH", "!\n";

$ ./prototypes.pl
Hello Alice Smith!

Thanks to the prototype, Perl knows what you meant was this:

print("Hello ", titleize("alice SMITH"), "!\n");

And not this:

print("Hello ", titleize("alice SMITH", "!\n"));

A lot of Perl builtin functions behave like this, including obviously uc and lc.

This is something even Ruby and Raku do not attempt. Ruby achieves its minimal parentheses count by making such one argument functions into methods you can unambiguously call with .method_name:

print "Hello ", "alice SMITH".titleize, "!\n"

Another things to notice here, is that Perl functions don't have argument lists. They just get @_ as argument list, and it's up to them to unpack them. Very often the first line of every function is my ($arg1, $arg2, @rest) = @_ or such.

Flipping Language Features

Perl has a lot of default like calculations being on floating point numbers, but it's really happy to offer alternatives, which you can select with lexically scoped use feature:

#!/usr/bin/perl

$\="\n";

print 1/7;

{
  use bigrat;
  print 1/7;
};

print 1/7;

$ ./bigrat.pl
0.142857142857143
1/7
0.142857142857143

Until recently it offered completely insane $[ which determined if arrays start from 0, from 1, or from something dumb. That got understandably removed.

Unix Integration

Perl always meant to completely replace Unix shell scripts. It has absolutely phenomenal Unix integration. Here are just some examples:

#!/usr/bin/perl

$os = `uname -ms`;
chomp $os;

{
  local $ENV{LC_ALL} = 'ru_RU';
  $date = `date`;
  chomp $date;
};

print "You're on $os\n";
print "In Russian, date is $date\n";

print "Number of characters in numbers 1 to 1_000_000 is: ";
open(F, "|wc -c");
print F $_ for 1..1_000_000;
close F;

$ ./system.pl
You're on Darwin x86_64
In Russian, date is вторник, 11 января 2022 г. 06:31:54 (GMT)
Number of characters in numbers 1 to 1_000_000 is:  5888896

As you can see:

• backticks to get output of a simple command
• you can change ENV by modifyng %ENV - and something other languages don't really provide, you can make those changes scoped so they get restored when you exit the block
• you can open pipes from or to your program just like you'd open a file - for bidirectional communication you'd need to use a module

Only Ruby and Raku fully endorsed this, and Ruby doesn't have local ENV trick. On the other hand, Perl doesn't have equivalent of Ruby's block-scoped local directory change with Dir.chdir{ ... }. In Perl if you change directory with chdir you need to restore it back manually.

Flip Flop Operator

A flip flop is a pair of condition. When first is true, it turns on the flip flop. When second is true, it turns it off. So there's a bit of hidden state.

Well, let's parse some HTML with regular expressions, and extract all links from a head section of an HTML:

#!/usr/bin/perl

$\="\n";

open F, "curl -s https://en.wikipedia.org/wiki/Perl |";
while (<F>) {
  if (/<head>/ .. /<\/head>/) {
    print $1 for /href="(.*?)"/g;
  }
}

$ ./flipflop.pl
/w/load.php?lang=en&modules=ext.cite.styles%7Cext.pygments%2CwikimediaBadges%7Cext.uls.interlanguage%7Cext.visualEditor.desktopArticleTarget.noscript%7Cjquery.makeCollapsible.styles%7Cskins.vector.styles.legacy%7Cwikibase.client.init&only=styles&skin=vector
/w/load.php?lang=en&modules=site.styles&only=styles&skin=vector
//upload.wikimedia.org
//en.m.wikipedia.org/wiki/Perl
/w/index.php?title=Perl&action=edit
/static/apple-touch/wikipedia.png
/static/favicon/wikipedia.ico
/w/opensearch_desc.php
//en.wikipedia.org/w/api.php?action=rsd
https://creativecommons.org/licenses/by-sa/3.0/
https://en.wikipedia.org/wiki/Perl
//meta.wikimedia.org
//login.wikimedia.org

If we had a lot of HTML documents, the flip flop would keep going on whenever a <head> is matched, and keep going off whenever </head> is matched. It's basically a shortcut notation for saying:

#!/usr/bin/perl

$\="\n";

open F, "curl -s https://en.wikipedia.org/wiki/Perl |";
$in_head = false;
while (<F>) {
  $in_head = 1 if /<head>/;
  $in_head = 0 if /<\/head>/;
  if ($in_head) {
    print $1 for /href="(.*?)"/g;
  }
}

Arguably a flip flop expresses it more cleanly than a state variable and some statements to manage it. Or maybe it doesn't.

This feature has a good amount of controversy behind it. Like many Perl features it found its way into Ruby, but you'd be hard pressed to find it used much in typical Ruby code. At one point Ruby tried to deprecate it with goal of removing it, but it managed a rare feat and got itself un-deprecated.

Should you use Perl?

Probably not.

I tried to show Perl in the best light here, and even that wasn't possible without running into a good number of WATs. If you look at real Perl code, there's a really high WAT rate. At the time it could have been argued the WATs are a price worth paying for expressiveness, and it's still way better than shell scripting, but most languages after Perl took many of Perl's best parts, without the WATs.

Perl has two main spiritual successors, which took different lessons from Perl - Ruby and Raku. Ruby took the "lessons learned" approach, kept the good stuff somewhat selectively, also good stuff from Smalltalk and other languages, and created a thing of beauty. Raku took the opposite "build a better kitchen sink" approach, cleaned up some stuff that clearly wasn't working, and instead piled up a lot of completely new untested ideas, to get a hopefully highly expressive mess. Depending on why you wanted to use Perl, one or the other might be more appealing.

Other modern languages like Python (or even somewhat JavaScript with Node) are not quite doing what Perl was aiming at, but they're generally adequate as replacement for shell scripting, and they have an advantage that you might already know them.

Perl is one of the best languages for code golfing, but Ruby is about equally good at it, while being so much more useful overall. And nowadays golfing-specific languages are also very popular.

Overall if you wanted to use Perl for something, I'd recommend Ruby as a first choice replacement, and one of the other languages I mentioned if that's not quite what you want.

While writing this episode I also had quite a few moments when I thought some Perl-style Ruby feature originated in Perl (notably Dir.chdir and %W), but it turned out that it was just Ruby extrapolating from the good parts of Perl. The best Perl of today is no longer Perl itself.

Code

All code examples for the series will be in this repository.

Code for the Perl episode is available here.

Came across an interesting video from one of the users of Perl: Is Perl dead? @Randal L. Schwartz on Dart and Flutter @Code Maven

Advanced Perl Programming is a book from Sriram Srinivasan published in 1997 (ouch!).

It's old, if you're a Perl newcomer, don't read such old books (in addition that this book is not adapted to your level).

There is a second edition of this book but it seems a totally different book (different author). Also the Advanced Perl Programming: From Advanced to Expert from William Bo Rothwell seems a completely different book.

Advanced Perl Programming is old but interesting... but I have to admit that it is not consistent in quality.

I think this book is for "hardcore Perl programmers" 😀

Start of the book

The first chapters talk about Perl internals from a Perl developer point of view: references, symbolic refs, reference counting, symbol table, anonymous subs and closures.

It continues with advanced Perl topics (eval and modules).

These chapters give an overall feeling of cleanliness and deep research from author. Each notion is compared to other programming languages (Java, C++, Tcl) which is VERY interesting. In short I loved these chapters.

It makes me think the author is a senior developer and has made a nice research work :)

Middle of the book

I really less appreciated this part, it's about Object Oriented Programming, interfaces, persistence, templating... But if topics seem cool, it has flaws, it's based often on big pieces of imaginary code (not on CPAN) and/or old technologies. I can't say it's bad, but I definitely less enjoyed this part because also the style. Overall I think it's harder to follow because the ordering where code snippets are introduced is rough (e.g. The tetris chapter).

There are still interesting things to pick up in the middle of this, e.g. I enjoyed the chapter about "Tie" (chapter 9) and Persistence (chapter 10).

End of the book

Starting chapter 18, we are back to Perl internals (perl interpreter internals this time). Personally I'm interested in this and I found this part really great.

Interesting bits in bulk

• "Variable suicide"
• I discovered there was a ".plc" initiative (to pre-compile perl scripts "a la" python .pyc)
• I heard for the first time the word "Impedance mismatch" (OOP)
• When you give a reference as parameter of a function, it is not an optimization
• Symbolic references only works for global variables
• Symbolic references does not increase ref count

Citations

• Perl is an highly idiomatic language (and it is both good and bad)
• Don't sit here and complain, do something! (yet another Perl motto)
• It would be an ideal world if we never had to worry about fatal bugs, power failures or end users (Byte Mag)
• A good tool is one that is used in ways its developers never thought of (Brian Kernighan)

Hi there

Welcome to my first edition of 2022 and 95th edition overall.

I remember there was a time when the O'Reilly group published many Perl books. Then came a few other publishing houses like Manning publications. I am sure you must have owned a handful of Perl books from these publishers. In recent times not many Perl books have been written, except one or two by brian d foy. A friend of mine donated all his Perl books to a local library as he is moving to Python. It is a sad state to be honest. Recently, I came across a Facebook post by a friend of mine about a Perl book called Extending and Embedding Perl. I knew about it but I had never had the chance to read it. So I decided to buy a used copy from Amazon. I must confess I was missing a great deal. If you haven't read it then you must check it out. By the way, I have kept all my Perl books safe. I like to read physical books and not online versions.

With a new year, there is a tradition of new year resolutions. As far as I am concerned, I stopped making any resolutions two years ago. But this year, I decided to make one and stick to it. And the resolution is to get the draft of my first Perl book out as soon as possible. It has been going on for months now. It is embarassing now to even talk about it. There are so many things going on at the same time, I hardly find time for the book. Please wish me luck.

A long time ago, Gabor started a campaign to make live videos about Perl. He even did few pair-programming sessions and they were very popular. But then there has been no noise on that front in recent times. I used to make YouTube videos for the Weekly Challenge during the middle of last year and then I also stopped because of lack of time. Last month, I started making videos again for the Weekly Challenge. It gives me immense pleasure when I see comments on my videos. Someone recently commented on one video and requested I should make videos of past challenges as well. I have to manage my time carefully otherwise my first book would be neglected again. Having said that, I am not giving up on making videos for the Weekly Challenge. If you are interested then please do check out my YouTube Channel.

There is one piece of good news shared by Curtis - that the MMVP (minimally minimal viable product) RFC for Corinna has been sent to P5P. I am keeping my fingers crossed.

Last but not least, please look after yourself and your loved ones.

Part of the Dancer2 video course.

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

Write a script to generate the 10001st prime number.

Solution

use strict;
use warnings;

use boolean; 
use Getopt::Long;
use LWP::UserAgent;

use constant N => 10_001;   
use constant PRIME_URL => "http://primes.utm.edu/lists/small/100000.txt";

sub get_primes{
    my @primes;
    my $ua = new LWP::UserAgent(
        ssl_opts => {verify_hostname => 0}
    );
    my $response = $ua->get(PRIME_URL);
    my @lines = split(/\n/,$response->decoded_content);
    foreach my $line (@lines){
        my @p = split(/\s+/, $line);
        unless(@p < 10){
            push @primes, @p[1..(@p - 1)];
        }
    }
    return @primes;
}

sub sieve_atkin{
    my($n) = @_;
    my @primes = (2, 3, 5);
    my $upper_bound = int($n * log($n) + $n * log(log($n)));
    my @atkin = (false) x $upper_bound;    
    my @sieve = (1, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 49, 53, 59);
    for my $x (1 .. sqrt($upper_bound)){
        for(my $y = 1; $y <= sqrt($upper_bound); $y+=2){
            my $m = (4 * $x ** 2) + ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (1, 13, 17, 29, 37, 41, 49, 53) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    } 
    for(my $x = 1; $x <= sqrt($upper_bound); $x += 2){
        for(my $y = 2; $y <= sqrt($upper_bound); $y += 2){
            my $m = (3 * $x ** 2) + ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (7, 19, 31, 43) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    }   
    for(my $x = 2; $x <= sqrt($upper_bound); $x++){
        for(my $y = $x - 1; $y >= 1; $y -= 2){
            my $m = (3 * $x ** 2) - ($y ** 2);
            my @remainders;  
            @remainders = grep {$m % 60 == $_} (11, 23, 47, 59) if $m <= $upper_bound; 
            $atkin[$m] = !$atkin[$m] if @remainders; 
        }          
    } 
    my @m;
    for my $w (0 .. ($upper_bound / 60)){
        for my $s (@sieve){
            push @m, 60 * $w + $s;  
        }
    }
    for my $m (@m){
        last if $upper_bound < ($m ** 2);
        my $mm = $m ** 2;
        if($atkin[$m]){
            for my $m2 (@m){
                my $c = $mm * $m2;
                last if $c > $upper_bound;
                $atkin[$c] = false;
            }
        }
    }
    map{ push @primes, $_ if $atkin[$_] } 0 .. @atkin - 1;
    return @primes; 
}

sub get_nth_prime{
    my($n, $generate) = @_; 
    my @primes;
    unless($generate){
        @primes = get_primes;
    }
    else{
        @primes = sieve_atkin($n);
    }
    return $primes[$n - 1]; 
}


MAIN:{
    my $n = N;
    my $generate = false;
    GetOptions("n=i" => \$n, generate => \$generate);
    print get_nth_prime($n, $generate) . "\n"; 
}

Sample Run

$ perl perl/ch-1.pl
104743
$ perl perl/ch-1.pl --generate
104743
$ perl perl/ch-1.pl --generate
104743
$ perl perl/ch-1.pl --generate --n 101
547
$ perl perl/ch-1.pl --generate --n 11
31
$ perl perl/ch-1.pl --n 10001
104743
$ perl perl/ch-1.pl --n 11
31

Notes

I've mentioned it before, but for anything that asks for or needs prime numbers I always ust grab them from one of several convenient online sources, rather than generate them myself.

This time around I figured it'd be sporting to generate them myself, but maybe in an interesting way. Here I implement a sieve method for determining prime numbers. This Sieve of Atkin_ has a claim to fame of being the most performant among prime number generating sieve techniques. The code is a bit convoluted looking, I will admit, but is a faithful Perl representation of the algorithm (follow the reference link for pseudocode). Also, rather than try and explain the algorithm myself anyone interested can find full in depth treatments elsewhere. A background in number theory helps for some of the details.

Since I have some existing code for getting the pre-computed primes I figured I would use that as a check and extra feature. Command line options allow for the default behavior (fetch pre-computed primes for an N of 10,001) to be overridden.

Part 2

Given a fraction return the parent and grandparent of the fraction from the Curious Fraction Tree.

Solution

use strict;
use warnings;

use Graph;
use constant ROOT => "1/1";
use constant SEPARATOR => "/";

sub initialize{
    my($member) = @_;
    my $graph = new Graph();
    $graph->add_vertex(ROOT);
    my @next = (ROOT);
    my @changes = ([0, 1], [1, 0]);
    my $level = 0;
    {
        my @temp_next;
        my @temp_changes;
        do{
            $level++;
            my $next = shift @next;
            my($top, $bottom) = split(/\//, $next);
            my $change_left = shift @changes;
            my $change_right = shift @changes;
            my $v_left = ($top + $change_left->[0]) . SEPARATOR . ($bottom + $change_left->[1]);
            my $v_right = ($top + $change_right->[0]) . SEPARATOR . ($bottom + $change_right->[1]);    
            $graph->add_edge($next, $v_left);
            $graph->add_edge($next, $v_right);
            push @temp_next, $v_left, $v_right;
            push @temp_changes, $change_left;
            push @temp_changes, [$level + 1, 0], [0, $level + 1];
            push @temp_changes, $change_right;
        }while(@next && !$graph->has_vertex($member));
        @next = @temp_next;
        @changes = @temp_changes; 
        redo if !$graph->has_vertex($member);
    }
    return $graph;
}

sub curious_fraction_tree{
    my($member) = @_;
    my $graph = initialize($member);
    my($parent) = $graph->predecessors($member);
    my($grandparent) = $graph->predecessors($parent);
    return ($parent, $grandparent);
}

MAIN:{
    my($member, $parent, $grandparent);
    $member = "3/5";
    ($parent, $grandparent) = curious_fraction_tree($member);
    print "member = '$member'\n";
    print "parent = '$parent' and grandparent = '$grandparent'\n";
    print "\n";
    $member = "4/3";
    ($parent, $grandparent) = curious_fraction_tree($member);
    print "member = '$member'\n";
    print "parent = '$parent' and grandparent = '$grandparent'\n";
}

Sample Run

$ perl perl/ch-2.pl
member = '3/5'
parent = '3/2' and grandparent = '1/2'

member = '4/3'
parent = '1/3' and grandparent = '1/2'

Notes

My thought process on this problem started somewhat backwards. After reading the problem statement I thought of the Graph module and remembered that it defines a function predecessors() which would be very useful for this. After convincing myself to use Graph; I then probably spent the majority of the time for this just getting my head around how to define new vertices at each level of the tree. Like all trees there is some recursiveness to the structure, but an iterative implementation still looks clean as well.

Once the graph is constructed the solution as required comes from calling predecessors() to get the parent and grandparent vertices.

References

Challenge 146

Sieve of Atkin

Prime Pages

Graph

1. Config::Tiny - Read/Write .ini style files with as little code as possible
   • Version: 2.28 on 2022-01-04
   • Votes: 30
   • Previous version: 2.27 was 3 months, 12 days before
2. CryptX - Cryptographic toolkit
   • Version: 0.076 on 2022-01-07
   • Votes: 43
   • Previous version: 0.075 was 13 days before
3. HTTP::Message - HTTP style message (base class)
   • Version: 6.36 on 2022-01-05
   • Votes: 59
   • Previous version: 6.35 was 1 month, 24 days before
4. IO::Socket::SSL - Nearly transparent SSL encapsulation for IO::Socket::INET.
   • Version: 2.074 on 2022-01-07
   • Votes: 42
   • Previous version: 2.073 was 16 days before
5. JSON::Validator - Validate data against a JSON schema
   • Version: 5.05 on 2022-01-06
   • Votes: 29
   • Previous version: 5.04 was 28 days before
6. Minilla - CPAN module authoring tool
   • Version: v3.1.14 on 2022-01-07
   • Votes: 53
   • Previous version: v3.1.12 was 9 months, 13 days before
7. SPVM - Static Perl Virtual Machine. Fast Calculation, Fast Array Operation, and Easy C/C++ Binding.
   • Version: 0.9112 on 2022-01-07
   • Votes: 21
   • Previous version: 0.9103 was 7 days before
8. Test::Differences - Test strings and data structures and show differences if not ok
   • Version: 0.69 on 2022-01-07
   • Votes: 20
   • Previous version: 0.68 was 7 months, 20 days before
9. Text::ANSITable - Create nice formatted tables using extended ASCII and ANSI colors
   • Version: 0.607 on 2022-01-05
   • Votes: 16
   • Previous version: 0.606 was 4 months, 9 days before

These are the ten most rated questions at Stack Overflow last week.
Between brackets: [question score / answers count]
Build date: 2022-01-08 22:09:37 GMT

1. Capturing group regex with grep - [3/4]
2. Find nearest option in a Perl Hash - [3/3]
3. Count trailing newlines with POSIX utilities or Perl - [2/5]
4. A 'my' issue, it cannot work even in clear PL rule - [2/1]
5. How can I get table height from PDF::Table? - [2/1]
6. Perl wrong UTF-8 output - [2/1]
7. Perl: Repair utf8 xml file which contains octal or hexadecimal codes - [2/1]
8. Howto sort inline POD entries of a Perl package documentation for IMenu or a final documentation - [2/0]
9. Perl 5 signatures: Passing multiple arrays - [1/2]
10. How to get regex to work in a perl script? - [1/2]

Hi everyone!

Let me start by welcoming you to the new year! Let me also use the opportunity to thank Mohammad S. Anwar for his dedication in both editing every other edition of the Perl Weekly Newsletter and his very own Weekly Challenge. Let me also thank Dave Cross for his immense help making our grammar a bit more bearable and the various Open Source projects he creates. (e.g. the CPAN Dashboard or The Perl Planetarium). If you also like their work please thank them in an email, a blog post, or by supporting them via Patreon for Mohammad or via GitHub for Dave. They won't become wealthy from this, but receiving a paycheck every month from tens of supporters give a huge boost to the ego and makes one create even more for the public.

As for me, you might recall I've been learning Spanish for more than 3 years and started to learn Ladino (aka. Judeo-Spanish) a few weeks ago. Learning a foreign language is a totally different experience than learning a programming language. If for nothing else, because you don't get immediate feedback to your mistakes from a compiler. Well. Except if you use an application that helps you. My open source mindset quickly kicked in. I found an Open Source platform called LibreLingo that will help you learn languages. It is still in very early version, but started to use that platform to be able to practice Ladino and also started to contribute to the project. I'll share more about it when enough progress was made to show something in public. Until then you are invited to check it out.

Enjoy the year ahead!

dist	author	first_version	latest_version	abstract
ACME-Dzil-Test-daemon	DAEMON	0.001	0.001	Module abstract placeholder text
ACME-Dzil-Test-daemon2	DAEMON	0.001	0.001	Module abstract placeholder text
Acme-CPANModules-ShellCompleters	PERLANCAR	0.001	0.001	Modules that provide shell tab completion for other commands/scripts
Acme-CPANModules-WorkingWithURL	PERLANCAR	0.001	0.001	Working with URL
Alien-libmaxminddb	VOEGELAS	1.000	1.000	Find or download and install libmaxminddb
Apache2-Dummy-RequestRec	JFF	0.01	0.03	dummy Apache request record class for testing
Apache2-RequestData	JFF	0.01	0.02	collects all query and post parameters in a hash ref
App-optex-rpn	UTASHIRO	1.01	1.01	Reverse Polish Notation calculation
App-ptimeout	DCANTRELL	v1.0.0	v1.0.0	time out a command, reporting errors
Array-Set-Naive	PERLANCAR	0.001	0.001	Like Array::Set, but uses naive algorithms
ArrayData-WordList	PERLANCAR	0.001	0.001	Array data from a WordList::* module
Avatica-Client	LOGIONIZ	0.001	0.002	Client for Apache Calcite Avatica
Bio-RNA-BarMap	FELIXK	0.01	0.01	Parse and query BarMap mappings.
Bio-RNA-Barriers	FELIXK	0.01	0.01	Parse, query and manipulate output of Barriers
Bio-RNA-Treekin	FELIXK	0.01	0.01	Classes for working with Treekin output.
CLI-Meta-cp	PERLANCAR	0.001	0.001	Metadata for 'cp' Unix commnd
CLI-Meta-mv	PERLANCAR	0.001	0.001	Metadata for 'mv' Unix commnd
Catalyst-Plugin-CachedUriForAction	ARISTOTLE	1.000	1.000	drop-in supercharger for uri_for_action
Crypt-Bcrypt	LEONT	0.001	0.002	A modern bcrypt implementation
DBD-Avatica	LOGIONIZ	0.01.0	0.2.1	Driver for Apache Avatica compatible servers
DBD-Phoenix	LOGIONIZ	0.01.0	0.01.0	Driver for Apache Avatica compatible servers
Devel-Agent	AKALINUX	0.001	0.007
Device-Chip-CCS811	PEVANS	0.01	0.01	chip driver for CCS811
Dist-Zilla-Plugin-SignReleaseNotes	TIMLEGGE	0.0001	0.0003	Create and signs a 'Release' notes file
ELab-Client	AKHUETTEL	0.010	0.020	Access the eLabFTW API with Perl
File-Symlink-Util	PERLANCAR	0.001	0.001	Utilities related to symbolic links
Freecell-Deal-MS	SHLOMIF	0.0.1	0.4.0	deal Windows FreeCell / FC Pro layouts
Git-Background	SKIRMESS	0.001	0.001	Perl interface to run Git commands (in the background)
HTML-Inspect	MARKOV	1.00	1.00	Inspect a HTML document
Health-SHC	TIMLEGGE	0.001	0.004	Extract and verify Smart Haelth Card information
IP-Geolocation-MMDB	VOEGELAS	0.001	0.005	Map IP addresses to country codes
Mail-Exim-Blacklist-Attachments	VOEGELAS	1.007	2.000	Blacklist email attachments
Mail-Exim-Blacklist-GeoIP	VOEGELAS	1.001	1.001	Map IP addresses to country codes
Mail-Exim-Blacklist-Geolocation	VOEGELAS	1.000	1.002	Map IP addresses to country codes
Mojo-Darkpan	RES	0.04	0.06	A Mojolicious web service frontend leveraging OrePAN2
OPM-Maker-Command-sopm	PERLSRVDE	1.0.0	1.1.0	Build .sopm file based on metadata
SPVM-Math	KIMOTO	0.01	0.05	SPVM Math Functions
Set-CSS	SHLOMIF	0.0.1	0.2.0	set of CSS classes
Test-HTTP-MockServer-Once	IGIBBS	v0.0.1	v0.0.2	Implement a one shot mock HTTP server for use in tests
Thread-Csp	LEONT	0.001	0.003	Communicating sequential processes threading for Perl
Time-Local-ISO8601	PERLANCAR	0.001	0.001	Compute time (Unix epoch) from YMD/ISO8601 sting
UI-Various	DORNER	0.01	0.09	graphical/non-graphical user interface without external programs
URL-XS	BRDUCH	v0.2.0	v0.3.1	Parsing URLs with zero-copy and no mallocs
Util-H2O-More	OODLER	0.0.1	0.0.3	like if bless created accessors for you. Intended for hash reference-based Perl OOP only. This module uses Util::H2O::h2o as the basis for actual object creation; but there's no reason other accessor makers couldn't have been used or can be used. I just really like h2o.
WordList-ArrayData	PERLANCAR	0.001	0.001	Wordlist from any ArrayData::* module
WordList-Special-Stdin	PERLANCAR	0.001	0.002	Wordlist from STDIN
XML-SAX-SVGTransformer	ISHIGAKI	0.01	0.04	SVG transformer
YAML-PP-Ref	TINITA	0.01	0.01	Generated Reference Parser backend for YAML::PP
idi	GENE	0.0100	0.0102	Easy Command-line MIDI
qq	RAJ	0.02	0.02	command line journal app

Stats

Number of new CPAN distributions this period: 50

Number of authors releasing new CPAN distributions this period: 28

Authors by number of new CPAN distributions this period:

A few more days of Advent of Code...

Day 15 - Chiton

Another path finder, this time with different costs for different paths. This screams for Dijkstra, but for part 1 I still did a more stupid brute force solution using code similar to Day 12 (but using a stack instead of recursion).

For part two my brute force solution was too slow, so I actually had to understand / implement Dijkstra, which took a bit of time, the Wikipedia article and this nice page. It was still rather slow, because I used a plain Perl sort to sort the todo list. Then I thought that I could just group the nodes by cost, thinking (in error) that there would by only 9 buckets, but as each node stores the cumulative cost there are way more buckets. Then I looked into this thing called Heap that was all hot on reddit, and sped up my code a lot by using Heap::Simple. Abigail has a very nice and detailed explanation of "Heap" on his post about the 15th.

• Part 1
• Part 2

Day 16 - Packet Decoder

Yay, decoding a binary protocol!

First, I decode the input into a binary string:

my $bits = join( '', map { sprintf( "%.4b", hex( '0x' . $_ ) ) } split( //, $ARGV[0] || <> ) );

Reading that from right to left, we first either read in a file or take the input directly from the command line, and split it into single characters (split //), the interpret that char as a hex value (hex('0x'.$_)) and convert it into a four bit 0/1 string (sprintf( "%.4b", ..)).

Then we "just" need to take a few bits of that string (I use substr to bite of the correct sizes) to get the version and type_id, and handle the next bits based on the type. As we're dealing with packets that can contain subpackets, I implemented all of this in a recursive function, where the most fiddly stuff was to make sure that the correct number of bits stay on the input stream.

I liked it!

• Part 1
• Part 2

Day 17 - Trick Shot

I spend some time thinking about math-y ways to solve the problem, but only figured out a way to calc the bounds for x. For part 1, I looped through all y between shooting straight down and double the max depths, and got my result. For part 2 the same interval also worked, so I just needed to adjust the calculation of the winning shot.

I liked how I parsed the input, using the return values of the regex:

my ($xfrom, $xto, $yto, $yfrom) = $in =~ /x=(-?\d+)..(-?\d+), y=(-?\d+)..(-?\d+)/;

• Part 1
• Part 2

Day 18 & 19

I skipped those two days (for now), because they seemed quite complex, and I had family stuff to do on the weekend.

Day 20 - Trench Map

This was a bit too tricky for me. I got part 1 working quite easily for the test data, but it did not work for the live data (which was the actual tricky bit here). After working through some solutions on reddit I finally figured out how to handle the blinking background, solving both parts with the same code:

• Part 1 & 2

Day 21 - Dirac Dice

Here I found the first part quite easy, though I still have problems implementing a modulo that works from 1 to 10 instead of 0 to 9:

 my $pos = ( $board{$player}->{pos} + $roll ) % 10;
 $pos = 10 if $pos == 0;

I did not try the second part, because I was busy with Christmas preparations (in my case, producing my mixtape)

• Part 1

Day 22 - Reactor Reboot

I did a quick brute force for part 1, knowing very well that this approach will not work for the second part (where I assumed (correctly) we cannot just ignore the values outside -50:50). I thought a bit about how to intersect cubes, but again had other things to do, and not enough math-power.. So part 2 will have to be solved later

• Part 1

Day 24 - Arithmetic Logic Unit

I skipped day 23 and 24 (again because of Christmas..), but spend some time on the 25th to solve day 24.

Of course I fell for the trap and implemented the ALU (so much simpler than Intcode!) and could output 4 bit numbers easily. But using my virtual machine to brute-force the model number would take ages.

So after some reading reddit I found this solution which very nicely explained how to reverse-engineer the input code to figure out which lines in the code where actually relevant. I then used this as my actual task and wrote some code to extract the relevant lines from my input, do the correct stack manipulations and just output the rules for the different numbers (the 5th number has to be 3 larger then the 11th number, etc):

 my @stack;
 my %rules;
 for my $i (1..14) {
     my $prog = $progs[$i];
     my $check = $prog->[5]->[2];
     my $offset = $prog->[15]->[2];
     if ($check > 0) {
         push(@stack,[$i,$offset]);
     }
     else {
         my $old = pop(@stack);
         my $calc = $old->[1] + $check;
         $rules{$i} = [$old->[0],$calc];
     }
 }

And then calculated the biggest/smallest serial number by hand.

But because I had some more appetite for coding, I also implemented an automatic solver:

 my @high=' ';
 my @low= ' ';
 while (my ($pos, $rule) = each %rules) {
     if ($rule->[1] <= 0) {
         $high[$rule->[0]] = 9;
         $high[$pos] = 9 + $rule->[1];
         $low[$pos]=1;
         $low[$rule->[0]]= 1 - $rule->[1] ;
     }
     else {
         $high[$pos] = 9;
         $high[$rule->[0]] = 9 - $rule->[1];
         $low[$rule->[0]] = 1;
         $low[$pos] = 1 + $rule->[1];
     }
 }
 
 say "high: ".join('',@high);
 say "low:  ".join('',@low);

Very nice, but I could have never come up with the actual solution on my own.

The rest...

I do plan to try to tackle the remaining tasks, but it might take some time, as we have a rather big roll-out of a project that has been in the work the last 1.5 years in the next week...

But it was another very nice Advent of Code. Thanks, Eric, and all the other people who helped make this work, and who posted their solutions and explanations!

Hi there

We wish all the readers of the newsletter, Merry Christmas. I hope and wish you are all enjoying quality time with your loved ones.

Belated happy birthday to my favourite language, Perl, on completing 34 years. Mark Gardner used his weekly blogging schedule to celebrate the occassion in his blog post.

Do you remember which year you first picked up the Perl language?

For me, I was introduced to Perl in the year 1998. So technically, I am 23 Perl years old. How about you? I am wondering if anyone other than the creator picked the language in the first year that it existed. If you know their name then please do share it with us. I am sure there must be a handful of people that I am not aware of.

Talking about birthday celebrations, I would like to wish belated Happy Birthday to the mother of our chief editor, Gabor Szabo. As per the record, my birthday was last Monday i.e. 20th December. To date, I have never celebrated my birthday, this year also went without celebration.

I noticed that I am getting close to my 100th edition of the newsletter. This is my 94th edition. It would be a big achievement for me, personally, to reach that number. I am looking forward to the 556th edition of the weekly newsletter as that will be my 100th edition.

Stay safe and enjoy the holiday break.

In Perl there are many ways to run external programs. Some of the ways will allow you to capture the output of the external program and some will even make it easy and fun. We are now looking at Capture::Tiny.

Merry Christmas and Happy New Year! May 2022 bring you less COVID and more Perl projects!

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

Write a script to generate all Semiprime numbers <= 100.

Solution

use strict;
use warnings;
use boolean; 
use LWP::UserAgent;
use constant N => 100; 
use constant PRIME_URL => "http://primes.utm.edu/lists/small/100000.txt";

sub get_primes{
    my @primes;
    my $ua = new LWP::UserAgent(
        ssl_opts => {verify_hostname => 0}
    );
    my $response = $ua->get(PRIME_URL);
    my @lines = split(/\n/,$response->decoded_content);
    foreach my $line (@lines){
        my @p = split(/\s+/, $line);
        unless(@p < 10){
            push @primes, @p[1..(@p - 1)];
        }
    }
    return @primes;
}

sub factor{
    my($n) = @_;
    my @factors = ();
    for  my $j (2 .. sqrt($n)){
        if($j**2 == $n){  
            push @factors, [$j, $j] if $j**2 == $n;
            next; 
        }
        push @factors, [$j, $n / $j] if $n % $j == 0;
    }
    return @factors;
}

sub semiprime{
    my($n, $primes) = @_;
    my @factors = factor($n);
    return false if @factors != 1;  
    my @prime_factors = grep {$factors[0]->[0] == $_ || $factors[0]->[1] == $_} @{$primes};     
    return true if @prime_factors == 2 || $prime_factors[0]**2 == $n; 
    return false; 
}

sub semiprime_n{
    my @primes = get_primes; 
    for my $n (1 .. N){
        print "$n " if semiprime($n, \@primes);   
    } 
    print "\n"; 
}

MAIN:{
    semiprime_n;
}

Sample Run

$ perl ch-1.pl
4 6 9 10 14 15 21 22 25 26 33 34 35 38 39 46 49 51 55 57 58 62 65 69 74 77 82 85 86 87 91 93 94 95

Notes

I am sticking to the convention that I started a while back to not re-compute prime numbers myself, but instead just grab them from one of several convenient online sources. The URL in the code above requires only a small amount of effort to scrape and parse. I hope nobody minds the little bit of extra traffic to their site!

Please do check out their main page listed below. It's a fun resource with interesting facts and news on prime numbers and related research.

Once the list of the first 100k primes is obtained (that's more than enough for any of these challenges) we proceed to factor and test candidate numbers. Provided the number has only two factors (which may be equal) and both of them are prime then it passes the semiprime test.

Part 2

You are given two positive numbers, $u and $v. Write a script to generate Ulam Sequence having at least 10 Ulam numbers where $u and $v are the first 2 Ulam numbers.

Solution

use strict;
use warnings;
use constant ULAM_LIMIT => 10;   

sub ulam{
    my($u, $v) = @_;    
    my %pairs; 
    my @ulam = ($u, $v); 
    my $w = $u + $v;  
    push @ulam, $w;  
    $pairs{"$u,$v"} = $w; 
    $pairs{"$u,$w"} = $u + $w; 
    $pairs{"$v,$w"} = $v + $w; 
    do{
        my @sums = sort {$a <=> $b} grep{my $sum = $_; my @values = grep{$sum == $_} values %pairs; $sum if @values == 1 && $sum > $ulam[@ulam - 1]} values %pairs; 
        my $u = $sums[0]; 
        push @ulam, $u;
        for my $pair (keys %pairs){
            my($s, $t) = split(/,/, $pair);  
            $pairs{"$s,$u"} = $s + $u;
            $pairs{"$t,$u"} = $t + $u;
        }   
    }while(@ulam < ULAM_LIMIT);
    return @ulam;  
}

MAIN:{
    my @ulam;
    @ulam = ulam(1, 2);   
    {
        print shift @ulam;
        print ", ";
        redo if @ulam > 1;
    } 
    print shift @ulam;
    print "\n";

    @ulam = ulam(2, 3);   
    {
        print shift @ulam;
        print ", ";
        redo if @ulam > 1;
    } 
    print shift @ulam;
    print "\n";

    @ulam = ulam(2, 5);   
    {
        print shift @ulam;
        print ", ";
        redo if @ulam > 1;
    } 
    print shift @ulam;
    print "\n";
}

Sample Run

$ perl perl/ch-2.pl
1, 2, 3, 4, 6, 8, 11, 13, 16, 18
2, 3, 5, 7, 8, 9, 13, 14, 18, 19
2, 5, 7, 9, 11, 12, 13, 15, 19, 23

Notes

The code here is a pretty direct translation of the definition: the next member of the sequence must be a sum of two previous members which is greater than the previous member and only be obtainable one way. Here that is done with a grep filter, with the sequence itself being stored in an array, but for convenience the sums of all unique previous pairs are kept in a hash.

References

Challenge 144

Semiprime Number

Prime Pages

Ulam Sequence

As previously announced, one of The Perl Foundation's initiatives for this year was to participate in Google Season of Docs. I'm pleased to announce that Khawar Latif Khan successfully completed the project.

You can read further details at * Khawar's Medium article * Jason McIntosh's case study

In addition, Khawar plans to share his experience at the next Perl and Raku Conference in Houston.

I'd like to thank: * Khawar for his quality work * Jason McIntosh for being the project lead and mentorship * All others who were involved in this project and provided input to Khawar * Google Season of Docs team for making this project happen

I'm looking forward to discussing more in Houston.

(published on behalf of TPF and Marketing Committee)

With the end of the year quickly approaching, The Perl Foundation want to thank you for all that you do in supporting us. Your support has allowed us to make significant strides in advancing the Perl and Raku languages, and the software behind them. There is, however, much work that still needs to be done.

As you consider your year-end philanthropy, we want to highlight a few strategies that may reduce your tax liability. Your gift to The Perl Foundation may be tax-deductible, so now is a great time to help us pave the way for another successful year at TPF.

(Please consult your tax advisor for information on your specific circumstances. This article should not be considered tax or financial advice).

Gifts of Cash - Extensions for 2021

"Above-the-Line" Deduction for Cash Gifts Extended and Expanded in 2021 - The $300 above-the-line deduction established in 2020 for gifts of cash by a non-itemizer (excluding donor advised funds or supporting organizations) has been extended and expanded to $600 for those filing jointly for the 2021 tax year. So, even if you are not planning to itemize your deductions for 2021, you can still take advantage of this tax benefit. Speak to your accountant and make donations.

Increase in Charitable Deduction Limit

The increase in the itemized deduction for cash contributions to public charities of 60% to 100% of adjusted gross income has been extended to include the 2021 tax year. Speak to your accountant and make donations.

Additional Tax Advantageous Giving Strategies

Gifts of Long-Term Appreciated Securities: In many cases, a gift of long-term appreciated securities is more tax advantageous than giving cash because capital gains taxes can be avoided. This can be especially useful in optimizing your tax benefits if you are not itemizing deductions in a given year.

IRA Charitable Rollover Gifts: If you are 70 years and six months of age or older, the IRS may allow you to make a qualified charitable distribution of up to $100,000 directly to The Perl Foundation from a traditional Individual Retirement Account (IRA). The benefit of donating through a rollover is that you will be able to avoid reporting the income.

Speak to your accountant to learn more about theses two options.

Thank you for being such an important part of our work at The Perl Foundation. Your support makes it possible for us to do the daily work growing Perl and Raku.

In this issue: * About The Perl and Raku Conference in Houston * Call for Presenters * Call for Teachers/Master-Class * Call for talk ideas * Volunteer-Organizer positions open * Call for sponsors * Contact us

Come to the Perl and Raku Conference in Houston!

We can't wait to see everyone in person at the 2022 Perl and Raku Conference June 21-25 2022!

You can expect to see a lot of presentations on Perl, Raku, and supporting languages. Core presentation topics in the past have included Perl 5 and Raku. Organizers are hopeful to continue with a core of Perl 5 and Raku moving forward. It’s worth noting that this event is run by volunteers and talks are also given by volunteers. The presentations at the conference are being submitted now during our Call For Presenters (CFP) and will be selected by organizers who volunteer to be on our talks-committee. Generally, there are sets of 3 to 4 simultaneous presentations (20-50 minutes long) on a variety of topics throughout each main event day. Surrounding the main conference days, master-class tutorial sessions (half day and full day format) are offered for an additional fee.

If you see #TPRCHouston around on social media, that’s our tag for The Perl Conference in Houston.

The website is live! There are still a few details we're filling in like how to book a room and of course the schedule, but there's still a bunch of information you can get by visiting https://perlconference.us

Call for Presenters

The call for presentations is open now! We will have an early submission deadline of 12 noon UTC, Tuesday February 1st. The final deadline for speaker submissions is 12 noon, Tuesday March 1st. Submit your talk ideas here: https://perlconference.us/speakers

Whether this is your first time submitting a talk proposal or one of many you’ve proposed and presented, consider submitting your talk idea to us. Making a presentation at a national event is great for networking and experience!

The presentations at the conference are selected by organizers who volunteer to be on our Talks Committee. Generally, there are sets of 3 to 4 simultaneous presentations (20 or 50 minutes long, including Q&A) on a variety of technical topics throughout each main event day.

Not sure you are up for giving a talk but have a topic you’d like to learn more about at our event? Tweet @PerlConferences using #TPRCHouston or email admin@perlconference.us.

Call for Teachers/Master-Class

We need to fill out our master-class/tutorial schedule. All tutorial ideas will be considered. You can submit your class idea to https://perlconference.us/speakers. We will get back to you quickly.

Keep in mind, the event schedule differs from some of the past events. Master-class tutorial sessions surrounding the main event and will be held on Jun 21 (Tuesday) and Jun 25 (Saturday).

What presentations are you hoping to see?

We’d love to hear your tech talk ideas for TPRCHouston! We’ve already received some interest in the following topics:

• Perl and Raku / Internet / History game show
• Security
• Fun side projects with Perl and Raku
• Integrating Perl and Raku with other tools

Got some more talk suggestions? Tweet @PerlConferences using #TPRCHouston or email admin@perlconference.us.

Be part of it all - Organizer spots open!

Planning for The Perl Conference in Houston is underway and we need a few more hands! It’s not too late to join us in planning this event! Openings are web design/content editor, speaking coordinator, outreach assistant, and more... Email admin@perlconference.us to volunteer. You can help frame the conference!

Call for Sponsors!

A donation to The Perl Foundation not only contributes to the Perl Conference in Houston, but also aids our other outreach programs. Perl Foundation Sponsors will get recognition for supporting The Perl Conference as well as our regional Perl Workshops, beginner training initiatives, and our grants programs for an entire year. Donating directly to The Perl Foundation provides the most value for your sponsorship money.

However, sponsors can also donate directly to The Perl Conference. Often the organizers are able to link a sponsor directly to an event at the conference (wifi, coffee break, etc.) where the cost of the event is in line with the donation amount.

Sponsors of $500 or more will be provided a table at our sponsor expo and job fair.

How to reach our organizers

• Visit our website: https://perlconference.us
• Follow us on Twitter: @PerlConferences
• Like us on Facebook: https://www.facebook.com/theperlconference
• Subscribe to the mailing list: https://perlconference.us/subscribe
• Send any questions about The Perl Conference to admin@perlconference.us. An organizer will get back to you.

Hi there!

Thomas Klausner sent me a bunch of links and suggestion, let me share them first:

Abigail has a series of Advent posts starting from day 01. I did not find a page listing all the entries but you can get to them by changing the URL. Smylers is doing crazy stuff with vim (and perl). One can find a lot of inspiring code (Perl, Raku and of course other languages) in the various 'Solution Megathreads' on Reddit. Finally domm himself has a few Advent related posts.

Today we are celebrating the 80th birthday of my mother. Due to the pandemic we cannot celebrate in the same space, but we have collected some videos from the family members and her friends and we are going to have a Zoom session. Much better than not being able to celebrate at all. Happy birthday mom!

In a few days a large part of the world is going to celebrate the birthday of another Jew.

Merry Christmas!

When using fork to create child processes it is a good idea to encapsulate the behavior of both the child process and the parent process in (separate) functions.

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given a string, $s, containing mathematical expression. Write a script to print the result of the mathematical expression. To keep it simple, please only accept + - * ().

Solution

Main driver.

use strict;
use warnings;
##
# Write a script to implement a four function infix calculator.     
##
use TWCCalculator;
use constant ADD => "10 + 8";
use constant SUBTRACT => "18 - 66";
use constant ADD_SUBTRACT => "10 + 20 - 5";  
use constant MULTIPLY => "10 * 8";
use constant DIVIDE => "52 / 2";
use constant CALCULATE => "(10 + 20 - 5) * 2"; 

MAIN:{
    my $parser = new TWCCalculator();
    $parser->parse(ADD); 
    $parser->parse(SUBTRACT); 
    $parser->parse(ADD_SUBTRACT); 
    $parser->parse(MULTIPLY); 
    $parser->parse(DIVIDE);
    $parser->parse(CALCULATE);
}   

TWCCalculator.yp (the Parse::Yapp code). This file is used to generate a parser module, TWCCalculator.pm, which is used in the code above. This is where the actual parsing of the input and implementation of the calculator is.

%token NUMBER    
%left '+' '-' '*' '/'

%%

line: 
    | expression  {print $_[1] . "\n"} 
;

expression: NUMBER
    | expression '+' expression {$_[1] + $_[3]}
    | expression '-' expression {$_[1] - $_[3]}
    | expression '*' expression {$_[1] * $_[3]}
    | expression '/' expression {$_[1] / $_[3]}
    | '(' expression ')' {$_[2]}
;

%%

sub lexer{
    my($parser) = @_;
    $parser->YYData->{INPUT} or return('', undef);
    $parser->YYData->{INPUT} =~ s/^[ \t]//;
    ##
    # send tokens to parser
    ##
    for($parser->YYData->{INPUT}){
        s/^([0-9]+)// and return ("NUMBER", $1);
        s/^(\+)// and return ("+", $1);
        s/^(-)// and return ("-", $1);
        s/^(\*)// and return ("*", $1);
        s/^(\/)// and return ("/", $1);
        s/^(\()// and return ("(", $1);
        s/^(\))// and return (")", $1);
        s/^(\n)// and return ("\n", $1);
    }  
}

sub error{
    exists $_[0]->YYData->{ERRMSG}
    and do{
        print $_[0]->YYData->{ERRMSG};
            return;
    };
    print "syntax error\n"; 
}

sub parse{
    my($self, $input) = @_;
    $self->YYData->{INPUT} = $input;
    my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error);
    return $result;  
}

Sample Run

$ yapp TWCCalculator.yp
$ perl ch-1.pl
18
-48
25
80
26
50

Notes

In a long ago (almost exactly two years!) Challenge we were asked to implement a Reverse Polish Notation (RPN) Calculator. For that challenge I wrote a short introduction to the parser module, Parse::Yapp, that I used. See the references below, I think it still holds up.

For this challenge I was able to rely pretty heavily on that older code. I simply changed the expected position of the operators and that was about it!

I really like any excuse to use a parser generator, they're a powerful tool one can have at the disposal for a fairly small investment of learning time. Well, practical usage may be quick to learn. Depending on how deep one wants to go there is the possibility also of a lifetime of study of computational linguistics.

Part 2

You are given a positive number, $n. Write a script to find out if the given number is a Stealthy Number.

Solution

use strict;
use warnings;
use boolean; 

sub factor{
    my($n) = @_;
    my @factors = ();
    for  my $j (2 .. sqrt($n)){
        push @factors, [$j, $n / $j] if $n % $j == 0;
    }
    return @factors;  
}

sub stealthy{
    my($n) = @_;
    my @factors = factor($n);
    for(my $i = 0; $i < @factors; $i++){
        for(my $j = 0; $j < @factors; $j++){
            unless($i == $j){
                my($s, $t) = @{$factors[$i]}; 
                my($u, $v) = @{$factors[$j]}; 
                return true if $s + $t == $u + $v + 1; 
            }  
        }  
    }  
    return false; 
}

MAIN:{
    print stealthy(12) . "\n";
    print stealthy(36) . "\n";
    print stealthy(6)  . "\n";
}

Sample Run

$ perl perl/ch-2.pl
1
1
0

Notes

That factor subroutine makes another appearance! Well, here there is a slight modification to get it to return the factors in pairs, each pair an array reference. These are all checked in a loop for the desired property.

This is a classic "generate and test" approach. For an idea of what it would look like to instead constrain the variables to fit the property and then discover which values, if any, match these constraints then please do take a look at my Prolog solution for Challenge 143 which uses a Constraint Logic Programming over Finite Domains (clpfd) approach.

References

Challenge 143

Parse::Yapp

RPN Calculator for Challenge 039