I recently acquired a copy of Programming Perl, often referred to as "The Camel Book" in the Perl community. After reading the first 4 chapters I thought I would share a few Perl tidbits I found interesting.

While <> is True

Say we have the following file named logos.txt.

Onion
Camel

Raptor

And in the same directory we have the following program named scratch.pl.

open my $fh, '<', 'logos.txt' or die;
while (my $logo = <$fh>) {
    print $logo;
}
close $fh;

As expected our program prints the contents of logos.txt.

$ perl ./scratch.pl
Onion
Camel

Raptor

Something I never really considered though, is why doesn't the loop exit when <> reads the empty line in logos.txt? Shouldn't <> return an empty string which is a false value?

According to Programming Perl, the reason why the loop doesn't exit is because <> reads the newline at the end of the line so we actually get "\n" which is a true value. Turns out this is a fib, and the actual reason is that while (my $logo = <$fh>) ... expands into while (defined (my $logo = <$fh>)) ..., and "\n" is a defined value.

We can show this by deparsing the code with B::Deparse.

$ perl -MO=Deparse,-p,-sCi2 -ne 42
LINE: while (defined(($_ = readline(ARGV)))) {
  '???';
}
-e syntax OK

Heredocs Can Execute Shell Commands

Most Perl programmers know that if you single quote a heredocs terminating string you prevent variable interpolation.

my $var = 12;
print <<'EOS';
Hello
$var = 12
EOS

You can see in the programs output that $var was not interpolated.

$ perl ./scratch.pl
Hello
$var = 12

But did you know that if you backquote the terminating string then each line is executed as a shell command?

print <<`EOC`;
echo this is a shell command
echo this is also a shell command
EOC

When we run this program we can see that the echo commands were executed.

$ perl ./scratch.pl
this is a shell command
this is also a shell command

The Comma Operator

I always took commas for granted, never realizing they were actually an operator.

Did you ever wonder why lists return their last element when evaluated in scalar context? Turns out it is due to the comma operator.

In scalar context the comma operator "," ignores its first argument, and returns its second element evaluated in scalar context.

This means that in scalar context the list (11, 22, 33) will evaluate to 33. The first comma operator will throw away the 11 and then return (22, 33) evaluated in scalar context, which will be evaluated by throwing away the 22 and returning 33.

Auto-Incrementing Strings

In perl you can not only auto-increment numbers, but also strings. To increment a string it must match the regex /^[a-zA-Z]*[0-9]*\z/.

Single alphabet character strings are incremented intuitively.

$ perl -E 'my $v = "a"; say ++$v'
b
$ perl -E 'my $v = "B"; say ++$v'
C

What happens though if we increment a non-alphanumeric char. Will it give the next ASCII character? Turns out non-alphanumeric characters are treated as 0's when incrementing. Fortunately if we use warnings Perl will give us a heads up.

$ perl -W -E 'my $v = "-"; say ++$v'
Argument "-" treated as 0 in increment (++) at -e line 1.
1

What happens if we increment z, which is at the end of the alphabet? Do we wrap back around to a? This is where things get interesting. Perl increments the string just like you would in a regular number system. Just like 9 + 1 = 10 in decimal z + 1 = aa in … stringimal.

$ perl -E 'my $v = "z"; say ++$v'
aa

Here are some more examples to show you the magic of string auto-incrementing.

$ perl -W -E 'my $v1 = "foo"; say ++$v1'
fop
$ perl -W -E 'my $v1 = "az"; say ++$v1'
ba
$ perl -W -E 'my $v1 = "a9"; say ++$v1'
b0

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

Spoiler Alert: This weekly challenge deadline is due in a few of days from now (on Aug. 14, 2022 at 23:59). 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: Damm Algorithm

You are given a positive number, $n.

Write a script to validate the given number against the included check digit.

Please checkout the wikipedia page for information.

Example 1

Input: $n = 5724
Output: 1 as it is valid number

Example 2

Input: $n = 5727
Output: 0 as it is invalid number

The algorithm is a check digit algorithm named after H. Michael Damm, who presented it in 2004.

The process is quite simple. We’ll use the quasi-group table provided in the afore-mentioned Wikipedia article:

0 3 1 7 5 9 8 6 4 2
7 0 9 2 1 5 4 8 6 3
4 2 0 6 8 7 1 3 5 9
1 7 5 0 9 8 3 4 2 6
6 1 2 3 0 4 5 9 7 8
3 6 7 4 2 0 9 5 8 1
5 8 6 9 7 2 0 1 3 4
8 9 4 5 3 6 2 0 1 7
9 4 3 8 6 1 7 2 0 5
2 5 8 1 4 3 6 7 9 0

Damm Algorithm in Raku

The process is simple. We start with a temporary value of 0. For each digit in the input number, we look up the table with the temporary variable and the digit, and set the temporary variable to the integer found in the table. At the end, the number is valid is the temporary variable is 0. For our test, we will use the two examples provided in the task specification, and we will test all numbers in the 5700..5800 range.

my @damm =  < 0 3 1 7 5 9 8 6 4 2 >,
            < 7 0 9 2 1 5 4 8 6 3 >,
            < 4 2 0 6 8 7 1 3 5 9 >,
            < 1 7 5 0 9 8 3 4 2 6 >,
            < 6 1 2 3 0 4 5 9 7 8 >,
            < 3 6 7 4 2 0 9 5 8 1 >,
            < 5 8 6 9 7 2 0 1 3 4 >,
            < 8 9 4 5 3 6 2 0 1 7 >,
            < 9 4 3 8 6 1 7 2 0 5 >,
            < 2 5 8 1 4 3 6 7 9 0 >;

sub is-valid ($n) {
    my $t = 0;
    $t = @damm[$t][$_] for $n.comb;
    return $t == 0;
}

for 5724, 5727 -> $test {
    say $test, is-valid($test) ?? " is valid." !! " is not valid.";
}
say "\nValid numbers between 5700 and 5800 are: ";
for 5700..5800 -> $i {
    print "$i " if is-valid $i;
}
say "";

This program displays the following output:

$ raku ./damm-algo.raku
5724 is valid.
5727 is not valid.

Valid numbers between 5700 and 5800 are:
5708 5719 5724 5735 5743 5756 5762 5770 5781 5797

Damm Algorithm in Perl

The algorithm for finding the check digit is the same as the one for testing whether a number is valid. So, rather than simply testing the validity directly as we did in Raku, we’ll write a find_check subroutine to find the check digit. Then, a number will be valid if its check digit is 0. Thus, we sort of get the two functions for the price of one. Besides that, the process is essentially the same as in Raku. Check the Raku section above is you need further explanations.

use strict;
use warnings;
use feature qw/say/;

my @damm =  (
[ < 0 3 1 7 5 9 8 6 4 2 > ],
[ < 7 0 9 2 1 5 4 8 6 3 > ],
[ < 4 2 0 6 8 7 1 3 5 9 > ],
[ < 1 7 5 0 9 8 3 4 2 6 > ],
[ < 6 1 2 3 0 4 5 9 7 8 > ],
[ < 3 6 7 4 2 0 9 5 8 1 > ],
[ < 5 8 6 9 7 2 0 1 3 4 > ],
[ < 8 9 4 5 3 6 2 0 1 7 > ],
[ < 9 4 3 8 6 1 7 2 0 5 > ],
[ < 2 5 8 1 4 3 6 7 9 0 > ] );

sub find_check {
    my $n = shift;
    my $t = 0;
    $t = $damm[$t][$_] for split //, $n;
    return $t;
}

sub is_valid {
    my $n = shift;
    return find_check($n) == 0;
}

for my $test (5724, 5727) {
    say $test, is_valid($test) ? " is valid." : " is not valid.";
}
say "\nValid numbers between 5700 and 5800 are: ";
for my $i (5700..5800) {
    print "$i " if is_valid $i;
}
say "";

This program displays the following output:

$ perl  ./damm-algo.pl
5724 is valid.
5727 is not valid.

Valid numbers between 5700 and 5800 are:
5708 5719 5724 5735 5743 5756 5762 5770 5781 5797

Task 2: Palindromic Prime Cyclops

Write a script to generate first 20 Palindromic Prime Cyclops Numbers.

A cyclops number is a number with an odd number of digits that has a zero in the center only.

Output

101, 16061, 31013, 35053, 38083, 73037, 74047, 91019, 94049,
1120211, 1150511, 1160611, 1180811, 1190911, 1250521, 1280821,
1360631, 1390931, 1490941, 1520251

Palindromic Prime Cyclops in Raku

In order to reduce the pointless computations, we’ll only test number ranges with an odd number of digits (100..999, 10000..99999, 1000000..9999999). As it turns out, the process is quite fast (about 2.6 seconds), so that performance enhancement wasn’t really required. I find it nonetheless better to avoid useless computations.

sub is-cyclops ($n) {
    my $length = $n.chars;
    return False if $length %% 2;
    my $mid = ($length - 1) /2;
    return False if substr($n, $mid, 1) != 0;
    return False if $n.comb[0..$mid-1] ~~ /0/;
    return False if $n.comb[$mid+1..$length-1] ~~ /0/;
    return True;
}

my $count = 0;
for |(100..999), |(10000..99999), |(1000000..9999999) -> $i {
    next unless $i eq $i.flip;
    next unless $i.is-prime;
    if is-cyclops $i {
        print "$i ";
        $count++;
        last if $count == 20;
    }
}
say "";

This program displays the following output:

$ time raku ./cyclops.raku
101 16061 31013 35053 38083 73037 74047 91019 94049 1120211 1150511 1160611 1180811 1190911 1250521 1280821 1360631 1390931 1490941 1520251

real    0m2,573s
user    0m0,015s
sys     0m0,015s

Palindromic Prime Cyclops in Perl

This is a port to Perl of the Raku program above. Since Perl doesn’t have a built-in is_prime subroutine, we roll out our own.

use strict;
use warnings;
use feature qw/say/;

sub is_cyclops {
    my $n = shift;
    my $len = length $n;
    return 0 if $len % 2 == 0;
    my $mid = ($len - 1) /2;
    return 0 if substr($n, $mid, 1) != 0;
    return 0 if (split //, $n)[0..$mid-1] =~ /0/;
    return 0 if (split //, $n)[$mid+1..$len-1] =~ /0/;
    return 1;
}

sub is_prime {
   my $n = shift;
   return 1 if $n == 2;
   return 0 if $n % 2 == 0;
   return 0 if $n == 1;
   my $p = 3;
   my $sqrt = sqrt $n;
   while ($p <= $sqrt) {
       return 0 if $n % $p == 0;
       $p += 2;
   }
   return 1;
}

my $count = 0;
for my $i (100..999, 10000..99999, 1000000..9999999) {
    next unless $i eq reverse $i;
    next unless is_cyclops $i;
    if (is_prime $i) {
        print "$i ";
        $count++;
        last if $count == 20;
    }
}

This program displays the following output:

$ perl ./cyclops.pl
101 16061 31013 35053 38083 73037 74047 91019 94049 1120211 1150511 1160611 1180811 1190911 1250521 1280821 1360631 1390931 1490941 1520251

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 August 21, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

Originally published on my blog.

In my team we run "masterclasses" every couple of weeks, where someone in the team presents a topic to the rest of the team.

This article is basically the content of the class on regular expressions (otherwise known as regex) I gave recently.

It's an introduction to the basics of regular expressions. There are many like it, but this is mine.

What is a regular expression (or regex)?

Wikipedia defines regular expressions as:

"a sequence of characters that define a search pattern"

They are available in basically every programming language, and you’ll probably most commonly encounter them used for string matches in conditionals that are too complicated for simple logical comparisons (like "or", "and", "in").

A couple of examples of regular expressions to get started:

| [ -~] | Any ASCII character
(ASCII characters fall between space and "~") |
| ^[a-z0-9_-]{3,15}$ | Usernames between 3 and 15 characters |

When to use regex

Use regular expressions with caution. The complexity of regex carries a cost.

Avoid coding in regex if you can

‘Some people, when confronted with a problem, think "I know, I'll use regular expressions." Now they have two problems.’ - Jamie Zawinski

In programming, only use regular expressions as a last resort. Don’t solve important problems with regex.

• regex is expensive - regex is often the most CPU-intensive part of a program. And a non-matching regex can be even more expensive to check than a matching one.
• regex is greedy - It’s extremely easy to match much more than intended, leading to bugs. We have multiple times had problems with regexes being too greedy, causing issues in our sites.
• regex is opaque - Even people who know regex well will take a while to pick apart a new regex string, and are still likely to make mistakes. This has a huge cost to project maintenance in the long run. (Check out this amazing regex for RFC822 email addresses)

Always try to be aware of all the language features at your disposal for operating on and checking strings, that could help you avoid regular expressions. In Python, for example, the in keyword, the powerful [] indexing, and string methods like contains and startswith (which can be fed either strings or tuples for multiple values) can be combined very effectively.

Most importantly, regexes should not be used for parsing strings. You should instead use or write a bespoke parser. For example, you can't parse HTML with regex (in Python, use BeautifulSoup; in JavaScript, use the DOM).

When to code in regex

Of course, there are times when regular expressions can or should be used in programs:

• When it already exist and you have to maintain it (although if you can remove it, you should)
• String validation, where there's no other option
• String manipulation (substitution), where there's no other option

If you are writing anything more than the most basic regex, any maintainers are unlikely to be able to understand your regex easily, so you might want to consider adding liberal comments. E.g. this in Python:

>>> pattern = """
^                   # beginning of string
M{0,4}              # thousands - 0 to 4 M's
(CM|CD|D?C{0,3})    # hundreds - 900 (CM), 400 (CD), 0-300 (0 to 3 C's),
                    #            or 500-800 (D, followed by 0 to 3 C's)
(XC|XL|L?X{0,3})    # tens - 90 (XC), 40 (XL), 0-30 (0 to 3 X's),
                    #        or 50-80 (L, followed by 0 to 3 X's)
(IX|IV|V?I{0,3})    # ones - 9 (IX), 4 (IV), 0-3 (0 to 3 I's),
                    #        or 5-8 (V, followed by 0 to 3 I's)
$                   # end of string
"""
>>> re.search(pattern, 'M', re.VERBOSE) 

Other great uses for regex

Regular expressions can be extremely powerful for quickly solving problems for yourself, where future maintenance is not a concern. E.g.:

• Grep (or Ripgrep), Sed, Less and other command line tools
• In editors (e.g. VSCode), for quickly reformatting text

It's also worth taking advantage of opportunities to use regex in these ways to practice your regex skills.

For example, I recently used the following regex substitution in VSCode to format a dump of text into a table format:

How to use regex

Bear in mind that regular expressions parsers come in a few varieties. Basically, every language implements its own parser. However, Perl’s regex parser is the gold standard. If you have a choice, use Perl Compatible Regular Expressions.

What regex looks like

The traditional way to write a regular expression is by surrounding it with slashes.

/^he[l]{2}o\wworld$/

This is how they're written in Perl and JavaScript, and in many command-line tools like Less.

Many more modern languages (e.g. Python), however, have opted not to include a native regex type, and so regular expressions are simply written as strings:

r"^he[l]{2}o\wworld$"

Common regex characters

| . | Matches any single character (except newlines, normally) |
| \ | Escape a special character (e.g. \. matches a literal dot) |
| ? | The preceding character may or may not be present (e.g. /hell?o/ would match hello or helo) |
| * | Any number of the preceding character is allowed (e.g. .* will match any single-line string, including an empty string, and gets used a lot) |
| + | One or more of the preceding character (.+ is the same as .* except that it won’t match an empty string) |
| | | "or", match the preceding section or the following section (e.g. hello|mad will match "hello" or "mad") |
| () | group a section together. This can be useful for conditionals ((a|b)), multipliers ((hello)+), or to create groups for substitutions (see below) |
| {} | Specify how many of the preceding character (e.g. a{12} matches 12 "a"s in a row) |
| [] | Match any character in this set. - defines ranges (e.g. [a-z] is any lowercase letter), ^ means "not" (e.g. [^,]+ match any number of non-commas in a row) |
| ^ | Beginning of line |
| $ | End of line |

Character shortcuts in regex

In most regex implementations, you can use backslash followed by a letter (\x) as a shortcut for a character set. Here’s a list of some common ones from rexegg.com's regex cheat sheet.

Regex in conditionals

The simplest use-case for regexes in programming is a string comparison. This looks different in different languages, e.g.:

// Perl
if ( "hello world" =~ /^he[l]{2}o\sworld$/ ) {..}

// JavaScript
if( /^he[l]{2}o\sworld$/.test("hello world") ) {..}

# Python
import re
if re.match(r"^he[l]{2}o\sworld$", "hello world"): ..

Regex in substitutions

You can also use regex to manipulate strings through substitution. In the following examples, "mad world" will be printed out:

// Perl
$hw = "hello world"; $hw =~ s/^(he[l]{2}o)\s(world)$/mad \2/; print($hw)

// JavaScript
console.log("hello world".replace(/^(he[l]{2}o)\s(world)$/, "mad $2"))

# Python
import re
print(re.replace(r"^(he[l]{2}o)\s(world)$", r"mad \2", "hello world"))

Regex modifiers

You can alter how regular expressions behave based on a few modifiers. I’m just going to illustrate one here, which is the modifier to make regex case insensitive. In Perl, JavaScript and other more traditional regex contexts, the modifiers are added after the last /. More modern languages often user constants instead:

// Perl
if ( "HeLlO wOrLd" =~ /^he[l]{2}o\sworld$/i ) {..}

// JavaScript
if( /^he[l]{2}o\sworld$/i.test("HeLlO wOrLd") ) {..}

# Python
import re
if re.match(r"^he[l]{2}o\sworld$", "HeLlO wOrLd", flags=re.IGNORECASE): ..

Lookahead and lookbehind in regex

These are only supported in some implementations of regular expressions, and give you the opportunity to match strings that precede or follow other strings, but without including the prefix or suffix in the match itself:

(Again, taken from rexegg.com's regex cheat sheet)

Regex resources

That is all I have for now. If you want to learn more, there’s are a lot of useful resources out there:

• Rexegg.com - Many great articles on most aspects of regex
• Regex101 - A tester for your regex, offering a few different implementations
• iHateRegex - A collection of example regex patterns for matching some common types of strings (e.g. phone number, email address)
• The official Perl Compatible Regular Expressions documentation

Hi there,

Personally I have noticed the fresh energy among all Perl fans ever since the release of latest Perl v5.36. I am telling this based on the amount of positive noise I heard on various public platform. There are still few in the pipeline that would give further push e.g. Corinna. If you are interested to know more then please do checkout this page maintained by Curtis Poe.

MetaCPAN is another place where you can see all the latest cool Perl projects. I know plenty of volunteers helping to improve the code base. If you use a distribution and you like it then why not share your experience with the Perl Community and submit your proposal to Perl Advent Calendar 2022? Or if you have created one then why not share with rest of the world.

If you are new to Perl and needs help then please do give us a shout. There are plenty of help available on various public platforms.

Enjoy the rest of the newsletter.

Part of the Dancer2 video course available both to Pro subscribers and attendees of the Perl Dancer course on Leanpub.

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

Write a script to find the smallest integer x such that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each other.

Solution

use strict;
use warnings;
use boolean;

sub is_permuted{
    my($x, $y) = @_;
    my(@x, @y); 
    map {$x[$_]++} split(//, $x);
    map {$y[$_]++} split(//, $y);
    return false if $#x != $#y;
    my @matched = grep {(!$x[$_] && !$y[$_]) || ($x[$_] && $y[$_] && $x[$_] == $y[$_])} 0 .. @y - 1;
    return true if @matched == @x;
    return false;
}

sub smallest_permuted{
    my $x = 0;
    {
        $x++;
        redo unless is_permuted($x, 2 * $x)     && is_permuted(2 * $x, 3 * $x) && 
                    is_permuted(3 * $x, 4 * $x) && is_permuted(4 * $x, 5 * $x) && 
                    is_permuted(5 * $x, 6 * $x);
    }
    return $x;
}

MAIN:{
    print smallest_permuted . "\n";
}

Sample Run

$ perl perl/ch-1.pl
142857

Notes

The approach here is to check if any two numbers are permutations of each other by counting up the digits for each and comparing the counts. A fun use of map and grep but I will admit it is a bit unnecessary. I implemented solutions to this problem in multiple languages and in doing so just sorted the lists of digits and compared them. Much easier, but less fun!

Part 2

Write a script to find out all Reversible Numbers below 100.

Solution

use strict;
use warnings;
sub is_reversible{
    my($x) = @_;
    my @even_digits = grep { $_ % 2 == 0 } split(//, ($x + reverse($x)));
    return @even_digits == 0;
}

sub reversibles_under_n{
    my($n) = @_;
    my @reversibles;
    do{
        $n--;
        unshift @reversibles, $n if is_reversible($n);

    }while($n > 0);
    return @reversibles;
}

MAIN:{
    print join(", ", reversibles_under_n(100)) . "\n";
}

Sample Run

$ perl perl/ch-2.pl
10, 12, 14, 16, 18, 21, 23, 25, 27, 30, 32, 34, 36, 41, 43, 45, 50, 52, 54, 61, 63, 70, 72, 81, 90

Notes

My favorite use of Perl is to prototype algorithms. I'll get an idea for how to solve a problem and then quickly prove out the idea in Perl. Once demonstrated to be effective the same approach can be implemented in another language if required, usually for business reasons but also sometimes simply for performance.

The code here is concise, easy to read, and works well. It's also 3 times slower than a Fortran equivalent.

$ time perl perl/ch-2.pl
10, 12, 14, 16, 18, 21, 23, 25, 27, 30, 32, 34, 36, 41, 43, 45, 50, 52, 54, 61, 63, 70, 72, 81, 90

real    0m0.069s
user    0m0.048s
sys     0m0.020s
-bash-5.0$ time fortran/ch-2     
          10
          12
          14
          16
          18
          21
          23
          25
          27
          30
          32
          34
          36
          41
          43
          45
          50
          52
          54
          61
          63
          70
          72
          81
          90

real    0m0.021s
user    0m0.001s
sys     0m0.016s

That said, the Fortran took at least 3x longer to write. These are the tradeoffs that get considered on a daily basis!

References

Challenge 176

Weekly Challenge 176

Challenge, My solutions

Task 1: Permuted Multiples

Task

Write a script to find the smallest positive integer x such that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each other.

My solution

This is one challenge where we could over-engineer it to make it faster. Given that the solution can be found in a fraction of a second, this won't be necessary.

For example after 1,666, the next possible solution is 100,000. 1667 × 6 will result in a five digit number which can't possibly be a permutation of the original number.

The easiest way to work out if a number is a permutation is simply to sort the numbers numerically. In Python, we can do this by ''.join(sorted(str(num))). While join '', sort split //, $num will do a similar thing in Perl.

Like a lot of the challenges, I have a counter that starts at one, and increments until we have a solution. For each number, we figure out if the number multiplied 2 to 6 are a permutation of the original number, and exit the inner loop if it isn't.

Finally when I do find a solution, I print it out, and exit the main() function.

Did you know? The solution (142,857) has its own Wikipedia page.

Examples

$ ./ch-1.py 
142857

$ ./ch-1.pl
142857

Task 2: Reversible Numbers

Task

Write a script to find out all Reversible Numbers below 100. A number is said to be a reversible if sum of the number and its reverse had only odd digits.

My solution

This is relatively straight forward challenge. Count from 1 to 99, and add to a solutions list if the number is a reversible number.

As python doesn't have an easy way to reverse an integer, I convert it to a string and back to an integer with int(str(num)[::-1]). In Perl, this simply done with the reverse method. To see if the number is odd, I compare it with the regular expression ^[13579]+$.

I then print all the numbers in a solutions list.

Examples

$ ./ch-2.py 
10, 12, 14, 16, 18, 21, 23, 25, 27, 30, 32, 34, 36, 41, 43, 45, 50, 52, 54, 61, 63, 70, 72, 81, 90

$ ./ch-2.pl 
10, 12, 14, 16, 18, 21, 23, 25, 27, 30, 32, 34, 36, 41, 43, 45, 50, 52, 54, 61, 63, 70, 72, 81, 90

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

Spoiler Alert: This weekly challenge deadline is due in a few of days from now (on Aug. 7, 2022 at 23:59). 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: Permuted Multiples

Write a script to find the smallest positive integer x such that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each other.

For example, the integers 125874 and 251748 are permuted multiples of each other as

251784 = 2 x 125874

and also both have the same digits but in different order.

Output

142857

In Raku, Perl, and some other programming languages, conversions between numbers and strings are simple or even implicit and automatic. This task will be very easy for them. In some other languages, the strong typing system might make it more difficult. In such an event, we may also use a purely arithmetic method to retrieve the individual digits (see for example the C and bc implementations). This may have an impact on my choice of guest languages: I will not try guest languages that are crippled by a type system straitjacket.

Permuted Multiples in Raku

We’re essentially trying to find if the first six integer multiples of an integer are anagrams of each other. One way to go might be to store the individual digits in a hash and check whether we have the same digits. But it’s not so easy when the input number has twice or several times the same digit. It is usually easier (and probably faster) to reduce the input number to a normalized form (for example with the digits rearranged in ascending order) and to compare the normalized form of the input number with the normalized forms of the multiples. In the program below, the ordered variable is a string in which the digits of the input integer have been rearranged in ascending order. At the end, we only need a string comparison to find out whether the various integers have the same digits.

sub check_multiples ($j) {
    my $ordered = join '', $j.comb.sort;
    for 2..6 -> $k {
        return False if ($k * $j).comb.sort.join ne $ordered;
    }
    return True;
}

.say and last if check_multiples $_ for 1..Inf;

This program displays the following output:

$ time raku ./permuted-multiples.raku
142857

real    0m3,370s
user    0m0,015s
sys     0m0,088s

We can significantly improve performance by adding one code line at the beginning of the check_multiples subroutine:

sub check_multiples ($j) {
    return False if $j.chars != (6 * $j).chars; 
    my $ordered = join '', $j.comb.sort;
    for 2..6 -> $k {
        return False if ($k * $j).comb.sort.join ne $ordered;
    }
    return True;
}

By returning early from the subroutine when the length of 6 * $j is more than the length of $j we save quite a bit of useless computations. The execution time goes down to 1.390 sec. Another possibility would be to reverse the tests in the for loop, i.e. to go down from 6 to 2.

Permuted Multiples in Perl

This is a port to Perl of the Raku program above. Please refer to the description in the Raku section above in you need explanations.

use strict;
use warnings;
use feature qw/say/;

sub check_multiples {
    my $j = shift;
    my $ordered = join '', sort split //, $j;
    for my $k (2..6) {
        return 0 if $ordered ne join '', sort {$a cmp $b}  split //, ($k * $j);
    }
    return 1;
}

my $i = 1;
while (1) {
    if (check_multiples $i) {
        say $i;
        last;
    }
    $i++;
}

This program displays the following output:

$ time perl  permuted-multiples.pl
142857

real    0m0,604s
user    0m0,546s
sys     0m0,046s

The Perl code is a bit longer than the Raku code, but the Perl program runs 5,6 times faster.

Permuted Multiples in Julia

In Julia, the built-in digits function returns the digits of a number. No need for conversions between integer and string and the other way around, and this leads to a quite concise program.

function check_multiples(n)
    ordered = sort(digits(n))
    for j in 2:6
        if sort(digits(n * j)) != ordered
            return false
        end
    end
    return true
end

i = 1
while true
    if check_multiples(i)
        println(i)
        break
    end
    global i += 1
end

Output:

$ julia .\permuted-multiples.jl
142857

Permuted Multiples in Python

def check_multiples(n):
  input = [int(c) for c in str(n)]
  input.sort()
  for i in range(2, 7):
    test = [int(c) for c in str(n * i)]
    test.sort()
    if input != test:
      return False
  return True


i = 2
while True:
  if check_multiples(i):
    print(i)
    break
  i += 1

Output:

$ time python3 ./permuted-multiples.py
142857

real  0m0,745s
user  0m0,640s
sys   0m0,077s

Permuted Multiples in awk

The awk language is relatively slow, so I added a test:

        if (length(test) != len) {
           return 0
        }

before the inner for loop to immediately go out of the loop and avoid the digit-by-digit comparison if the length of tested number is not the same as the length of the input number.

function check_multiples(n) {
    split(n, ordered, "")
    asort(ordered)
    len = length(ordered)
    for (j = 2; j <= 6; j++) {
        split(n * j, test, "")
        asort(test)
        if (length(test) != len) {
           return 0
        }
        for (k = 1; k <= len; k++) {
            if (ordered[k] != test[k]) {
                return 0
            }
        }
    }
    return 1
} 

BEGIN  {
    i = 1
    while (1) {
        if (check_multiples(i)) {
            print i
            break
        }
    i++
    }
}

With the performance improvement described above, the runtime is quite good:

$ time awk -f permuted-multiples.awk
142857

real    0m1,498s
user    0m1,343s
sys     0m0,015s

However, we can improve it by making the test earlier in the check_multiples function:

function check_multiples(n) {
    if (length(n) != length(6 * n)) {
        return 0
    }
    split(n, ordered, "")
    asort(ordered)
    len = length(ordered)
    for (j = 2; j <= 6; j++) {
        split(n * j, test, "")
        asort(test)
        for (k = 1; k <= len; k++) {
            if (ordered[k] != test[k]) {
                return 0
            }
        }
    }
    return 1
}

With this change, the output is now this:

$ time awk -f permuted-multiples.awk
142857

real    0m0,653s
user    0m0,624s
sys     0m0,031s

That’s 2.3 times faster. Not bad.

Permuted Multiples in C

The C implementation is quite verbose (and sort of a pain in the neck to get it right) compared to other languages, but I decided not to criticize this aspect any further when I saw the performance (barely more than 1/10 sec. runtime):

#include <stdio.h>
#include <stdlib.h>
#include <math.h>

int comp (const void * elem1, const void * elem2) {
    int f = *((int*)elem1);
    int s = *((int*)elem2);
    if (f > s) return  1;
    if (f < s) return -1;
    return 0;
}

int normalize (int num) {
    int n = num;
    int len = n <= 9 ? 1 : floor(log10(n)) + 1;
    int d[len];  // array of digits of input number
    char st[len];
    int i = 0;
    while (n > 0) {
        d[i] = n % 10;
        n /= 10;
        i++;
    }
    qsort (d, sizeof(d)/sizeof(*d), sizeof(*d), comp);
    int norm = 0;
    int j = 1;
    for (int i = len - 1; i >= 0; i--) {
        norm += d[i] * j;
        j *= 10;
    }
    return norm;
}

int permuted_multiples (int n) {
    int norm_in = normalize(n);
    for (int i = 6; i > 2; i--) 
        if (normalize(n * i) != norm_in) return 0;
    return 1;
}

int main () {
    int i = 1;
    while (1) {
        if (permuted_multiples(i)) {
            printf("%d\n", i);
            break;
        }
        i++;
    }
}

Output:

$ time ./a.out
142857

real    0m0,112s
user    0m0,078s
sys     0m0,000s

Permuted Multiples in D

D is similar to C, but with less pointer hassle and more built-in functions, making the syntax simpler:

import std.stdio;
import std.conv, std.array;
import std.algorithm;

int normalize(int num) {
    string n = to!string(num, 10);
    ulong len = n.length;
    string[] d = n.split("");
    d.sort();
    return to!int(d.joiner);
}

bool permuted_multiples (int n) {
    int norm_in = normalize(n);
    for (int i = 6; i > 2; i--) 
        if (normalize(n * i) != norm_in) return false;
    return true;
}

void main() {
    int i = 1;
    while (true) {
        if (permuted_multiples(i)) {
            printf("%d\n", i);
            break;
        }
        i++;
    }
    writeln(" ");
}

This program also displays 142857 and runs in .44 second (don’t compare with C, though, the timings are not equivalent for various reasons).

Task 2: Reversible Numbers

Write a script to find out all Reversible Numbers below 100.

A number is said to be a reversible if sum of the number and its reverse had only odd digits.

For example,

36 is reversible number as 36 + 63 = 99 i.e. all digits are odd.
17 is not reversible as 17 + 71 = 88, none of the digits are odd.

Output:

10, 12, 14, 16, 18, 21, 23, 25, 27,
30, 32, 34, 36, 41, 43, 45, 50, 52,
54, 61, 63, 70, 72, 81, 90

Reversible Numbers in Raku

I first thought about using junctions to check whether all of the digits of the resulting number are odd (or, alternatively, whether any of the digits is even), but it rapidly occurred to me that a regex character class with all even digits is sort of equivalent to a junction with even digits, and that a regex solution would be much simpler (and, by the way, that the same solution could also be used in Perl (and possibly some other languages).

This leads to the following very simple code:

print "$_ " unless $_ + .flip ~~ /<[02468]>/ for 1..100;

Used as a Raku one-liner, we obtain the following output:

$ raku -e 'print "$_ " unless $_ + .flip ~~ /<[02468]>/ for 1..100;'
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Perl

The Perl solution also uses a regex and an even-digit character class to do the job:

for (1..100) {print "$_ " unless ($_ + reverse $_) =~ /[02468]/}

Used as a Perl one-liner, we obtain the following output:

$ perl -e 'for (1..100) {print "$_ " unless ($_ + reverse $_) =~ /[02468]/}'
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Julia

Julia uses the Perl Compatible Regular Expressions (PCRE) library to handle regexes. The occursin function returns a Boolean value telling us whether the regex pattern was found. This is almost as easy as in Raku and Perl

for i in 1:100
    sum = i + parse(Int32, reverse(string(i)))
    if ! occursin(r"[02468]", string(sum))
        print("$i ")
    end
end
println(" ")

Output:

$ julia .\reversible.jl
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in C

The C language doesn’t have a standard string reverse function (although some implementations have it). So, we have to write one. Otherwise, we convert the integer sum to a string (using the sprintf function) and loop through the digits to check whether any of them is even, and return a false value (0) if such is the case.

int reverse(int n) {
    char st[10];
    char r[10];
    int len = sprintf(st, "%d", n);   // convert input int to string
    for (int i = 0; i < len; i++) {
        r[len - i - 1] = st[i];
    }
    r[len] = '\0';
    return atoi(r);
}

int is_reversible(int n) {
    char sum[10];
    int length =  sprintf(sum, "%d", n + reverse(n));
    for (int k = 0; k < length; k++) {
        if (sum[k] % 2 == 0) {
            return 0;
        }
    }
    return 1;
}

int main () {
    for (int i = 1; i < 100; i++) {
        if (is_reversible(i)) {
            printf("%d ", i);
        }
    }
    printf("%s\n", "");
}

Output:

$ ./a.out
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

C compared to Perl or Raku

If you compare this 35-line C solution with the Raku or Perl one-liners shown above, you’ll probably understand why Raku and Perl are my favorite programming languages. Having said that, I should add that C, which was created in the early 1970s and is still very much in use half a century later, is sort of the mother of all languages (even the Perl interpreter is written mostly in C). And, as seen above in the context of the first task of this challenge, C is very fast.

For those of you old enough to remember the Usenet newsgroups, let me share this pearl of wisdom dating from the late 1990s.

A Tribute to the Beatles “Let It Be” (and to Dennis M. Ritchie).

To the tune of “Let It Be”.

To listen to it, go there.

When I find my code in tons of trouble, Friends and colleagues come to me, Speaking words of wisdom: Write in C.

As the deadline fast approaches, And bugs are all that I can see, Somewhere, someone whispers: Write in C.

Write in C, write in C, Write in C, oh, write in C. LOGO’s dead and buried, Write in C.

Reversible Numbers in D

The D programming language boasts to combine the performance and safety of compiled languages (such as C or C++) with the expressive power of modern dynamic and functional programming languages. The syntax is relatively close to C, but the program is notably shorter than its C counterpart. Here, we have methods to reverse a string (retro) and to easily convert integers to strings or strings to integers. As with our C implementation, we loop through the digits to check whether any of them is even, and return false if such is the case.

import std.stdio;
import std.conv, std.range;

bool is_reversible(int n) {
    string s = to!string(n, 10);
    string rev = s.retro.text;
    string sum = to!string(n + to!int(rev), 10);
    for (int k = 0; k < sum.length; k++) {
        if (sum[k] % 2 == 0) {
            return false;
        }
    }
    return true;
}

void main() {
    for (int i = 1; i < 100; i++) {
        if (is_reversible(i)) {
            printf("%d ", i);
        }
    }
    writeln(" ");
}

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in bc

bc stands for “basic calculator” and was initially written almost half a century ago. As a (programmable) calculator, bc can run mathematical or arithmetic scripts, but it has no string manipulation features. So we use only arithmetical tools here.

define reverse (n) {
    sum = 0
    j = 10 ^ (length(n) - 1)
    while (n > 0) {
        sum += (n % 10) * j
        n = n/10
        j /= 10
    }
    return (sum )
}

define is_reversible(m) {
    sum = m + reverse(m)
    while (sum > 0) {
        k = sum % 10
        if (k % 2 == 0) { 
            return 0 
        }
        sum /= 10
    }
    return 1
}

for (i = 1; i <= 100; i++) {
    # print i, " "
    if (is_reversible(i)) {
        print i, " "
    }
}
quit

Output:

$ bc -q reversible.bc
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72\
81 90

Reversible Numbers in awk

Compared to bc, awk has some limited string manipulation features (such as substr) that we put to good use here. awk also has some regex capabilities, but they’re associated with standard input (e.g. files) reading and did not seem to be usable in our context. So, our program is essentially based on arithmetic loops.

function is_reversible(n) {
    len = length(n)
    m = ""
    for (j = len; j != 0; j--) {
        m = m substr(n, j, 1)
    }
    sum = m + n
    len = length(sum)
    for (k = 1; k <= len; k++) {
        if ((substr(sum, k, 1) % 2) == 0) {
            return 0
        }
    }
    return 1
}

BEGIN {
    for (i = 1; i <= 200; i++) {
        if (is_reversible(i)) {
            printf("%d ", i)
        }
    }
}

Output:

$ awk -f ./reversible.awk
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Python

In Python, we use the features provided by the re regex library, leading to a fairly concise program.

from re import search
pattern = r"[02468]"
for i in range(1, 100):
    tested = str(i + int(str(i)[::-1]))
    if not search(pattern, tested):
        print(i, end=' ')

Output:

$ python3 ./reversible.py
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Ruby

I really like Ruby’s ability to chain method invocations as in sum = n + n.to_s.reverse.to_i, which makes it possible to convert an integer to a string, to revert the string, to convert the resulting string back to an integer and finally finally to add it to another number, all in one short code line. We’ve done similar chained data conversions in Perl, Raku and Julia, but there is a number of mainstream programming languages which can’t do that (mostly because their built-in methods or functions often have side effects and are intrinsically not pure.

def is_reversible(n)
    sum = n + n.to_s.reverse.to_i
    while (sum > 0) 
        k = sum % 10
        if k % 2 == 0 
          return false 
        end
        sum /= 10
    end
    return true
end

for i in 1..100
    if is_reversible(i)
        printf("%d ", i)
    end
end
puts("")

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Scala

Scala also provides the pleasant possibility to chain method invocations (as in var sum = n + n.toString.reverse.toInt). So, our Scala program looks quite similar to our Ruby implementation.

object reversible extends App {
  def is_reversible(n: Int): Boolean = {
    var sum = n + n.toString.reverse.toInt
    while (sum > 0) {
      val k = sum % 10
      if (k % 2 == 0) {
        return false
      }
      sum /= 10
    }
    return true
  }

  for (i <- 1 to 100) {
    if (is_reversible(i)) {
      printf("%d ", i)
    }
  }
  println("")
}

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Ring

for i = 1 to 100
    if is_reversible(i)
        see "" + i + " "
    ok
next

func reverse(num)
    n = "" + num
    rev = ""
    for i = len(n) to 1 step -1
        rev +=  n[i]
    next
    return number(rev)

func is_reversible (m)
    sum = m + reverse(m)
    st = "" + sum
    for i = 1 to (len(st))
        if st[i] % 2 = 0
            return false
        ok
    next
    return true

Output:

$ ring ./reversible.ring
10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in JavaScript

function is_reversible (n) {
    var digits = n.toString().split("")
    let reverse_digits = digits.reverse()
    let reverse_n = parseInt(reverse_digits.join(""));
    var sum = n + reverse_n
    while (sum > 0) {
        let k = sum % 10
        if (k % 2 == 0) { 
          return false 
        }
        sum = Math.floor(sum / 10)
    }
    return true    
}

for (var i = 1; i <= 100; i++) {
    if (is_reversible(i)) {
        process.stdout.write(i + " ")
    } 
}
process.stdout.write(" \n")

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Nim

I tried to use the split function with an empty string as a delimiter, but Nim’s split function apparently does not accept an empty string. Looking for a solution on the Internet, I found on this Stack Overflow page that a Nim string is a sequence of chars, so that a simple cast (e.g. @(intToStr(n)) will split the string into individual chars.

import strutils
import algorithm 

proc is_reversible(n: int): bool =
  # A Nim string is a sequence of chars, so that a cast will 
  # split the string into individual chars
  let rev = parseInt(join(@(intToStr(n)).reversed(), ""))
  var sum = n + rev
  while sum > 0:
    let k = sum mod 10
    if (k mod 2 == 0):
      return false
    sum = (sum / 10).int
  return true    


for i in 1..100:
  if is_reversible(i):
    stdout.write i, " "
echo ""

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Dart

import "dart:io";

void main() {
    for (int i = 0; i <= 100; i++ ) {
        if (is_reversible(i)) {
            stdout.write("$i ");
        }
    }
}

bool is_reversible(n) {
    var rev = int.parse(n.toString().split("").reversed.join(""));
    var digits = (n + rev).toString().split("");
    int len = digits.length;
    for (int i = 0; i < len; i++) {
        if (int.parse(digits[i]) % 2 == 0) {
            return false;
        }
    }
    return true;
}

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Kotlin

fun is_reversible(n: Int): Boolean {
    val sum = n + n.toString().reversed().toInt()
    val sumstr = sum.toString()
    for (i in 1..sumstr.length) {
        if (sumstr[i-1].toInt() % 2 == 0) {
            return false
        }
    }
    return true
}

fun main() {
    for (i in 1..100) {
        if (is_reversible(i)) {
            print("$i ")
        }
    }
    println(" ")
}

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Java

My Java implementation of the reversible numbers task is faithful to Java’s reputation of being very verbose.

public class ReversibleNumbers {

    public static int reverse(int n) {
        String n_str = String.valueOf(n);
        String rev = "";
        char ch;
        for (int i = 0; i < n_str.length(); i++) {
            ch = n_str.charAt(i);   //extracts each character
            rev = ch + rev;         //adds each character in front of the existing string
        }
        return Integer.parseInt(rev);
    }

    public static boolean isReversible(int n) {
        int sum = n + reverse(n);
        char[] digits = String.valueOf(sum).toCharArray();
        for (int i = 0; i < digits.length; i++) {
            if ((digits[i] - '0') % 2 == 0) {
                return false;
            }
        }
        return true;
    }

    public static void main(String[] args) {
        for (int i = 1; i <= 100; i++) {
            if (isReversible(i)) {
                System.out.printf("%d ", i);
            }
        }
        System.out.printf("%s", "\n");
    }
}

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Lua

local function is_reversible(n)
    rev = tonumber(string.reverse(tostring(n)))
    sum = rev + n
    while sum > 0 do
        if sum % 2 == 0 then
            return false
        end
        sum = math.floor(sum / 10)
    end
    return true
end

for i = 1, 100 do
    if is_reversible(i) then
        io.write(i, " ")
    end
end
print("")

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

Reversible Numbers in Go

For some reason, programming languages maintained by groups of dedicated open-source users, such as Raku, Perl, Julia, Nim, JavaScript, Scala, Kotlin, and Lua, have an off-the-shelf reverse function or method, whereas programming languages maintained by very big corporations, such as Java or Go, don’t have it, in spite of their huge financial resources. It appears that the open-source model is more efficient. IT managers should think about it: the best programming languages might not be what they think.

package main

import (
    "fmt"
    "strconv"
)

func reverse(n int) int {
    n_str := strconv.Itoa(n)
    rev := ""
    for _, v := range n_str {
        rev = string(v) + rev
    }
    rev_num, _ := strconv.Atoi(rev)
    return rev_num
}

func is_reversible(n int) bool {
    sum := n + reverse(n)
    sum_str := strconv.Itoa(sum)
    for i := 0; i < len(sum_str); i++ {
        if sum_str[i] % 2 == 0 {
            return false
        }
    }
    return true
}

func main() {
    for i := 1; i <= 100; i++ {
        if is_reversible(i) {
            fmt.Printf("%d ", i)
        }
    }
    fmt.Println("")
}

Output:

10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90

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 August 14, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

1. Alien::Build - Build external dependencies for use in CPAN
   • Version: 2.51 on 2022-08-03
   • Votes: 22
   • Previous version: 2.51 was before
2. App::Netdisco - An open source web-based network management tool.
   • Version: 2.053005 on 2022-08-04
   • Votes: 14
   • Previous version: 2.052010 was 8 days before
3. App::perlbrew - Manage perl installations in your $HOME
   • Version: 0.96 on 2022-07-31
   • Votes: 170
   • Previous version: 0.95 was 2 months, 16 days before
4. Catalyst::View::TT - Template View Class
   • Version: 0.46 on 2022-08-03
   • Votes: 16
   • Previous version: 0.45 was 2 years, 12 days before
5. Encode - character encodings in Perl
   • Version: 3.19 on 2022-08-04
   • Votes: 57
   • Previous version: 3.18 was 1 month, 9 days before
6. JSON - JSON (JavaScript Object Notation) encoder/decoder
   • Version: 4.09 on 2022-08-01
   • Votes: 97
   • Previous version: 4.07 was 1 month, 7 days before
7. JSON::PP - JSON::XS compatible pure-Perl module.
   • Version: 4.11 on 2022-07-31
   • Votes: 16
   • Previous version: 4.10 was 1 month, 7 days before
8. Memoize - Make functions faster by trading space for time
   • Version: 1.09 on 2022-08-01
   • Votes: 24
   • Previous version: 1.03 was 10 years, 3 months, 9 days before
9. Net::SSH2 - Support for the SSH 2 protocol via libssh2.
   • Version: 0.73 on 2022-08-03
   • Votes: 23
   • Previous version: 0.72 was 1 year, 7 months, 12 days before
10. Pithub - Github v3 API
    • Version: 0.01038 on 2022-08-03
    • Votes: 19
    • Previous version: 0.01037 was 14 days before
11. PPR - Pattern-based Perl Recognizer
    • Version: 0.001002 on 2022-08-03
    • Votes: 17
    • Previous version: 0.000028 was 2 years, 1 month, 5 days before
12. SPVM - SPVM Language
    • Version: 0.9635 on 2022-08-04
    • Votes: 26
    • Previous version: 0.9630 was 6 days before
13. Type::Tiny - tiny, yet Moo(se)-compatible type constraint
    • Version: 1.016007 on 2022-08-04
    • Votes: 131
    • Previous version: 1.016006 was 10 days before
14. XML::Compile::SOAP - SOAP version 1.1
    • Version: 3.28 on 2022-08-01
    • Votes: 13
    • Previous version: 3.27 was 1 year, 3 months, 24 days before

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

Week's winner: Algorithm::Line::Bresenham (+2)

Build date: 2022/08/06 21:12:25 GMT

Clicked for first time:

• Apache::ConfigParser - Load Apache configuration files
• App::PFT - Hacker friendly static blog generator
• Dist::Zilla::Plugin::SyncCPANfile - Sync a cpanfile with the prereqs listed in dist.ini
• Excel::ValueWriter::XLSX - generating data-only Excel workbooks in XLSX format, fast
• Search::Fzf - Ported Fzf using perl.
• Test2::Tools::HTTP::UA::Mojo - Mojo user agent wrapper for Test2::Tools::HTTP

Increasing its reputation:

• Algorithm::Line::Bresenham (+2=2)
• App::perlbrew (+1=170)
• B::Hooks::AtRuntime (+1=5)
• Devel::NYTProf (+1=178)
• Devel::ptkdb (+1=8)
• Devel::StrictMode (+1=7)
• Excel::Writer::XLSX (+1=57)
• Feature::Compat::Try (+1=11)
• Form::Diva (+1=4)
• Math::AnyNum (+1=6)
• Mojolicious (+1=472)
• Net::Google::Spreadsheets (+1=3)
• Net::SFTP::Foreign (+1=23)
• PadWalker (+1=24)
• PAR::Packer (+1=40)
• PDF::Reuse (+1=9)
• Promise::Me (+1=2)
• Search::Elasticsearch (+1=44)
• Storable::Improved (+1=3)
• Sub::HandlesVia (+1=8)
• Sub::Quote (+1=8)
• Sys::Binmode (+1=5)
• Text::Markdown::Hoedown (+1=13)
• Time::HiRes (+1=59)
• Variable::Magic (+1=24)

These are the five most rated questions at Stack Overflow last week.
Between brackets: [question score / answers count]
Build date: 2022-08-06 21:10:40 GMT

1. Perl: speed of s/// with variable in replacement - [7/2]
2. Perl regex capture groups and nth occurence - [3/4]
3. How can I pass prove (Test::More) an argument, e.g. an API URL? - [2/2]
4. Perl regex combining capture groups & nth string - [2/2]
5. Linux grep command in Perl script now working - [2/2]

Sometimes I want to filter a set of strings, but the details of the filter are not known beforehand. In particular, I may want a null filter, which simply accepts anything.

This looks like a job for a regular expression, but I can think of at least two implementations. One is to pass around regular expression objects. The second is to wrap a match (m//) in a subroutine reference, and pass that around. Given the use of regular expressions, there are a number of possibilities for a regular expression that matches any string.

I wondered whether one of the alternatives I was choosing among was faster than another, so I decided to Benchmark them. Both implementations applied the regular expression to a global variable. In practice this would probably be a localized $_, but my read of the Benchmark module says that it also localizes $_, but leaves it undef.

Note that the empty pattern is not benchmarked, because it is equivalent to the last successfully-matched pattern, if any. The sub { 1 } was included because if we're dealing in code references, the null filter simply needs to return a true value.

Here are the results, obtained with Perl 5.36.0, unthreaded. The script that generated them is on GitHub

Somewhat to my surprise, the subroutine-reference implementation was an order of magnitude faster than the regular-expression-reference implementation. I expected that, Regexps being first-class objects, it would be pretty much equivalent to m/ ... / wrapped in a subroutine -- maybe even a little faster.

A little messing around with perl -MO=Concise got me the following:

$ perl -MO=Concise -e '$_ =~ m/foo/;'
5  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter v ->2
2     <;> nextstate(main 1 -e:1) v:{ ->3
4     </> match(/"foo"/) vKS ->5
-        <1> ex-rv2sv sK/1 ->4
3           <$> gvsv(*_) s ->4
-e syntax OK
$ perl -MO=Concise -e '$_ =~ qr/foo/;'
7  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter v ->2
2     <;> nextstate(main 1 -e:1) v:{ ->3
6     </> match() vKS ->7
-        <1> ex-rv2sv sK/1 ->4
3           <$> gvsv(*_) s ->4
5        <|> regcomp(other->6) sK ->6
4           </> qr(/"foo"/) s ->5
-e syntax OK

The salient difference, to my eye, was the presence of the regcomp operator in the second case. perldoc-search on this led me eventually to perlreapi which says, in part,

"precomp" "prelen"

Used for optimisations. "precomp" holds a copy of the pattern that was compiled and "prelen" its length. When a new pattern is to be compiled (such as inside a loop) the internal "regcomp" operator checks if the last compiled "REGEXP"'s "precomp" and "prelen" are equivalent to the new one, and if so uses the old pattern instead of compiling a new one.

The relevant snippet from "Perl_pp_regcomp":

            if (!re || !re->precomp || re->prelen != (I32)len ||

                memNE(re->precomp, t, len))

            /* Compile a new pattern */

	

So I assume that the speed difference might be reduced if the filter was called in a tight enough loop. But if so, the Benchmark loop is not tight enough, and it's pretty tight. On the other hand, maybe the Benchmark loop is tight enough, and the extra time is spent determining that a recompilation is not needed. But it will take deeper knowledge of Perl internals than I possess to sort this out.

Scripts and output for coloring page book pages based on digital elevation data

Introduction
Adult coloring books are all the rage. Most are hand-drawn, and subjects are wide-ranging. I happen to love maps and landscape data, so I created an automated method to convert digital elevation models (or any greyscale image, for that matter) into a color-able coloring book image.

View the web site here.

before after

Usage
Before using the included Perl script, you'll need to make sure that the NetPBM and TurboJPEG packages are installed and in the user's path. You can do this on an RPM system with:

sudo yum install libjpeg-turbo-utils netpbm-progs
The script operates on whole directories. Every image in the indir (below) will be converted and an output image file and thumbnail will be created in the outdir (which will be created if it does not already exist). Run the script like so:

makeOutlineImage.pl indir outdir

Code that performs side effects is difficult to test because we need figure out how to sandbox the effects so we can observe the state of the sandbox before and after executing the effectful code. The difficulty is increased when the side effectful code also depends on specific OS configurations. Let us explore my solution to such a predicament.

I have been working on the next major release of my btrfs snapshot manager yabsm and I want to write unit tests for functions that take and delete btrfs snapshots. This code performs the side effect of taking and deleting snapshots and depends on the OS having a btrfs subvolume available that the user running the program has read+write permissions on.

Yabsm is written in Perl so if you don't know Perl it may be difficult to follow the code examples.

Disclaimer

This is just a description of a solution to a problem I came across. I do not claim to be any kind of authority on code testing.

A quick note on btrfs

Btrfs is a Linux filesystem that allows you to take snapshots of your filesystem. A btrfs filesystem is organized into various "subvolumes" that can be mounted at various locations in your file tree. A common configuration is to have three subvolumes mounted at /, /home, and /.snapshots so you can seperately snapshot your /, and /home directories, and store the snapshots in /.snapshots.

The code to be tested

Let us assume we have already defined the following 4 predicates.

is_btrfs_subvolume is satisfied if passed a string representing the path of a btrfs subvolume on the system.

is_btrfs_dir is satisfied if passed a string representing a directory on the system that resides on a btrfs subvolume.

is_btrfs_snapshot is satisfied if passed a string representing a path to a btrfs snapshot on the system. This predicate is a bit of a fib because every snapshot is also a subvolume and thus would also be satisfied by is_btrfs_subvolume. For simplicity purposes we will pretend that we can differentiate between subvolumes and snapshots.

can_read_write_dir is satisfied if passed a directory that the current user has read+write permissions for.

sub take_snapshot {

    # Take a read-only btrfs snapshot of $subvolume named $name and place it in
    # $destination.

    my $name        = shift;
    my $subvolume   = shift;
    my $destination = shift;

    # preconditions
    return 0 unless is_btrfs_subvolume($subvolume);
    return 0 unless can_read_write_dir($subvolume);
    return 0 unless is_btrfs_dir($destination);
    return 0 unless can_read_write_dir($destination);

    # WARNING: Calling system like this is dangerous - see the appendix for a detailed explanation
    my $cmd    = "btrfs subvolume snapshot -r '$subvolume' '$destination/$name'";
    my $status = system $cmd;

    unless (0 == $status) {
        die "Aborting because '$cmd' exited with non-zero status";
    }

    return 1;
}

sub delete_snapshot {

    # Delete the btrfs snapshot $snapshot.

    my $snapshot = shift;

    # preconditions
    return 0 unless is_btrfs_snapshot($snapshot);
    return 0 unless can_read_write_dir($snapshot);

    # WARNING: Calling system like this is dangerous - See the appendix for a detailed explanation
    my $cmd    = "btrfs subvolume delete '$snapshot'";
    my $status = system $cmd;

    unless (0 == $status) {
        die "Aborting because '$cmd' exited with non-zero status";
    }

    return 1;
}

Testing the code

As you can see the code above uses the 4 predicates to assert that preconditions are met before we perform the actual side effect of taking or deleting a snapshot. It is also important to notice that if the side effect fails (determined via btrfs's exit status) then we kill the program. There is an underlying assumption going on here; if certain preconditions are met then we can be sure that our btrfs system command will run successfully.

Hmm, maybe in our test environment we can set up different scenarios around these preconditions and see if our assumptions are correct.

1. Finding a btrfs subvolume

   We cannot take and delete snapshots unless we have a btrfs subvolume available. The simplest way to find a btrfs subvolume is to ask the tester to supply us one via a command line parameter. We can use Perl's built-in Getopt::Long library to make this easy.

   use Getopt::Long;
   my $BTRFS_SUBVOLUME;
   GetOptions( 's=s' => \$BTRFS_SUBVOLUME );
   

   We now have a variable $BTRFS_SUBVOLUME, that if defined means the tester supplied us with a btrfs subvolume.

   Perl's built-in Test::More library allows us to skip tests if certain conditions are met so we can use the definedness of $BTRFS_SUBVOLUME for such conditions.

2. Setting up the sandbox

   If $BTRFS_SUBVOLUME is defined then we can attempt to set up our sandbox.

   We will use the tempdir function from the built-in File::Temp library to create a sandbox directory that will be removed when our test script terminates. This sandbox will reside on the $BTRFS_SUBVOLUME which means we can place snapshots inside it.

   We will require that our test script needs to be run with root privilages so we can be sure we have the necessary permissions for taking and deleting snapshots.

   use File::Temp 'tempdir';
   
   my $BTRFS_SANDBOX;
   if ($BTRFS_SUBVOLUME) {
       die "Must be root user" if $<;
       die "'$BTRFS_SUBVOLUME' is not a btrfs subvolume" unless is_btrfs_subvolume($BTRFS_SUBVOLUME);
       $BTRFS_SANDBOX = tmpdir('sandboxXXXXXX', DIR => $BTRFS_SUBVOLUME, CLEANUP => 1);
       die "'$BTRFS_SANDBOX' is not a btrfs directory" unless is_btrfs_dir($BTRFS_SANDBOX);
   }
   

3. Testing

   We are ready to write our tests! Lets use the Test::Exception library from CPAN to test that our subroutines don't kill the program when they're not supposed to.

   Please refer to the documentation on Test::Exception::livesand, Test::More::is and Test::More SKIP blocks if you are confused about the test framework specific code.

   Here's the tests - be sure to read the comments!

   use Test::More 'no_plan';
   use Test::Exception;
   
   SKIP: {
       skip "Skipping btrfs specific tests because we don't have a btrfs sandbox available", 9
           unless $BTRFS_SUBVOLUME;
   
       ### take_snapshot
   
       # All the preconditions for taking a snapshot should be met
       lives_and { is take_snapshot('foo', $BTRFS_SUBVOLUME, $BTRFS_SANDBOX), 1 } 'take_snapshot terminated are returned true';
   
       # Make sure the snapshot was actually created
       is(is_btrfs_snapshot("$BTRFS_SANDBOX/foo"), 1, 'The snapshot was created');
   
       ### delete_snapshot
   
       # All the preconditions for deleting a snapshot should be met
       lives_and { is delete_snapshot("$BTRFS_SANDBOX/foo"), 1 } 'delete_snapshot terminated and returned true';
   
       # Make sure the snapshot was actually deleted
       is(is_btrfs_snapshot("$BTRFS_SANDBOX/foo"), 0, 'The snapshot was deleted');
   
       ### Preconditions not met
   
       # There is no subvolume named "$BTRFS_SANDBOX/quux"
       lives_and { is take_snapshot('foo', "$BTRFS_SANDBOX/quux", $BTRFS_SANDBOX), 0 } 'take_snapshot returns false if non-existent subvolume';
       is(is_btrfs_snapshot("$BTRFS_SANDBOX/foo"), 0, 'no snapshot was created');
   
       # There is no btrfs directory named "$BTRFS_SANDBOX/quux"
       lives_and { is take_snapshot('foo', $BTRFS_SUBVOLUME, "$BTRFS_SANDBOX/quux"), 0 } 'take_snapshot returns false if non-existent btrfs target dir;
       is(is_btrfs_snapshot("$BTRFS_SANDBOX/quux/foo"), 0, 'no snapshot was created');
   
       # There is no snapshot named "BTRFS_SANDBOX/quux"
       lives_and { is delete_snapshot("$BTRFS_SANDBOX/quux"), 0 } 'delete_snapshot returns false if non-existent snapshot;
   }
   

   The way I test the code is by testing that if take_snapshot and delete_snapshot are called with arguments that satisfy their preconditions, the functions execute succesfully. I then then observe the state of the sandbox to see if a snapshot was in fact taken or deleted.

   I also test that if I call the functions with arguments that do not satisfy the preconditions then the side-effect of taking/deleting a snapshot is never performed.

Summary

The first step to testing side-effectful code is to write the code in a way that allows it to be tested. I used a set of preconditions on function arguments that if satisfied should result in succesful execution of the side effect. I was able to set up a testing sandbox where I can observe the valididity of these assumptions.

Appendix

Thank you to thrig on IRC for pointing out that the way I call system in take_snapshot and delete_snapshot is dangerous. They even wrote a personalized article on why and how to fix it! https://thrig.github.io/2022/08/04/shell-elimiation-3.html

Dave writes:

This is my monthly report on work done during July covered by my TPF perl core maintenance grant. 3:57 BBC: TODDR/YAML-Syck-1.34.tar.gz (Issue #19939) 3:28 Format in fill-mode has inconsistent behaviour (Issue #19985) 4:58 Goto xsub forces scalar context (#19188) 0:57 Returning undef returns a weird hash reference (Issue #19996) 0:37 Segmentation fault with use re 'eval' (Issue #19390) 0:20 fix build warning 39:28 make stack reference counted 6:11 process p5p mailbox 1:16 segfault on goto &xs_sub when calling sub is replaced (Issue #19936) ------ 61:12 TOTAL (HH::MM) I worked on quite a few tickets last month, but the most important thing I did was to continue work on making the stack reference counted (work I started near the end of June).

This is still very much a work in progress and I have nothing visible (i.e. pushed) to show for it yet, but what I have done so far is:

1) Put wrappers around 254 pp functions.

This changes the definitions of pp function from e.g.: PP(pp_subst) { ... } to PP_wrapped(pp_subst, ((PL_op->op_flags & OPf_STACKED) ? 2 : 1), 0) { ... } which on normal builds has no effect, but on builds with PERL_RC_STACK defined, it expands to something like: ``` OP* Perl_pp_subst(aTHX) { return Perl_pp_wrap(my_perl, S_norcs_pp_subst, ((PL_op->op_flags & OPf_STACKED) ? 2 : 1), 0); }

STATIC OP*
S_norcs_pp_subst(pTHX)
{
    ...
}

`` pp_wrap()is responsible for pushing a (non-reference-counted) copy of the current stack frame onto the end of the stack, then calling the original pp functionS_norcs_pp_subst()`, which doesn't know about reference-counted arguments, then shifting down and bumping the reference count of everything that it returns on the stack.

The two numeric arguments for pp_wrap are how many arguments that op expects on the stack, or for list ops, how many (mark-delineated) lists it expects. Often these are just constants, but for some, like pp_subst, it varies depending on flags.

2) Of the remaining 56 pp functions, some didn't need wrapping (like pp_pushmark), while others required special handling - like most of the pp_enterfoo and pp_leavefoo functions. For example most leavefoo ops in void context just abandon any arguments left on the stack: PL_stack_sp = PL_stack_base + cx->blk_oldsp; For a reference-counted stack, this means that all those SVs leak. So I've replaced all such occurrences with an inline function call: rpp_pop_to(PL_stack_base + cx->blk_oldsp); which on normal builds just resets PL_stack_sp, while on PERL_RC_STACK builds, it will decrement the reference count of all those abandoned stack items first.

I have almost finished doing (2) - just a handful of ops still need going over on a line-by-line basis (in particular pp_goto(), which I've been leaving to absolutely last).

None of the changes I've done so far actually do reference-counting yet: pp_wrap(), rpp_pop_to() etc currently have any SvREFCNT_dec()s etc commented out. The idea is that I can initially add all these modifications to the core while perl still works, Then once all that work is done I should be able to make changes in a small number of places - pp_wrap(), rpp_pop_to() etc - and the whole of the perl core should become reference-count-aware at once. This means that initially the core will be merely mostly broken rather than completely broken, and it should be easier to fix up those remaining bits which need it.

Then later on, things can be made more efficient again, e.g. by removing the wrapper functions from common ops and make them directly reference-count aware instead.

PS - for the avoidance of doubt, even with all these changes, unless the core is built with PERL_RC_STACK defined, none of these changes take affect yet.

The Grants Committee has concluded voting on the July 2022 round. One grant request was submitted:

Grant Proposal: Google TensorFlow API Bindings for Perl (John Napiorkowski) (USD 8,800)

VOTING RESULTS: Approved. 3 YES votes (12 points), 0 NO votes, 3 ABSTAIN

We accept proposals throughout the year; our next round of review will begin in July. You can submit proposals at any time.

If you want to help with funding and increase our budget, please visit our donations page. We sincerely appreciate all the donors which make the grant program possible. If you donate, please take advantage of your employers' matching donation program.

As always, thanks to our donors, both large and small, who support this program to give back to the community.

Hi there!

One of the ongoing discussions in the Perl community is the question of backward compatibility. One group of people say it is (one of) the most important traits of Perl that you can run very old code on a very new version of Perl. The other side mostly say that there are very few cases when this is actually needed and the change in the version of Perl is just one aspect of upgrades people need to handle.

Then comes the case, like the introduction of th $00 variable in Perl 5.32 that breaks the code of people who used that variable for their own purposes. This is not the first case where a change in perl (or for that matter in a CPAN module) breaks some working code. Neither will be the last.

So the question isn't IF there can be changes breaking backward compatibility, but how we deal with them? Do the authors give proper warning? Are there tools to find pieces of code that will be impacted? (e.g. a Perl Critic rule). Are there instructions how to fix the code that will be broken?

On the other side of the coin, how can a user - a user of Perl or a CPAN module - ensure that changes in any of the dependencies won't impact their product or service? How can they notice any impact before it reaches the production system? Possibly even before it reaches the development machines forcing the whole team to stop working.

Hint: write and run automated tests!

Enjoy your week!

Sorry, SPVM continues to undergo heavy changes.

After building real-world modules and applications, I realized that a lot of changes needed to be made.

You can see what I'm currently working on below.

SPVM modules - CPAN modules

JSON - JSON

Math - Math functions

Regex - Regular Expression

Unicode - Unicode Utilities

Base64 - Base 64

Time::Local - Time Reverse Manipulation

SPVM::Errno - Error Number

SPVM::Resource::Re2::V2022_06_01 - Resource of Google RE2 release 2022-06-01.

SPVM::Resource::Zlib::V1_2_11 - zlib v1.2.11 Resource

SPVM::Cwd - get pathname of current working directory

SPVM::IO - File IO, Socket, Select/Polling.

SPVM::Digest::MD5 - SPVM interface to the MD5 Algorithm

SPVM::Digest::SHA - SPVM extension for SHA-1/224/256/384/512

Stats

Number of new CPAN distributions this period: 68

Number of authors releasing new CPAN distributions this period: 39

Authors by number of new CPAN distributions this period:

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

Spoiler Alert: This weekly challenge deadline is due in a few of days from now (on July 31, 2022 at 23:59). 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: Last Sunday

Write a script to list Last Sunday of every month in the given year.

For example, for year 2022, we should get the following:

2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Last Sunday in Raku

In Raku, the Date classmethodday-of-month) provides all the methods needed to properly manage dates.

The MAIN subroutine takes one parameter, the year that we want to process, and will default to 2022 if no parameter is passed.

First, we compute the last date in the month, find on which day of the week it falls (day of week is an integer between 1 and 7, where 1 stands for Monday and 7 for Sunday).

To get the date in month of the last Sunday in the month, we simply subtract the day of the week from the day in the month, except that this would not work properly when the last day of the month is a Sunday (we would obtain the previous Sunday), so we subtract the week day modulo 7.

sub MAIN (Int $yr = 2022) {
    for ('01'..'09', 10 .. 12).flat -> $month {
        my $month-end = Date.new("$yr-$month-01").last-date-in-month;
        my $week_day = $month-end.day-of-week;
        my $day-in-month = $month-end.day-of-month;
        # Note: Sunday is weekday 7
        my $sunday = $day-in-month - ($week_day % 7);
        say Date.new("$yr-$month-$sunday");
    }
}

This program displays the following output:

$ raku ./last-sunday.raku
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

~
$ raku ./last-sunday.raku 2023
2023-01-29
2023-02-26
2023-03-26
2023-04-30
2023-05-28
2023-06-25
2023-07-30
2023-08-27
2023-09-24
2023-10-29
2023-11-26
2023-12-31

Last Sunday in Perl

This Perl program essentially follows the same idea as the Raku program above, except that we need to compute manually the last day in the month, which leads us to implement an is_leap subroutine to be sure of the last day of February.

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Time::Local;

my $yr = shift // 2022;
my @months = (0, 31, is_leap($yr) ? 29 : 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

for my $month (1..12) {
    my $month_last_day = timegm( 0, 0, 0, $months[$month], $month - 1, $yr - 1900 );
    my $day_in_week = (gmtime $month_last_day)[6];
    my $sunday = $months[$month] - ($day_in_week % 7);
    printf "%04d/%02d/%02d\n", $yr, $month, $sunday;
}

sub is_leap {
    my $yr = shift;
    return 0 if $yr % 4;    # no if not divisible by 4
    return 1 if $yr % 100;  # yes if divisible by 4 but not by 100
    return 0 if $yr % 400;  # no if divisible by 100 and not by 400
    return 1;               # yes if divisibe by 400
}

This program displays the following output:

$ perl ./last-sunday.pl
2022/01/30
2022/02/27
2022/03/27
2022/04/24
2022/05/29
2022/06/26
2022/07/31
2022/08/28
2022/09/25
2022/10/30
2022/11/27
2022/12/25

~
$ perl ./last-sunday.pl 2023
2023/01/29
2023/02/26
2023/03/26
2023/04/30
2023/05/28
2023/06/25
2023/07/30
2023/08/27
2023/09/24
2023/10/29
2023/11/26
2023/12/31

Last Sunday in Julia

The Julia Dates module provides everything we need, including a lastdayofmonth method.

using Dates

function sundays(year, month)
    month_end = Dates.lastdayofmonth(Dates.Date(year, month, 1))
    weekday = Dates.dayofweek(month_end)
    println(month_end - Dates.Day(weekday % 7))
end

year = parse( Int, ARGS[1])
for month in 1:12
    sundays(year, month)
end

Output:

$ julia ./last-sunday.jl 2022
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Last Sunday in Python

Python’s datetime module doesn’t have a lastdayofmonth method, but we can use the timedelta(days = 1) method to subtract one day from the first day of the next month. We only need a bit of simple arithmetic to find the next month.

from datetime import date,timedelta
import sys

def lastsundays (y):
  for m in range(1,13):
    if m == 12:
      year = y + 1
      month = 1
    else:
      year = y
      month = m + 1

    mthEnd = date(year, month, 1) - timedelta(days = 1)
    weekDay = mthEnd.weekday()
    lastSun = mthEnd - timedelta(days = (weekDay + 1) % 7)
    print(lastSun)

if len(sys.argv) == 2:
  year = int(sys.argv[1])
else:
  year = 2022

lastsundays(year)

Output:

$ python3 ./last-sunday.py
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Last Sunday in Ruby

The Ruby date class provides a next_month and a prev_day methods that we can chain to get the last day of the month (lmd) in just one code line. Thus, the Ruby solution is particularly concise.

require 'date'

year = ARGV.shift.to_i.nil? || 2022

for month in 1..12 
    lmd = Date.new(year, month, 1).next_month.prev_day
    weekday = lmd.wday
    puts lmd - (weekday % 7)
end

Output:

2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Task 2: Perfect Totient Numbers

Write a script to generate first 20 Perfect Totient Numbers. Please checkout [wikipedia page](https://en.wikipedia.org/wiki/Perfect_totient_number] for more informations.

Output:

3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571

Wikipedia explains us that, in number theory, Euler’s totient function counts the positive integers up to a given integer n that are relatively prime to n. In other words, it is the number of integers k in the range 1 ≤ k ≤ n for which the greatest common divisor gcd(n, k) is equal to 1. For example, there are 4 integers less than 10 that are prime relatively prime to 10: 1, 3, 7, 9. So, the totient of 10 is 4.

A perfect totient number is an integer that is equal to the sum of its iterated totients. That is, we apply the totient function to a number n, apply it again to the resulting totient, and so on, until the number 1 is reached, and add together the resulting sequence of numbers; if the sum equals n, then n is a perfect totient number.

For example, there are six positive integers less than 9 and relatively prime to it (1, 2, 4, 5, 7, 8), so the totient of 9 is 6; there are two numbers less than 6 and relatively prime to it (1, 5), so the totient of 6 is 2; and there is one number less than 2 and relatively prime to it (1), so the totient of 2 is 1; and 9 = 6 + 2 + 1, so 9 is a perfect totient number.

Once we’ve understood what a perfect totient number, it is quite easy to program a is_perfect_totient function that determines whether an input integer is a perfect totient. We need a gcd function to find out whether an integer is relatively prime to another. Some programming languages provide a built-in gcd function; for other languages, we’ll need to implement our own gcd function (see for example the Perl implementation below).

Perfect Totient Numbers in Raku

Raku has a built-in infix gcd operator. So it is quite easy: in the is-perfect-totient subroutine, we simply compute the totient of the input number n (i.e. count the number positive integers up to n that are relatively prime to n), then iteratively compute the totient of the totient, and so on, until we reach 1. Finally, we compare the sum of all totients to the original input number.

Raw Unoptimized Version

This is our first Raku version.

# Unoptimized version, don't use it
my $count = 0;
for 2..Inf -> $n {
    print "$n " and $count++ if is-perfect-totient $n;
    last if $count >= 20;
}
say "";
sub is-perfect-totient ($num) {
    my $n = $num;
    my $sum = 0;
    while $n >= 1 {
        $n = (grep { $n gcd $_ == 1 }, 1..^$n).elems;
        $sum += $n;
    }
    return $num == $sum;
}

This program displays the following output:

$ raku ./perfect-totient.raku
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

The program becomes quite slow for the last perfect totient values (about 25 seconds to run). I tried some micro-optimizations, but without any significant improvement.

Caching the Totient Sums (Naive Version)

If you think about it, the above program computes the sum of the totients many times for the same number. We could store these values to avoid recomputing them. This strategy is called caching (or sometimes memoizing). We use the @tot array as a cache (or memo) to store the totient sums. When we want to compute the totient of a number, we first check if it is in the cache and use this value if such is the case, and we do the computation the hard way (with gcd) only if it is not in the cache.

This could lead to this program:

# Naive caching strategy
my $count = 0;
my @tot = 0, 0;
for 2..Inf -> $n {
    print "$n " and $count++ if is-perfect-totient $n;
    last if $count >= 20;
}
say "";
say "Time spent: ", now - INIT now;

sub is-perfect-totient ($num) {
    my $n = $num;
    my $sum = 0;
    while $n >= 1 {
        if (defined @tot[$n]) {
            $sum += @tot[$n];
            last;
        } else {
            $n = (grep { $n gcd $_ == 1 }, 1..^$n).elems;
            $sum += $n;
        }
    }
    @tot[$num] = $sum;
    return $num == $sum;
}

This program displays the following output:

$ ./raku perfect-totient_cached_1.raku
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571
Time spent: 15.32900533

So we are now at 15 seconds. This is a significant improvement (although less than what I hoped).

Caching the Totient Sums (Improved Version)

We are testing every integer in ascending order. When we are testing one such new integer we know for sure that we haven’t computed its totient sum so far and need to compute it, and we also know for sure that we have already done the calculation for its totient number (provided we supply a first value). In other words, we no longer need the while loop, we can just compute the totient for the new input integer, and add to that the totient sum of the totient, which we are guaranteed to have in the cache. This leads to a significant code simplification of the is-perfect-totient subroutine:

# Improved caching strategy
my $count = 0;
my @tot = 0, 0;
for 2..Inf -> $n {
    print "$n " and $count++ if is-perfect-totient $n;
    last if $count >= 20;
}
say "";
say "Time spent: ", now - INIT now;

sub is-perfect-totient ($num) {
    my $sum = (grep { $num gcd $_ == 1 }, 1..^$num).elems;
    $sum += @tot[$sum];
    @tot[$num] = $sum;
    return $num == $sum;
}

This program displays the following output:

$ raku ./perfect-totient_cached_2.raku
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571
Time spent: 12.34103864

The code simplification has also led to an additional performance improvement of about 20%.

Perfect Totient Numbers in Perl

Our Perl implementation is really a port to Perl of the first Raku program above, with the only difference that we need to implement our own gcd subroutine, since two numbers are relatively prime (or coprime) if their greatest common divisor equals 1. For this, our gcd subroutine will use the so-called Euclidean algorithm, which is an improved variant of Euclid’s original method.

Raw Unoptimized Version

This is our first Perl version.

# Unoptimized version, don't use it
use strict;
use warnings;
use feature qw/say/;

sub gcd {
    my ($i, $j) = sort { $a <=> $b } @_;
    while ($j) {
        ($i, $j) = ($j, $i % $j);
    }
    return $i;
}
sub is_perfect_totient {
    my $num = shift;
    my $n = $num;
    my $sum = 0;
    while ($n >= 1) {
        $n = scalar grep { gcd( $n, $_) == 1 } 1..$n-1;
        $sum += $n;
    }
    return $num == $sum;
}
my $count = 0;
my $n = 1;
while ($count < 20) {
    print "$n " and $count++ if is_perfect_totient $n;
    $n++;
}
say "";

This program displays the following output:

$ perl  ./perfect-totient.pl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This program is even slower (39 seconds) than the first Raku version (25 seconds), presumably because of the pure Perl implementation of the gcd function. So, we will also use the caching strategy previously tested in Raku

Caching the Totient Sums

Here, we will go directly to the improved caching strategy used in the third Raku program because it makes the code simpler (and slightly faster).

# Optimized cached version
use strict;
use warnings;
use feature qw/say/;

my @tot = (0, 0);

sub gcd {
    my ($i, $j) = sort { $a <=> $b } @_;
    while ($j) {
        ($i, $j) = ($j, $i % $j);
    }
    return $i;
}

sub is_perfect_totient {
    my $num = shift;
    my $sum = scalar grep { gcd( $num, $_) == 1 } 1..$num-1;
    $sum += $tot[$sum];
    $tot[$num] = $sum;
    return $num == $sum;
}

my $count = 0;
my $n = 1;
while ($count < 20) {
    print "$n " and $count++ if is_perfect_totient $n;
    $n++;
}
say "";

Output:

$ time perl perfect-totient_cached.pl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    0m20,371s
user    0m20,281s
sys     0m0,046s

So, our caching program runs almost twice faster than our original Perl program.

Perfect Totient Numbers in Julia

This is port to Julia of the Raku program above. Julia has a built-in gcd function that we put for good use.

function is_perfect_totient(num)
    n = num
    sum = 0
    while n >= 1
        n = length( filter((x) -> gcd(x, n) == 1, 1:n-1))
        sum += n
    end
    return num == sum
end

count = 0
n = 1
while count < 20 
    if is_perfect_totient(n)
        print("$n ")
        global count += 1
    end
    global n += 1;
end

Output:

$ julia ./perfect-totient.jl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This Julia implementation runs much faster (less than 4 seconds) than the Raku and Perl versions. There is probably no urgent need to try to use the caching strategy used for Raku and Perl, but let’s try. The cached version below runs about twice faster (less than 2 seconds):

cache = zeros(Int64, 1, 10000)

function is_perfect_totient(num)
    tot = length( filter((x) -> gcd(x, n) == 1, 1:n-1))
    sum = tot + cache[tot] 
    cache[num] = sum
    return num == sum
end

count = 0
n = 2
while count < 20 
    if is_perfect_totient(n)
        print("$n ")
        global count += 1
    end
    global n += 1;
end

From now on, for other guest-languages, we will go directly for the improved cache strategy (faster and simpler code).

Perfect Totient Numbers in C

C doesn’t have a built-in gcd function, so we implement our own.

#include <stdio.h>
#define MAX_VAL 50000

int cache[MAX_VAL];

int gcd(int i, int j) {
    while (j != 0) {
        int temp = i % j;
        i = j;
        j = temp;
    }
    return i;
}

int is_perfect_totient (int num) {
    int tot = 0;
    for (int i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot++;
        }
    }
    int sum = tot + cache[tot];
    cache[num] = sum;
    return num == sum;
}

int main() {
    int j = 1;
    int count = 0;
    while (count < 20) {
        if (is_perfect_totient(j)) {
            printf("%d ", j);
            count++;
        }
        j++;
    }
    printf("%s\n", " "); 
}

Output:

$ time ./a.exe
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    0m1,441s
user    0m1,374s
sys     0m0,015s

Perfect Totient Numbers in bc

In bc, which is really an arbitrary precision basic calculator with some programming features, we also need to implement our own gcd function.

define gcd (i, j) {
    while(j != 0) {
        k = j
        j = i % j
        i = k
    }
    return i
}

define is_perfect_totient (num) {
    tot = 0
    for (i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot += 1
        }
    }
    sum = tot + cache[tot] 
    cache[num] = sum
    return num == sum
}

j = 1
count = 0
# we only go to 15 (not 20) because bc is very slow
while (count <= 15) {
    if (is_perfect_totient(j)) {
        print j, " "
        count += 1
    }
    j += 1
}
print "\n"
quit

Since bc is really slow, we display only the first 16 perfect totient numbers:

$ time bc -q perfect-totient.bc
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199

real    0m35,553s
user    0m35,437s
sys     0m0,030s

Perfect Totient Numbers in awk

In awk also we need to implement our own `gcd` function.

function gcd (i, j) {
    while(j != 0) {
        k = j
        j = i % j
        i = k
    }
    return i
}
function is_perfect_totient (num) {
    tot = 0
    for (i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot += 1
        }
    }
    sum = tot + cache[tot] 
    cache[num] = sum
    return num == sum
}
BEGIN {
    j = 1
    count = 0
    while (count < 20) {
        if (is_perfect_totient(j)) {
            printf "%d ", j
            count += 1
        }
        j += 1
    }
    print " "
}

Output:

$ time awk -f perfect-totient.awk
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 557

real    0m48,899s
user    0m48,656s
sys     0m0,046s

Perfect Totient Numbers in D

D has a built-in gcd function in the std.numeric module.

import std.stdio;
import std.numeric;

int[10000] cache;

bool is_perfect_totient(int num) {
    int tot = 0;
    for (int i = 1; i < num; i++) {
        if (gcd(num, i) == 1) {
            tot++;
        }
    }
    int sum = tot + cache[tot];
    cache[num] = sum;
    return num == sum;
}

void main() {
    int j = 1;
    int count = 0;
    while (count < 20) {
        if (is_perfect_totient(j)) {
            printf("%d ", j);
            count++;
        }
        j++;
    }
    writeln(" "); 
}

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This ran in 1.34 seconds (but not the same hardware, so don’t compare with other timings).

Perfect Totient Numbers in Ring

t_start = clock()
j = 1
count = 0
cache = list(10000)
while count < 14
    if is_perfect_totient(j)
        see "" + j + " "
        count++
    ok
    j++
end
see nl
duration = (clock() - t_start)/clockspersecond()
see "" + duration + nl

func gcd (i, j) 
    while j != 0 
        k = i % j
        i = j
        j = k
    end
    return i

func is_perfect_totient (num)
    tot = 0
    for i = 1 to (num-1)
        if gcd(num, i) = 1
            tot++
        ok
    next
    sum = tot + cache[tot+1] 
    cache[num+1] = sum
    return num = sum

Output:

$ ring ./perfect-totient.ring
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571
207.40

This program ran in 207.40 seconds, so it isn’t fast. However, it is possible to compile Ring source code into binary executable files (apparently with an intermediate C file). This should presumably be much faster, but I wasn’t able to do this so far because of various environment problems.

Perfect Totient Numbers in Python

Python has a gcd function in the math module.

import math

cache = [0] * 10000

def is_perfect_totient (n):
    tot = 0
    for i in range(1, n):
        if (math.gcd(n, i) == 1):
            tot += 1

​ sum = tot + cache[tot] ​ cache[n] = sum ​ return n == sum
​
i = 1 ​ count = 0 ​ while count < 20: ​ if isperfecttotient(i): ​ print(i, end = ” “) ​ count += 1 ​ i += 1 ​ print(” “)

Output:

$ time python3 ./perfect-totient.py
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    0m4,832s
user    0m4,718s
sys     0m0,076s

Perfect Totient Numbers in Kotlin

In Kotlin, we had to implement our own gcd function.

val cache = Array(10000, {i-> 0})

fun gcd (m: Int, n: Int): Int {
    var i = m
    var j = n
    while(j != 0) {
        val k = j
        j = i % j
        i = k
    }
    return i
}

fun is_perfect_totient(n: Int): Boolean {
    var tot = 0
    for (i in 1..n-1) {
        if (gcd(n, i) == 1) {
            tot++
        }
    }
    val sum = tot + cache[tot] 
    cache[n] = sum
    return n == sum
}

fun main() {
    var i = 0
    var count = 0
    while (count <= 20) {
        if (is_perfect_totient(i)) {
            print("$i ")
            count++
        }
        i++
    }
    println(" ")
}

Output:

0 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This program ran in 2.5 seconds.

Perfect Totient Numbers in Rust

The Rustnum::integer library provides a gcd function. In my humble opinion, Rust is nevertheless a pain in the neck to use because of its ultra-strict type system. As an example, I could not use a simple integer (i32) as an array subscript, because Rust wants a usize type. That’s why I had to use expressions like CACHE[n as usize]. Similarly, Rust forced me to have my global cache array in uppercase. And, since it is a global variable, I had to wrap accesses to the cache in a unsafe{] block. I personally don’t think a programming language should get in the way of developers to such an extent. I really wasted quite a bit of time working around this straitjacket.

use num::integer::gcd;

static mut CACHE:[i32;10000] = [0; 10000];

fn is_perfect_totient(n: i32) -> bool {
    let mut  tot = 0;
    for i in 1..n {
        if gcd(n, i) == 1 {
            tot += 1
        }
    }
    unsafe {
        let sum = tot + CACHE[tot as usize];
        CACHE[n as usize] = sum;
        return n == sum;
    }
}    

fn main() {
    let mut i = 1;
    let mut count = 0;
    while count < 20 {
        if is_perfect_totient(i) {
            print!("{} ", i);
            count += 1;
        }
        i += 1;
    }
    println!("{}", " ")
}

Ouput:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Java

Java has a gcd function bizarrely sitting in the java.math.BigInteger class. For a program performing heavy number crunching, I did not think it was reasonable to accept the performance penalty associated with big integers. So, I wrote my own gcd function.

public class PerfectTotient {

    static int[] cache = new int[10000];

    public static int gcd(int i, int j) {
        while (j != 0) {
            int temp = i % j;
            i = j;
            j = temp;
        }
        return i;
    }
    public static boolean isPerfectTotient(int n) {
        int tot = 0;
        for (int i = 1; i < n; i++) {
            if (gcd(n, i) == 1) {
                tot++;
            }
        }
        int sum = tot + cache[tot];
        cache[n] = sum;
        return n == sum;
    }

    public static void main(String[] args) {
        int i = 0;
        int count = 0;
        while (count < 20) {
            if (isPerfectTotient(i)) {
                System.out.printf("%d ", i);
                count++;
            }
            i++;
        }
        System.out.printf("%s", "\n");
    }
}

Ouput:

0 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

The compiled program ran in 1,23 second (not on the same hardware as most timings in this post).

Perfect Totient Numbers in Nim

Nim has a gcd function in its math library.

import math

var cache: array[0..10000, int]

proc is_perfect_totient (n: int): bool =
  var tot = 0
  for i in 1..n-1:
    if (gcd(n, i) == 1):
      tot += 1
  let sum = tot + cache[tot]
  cache[n] = sum
  return sum == n

var i = 1
var count = 0
while count < 20:
  if is_perfect_totient(i):
    stdout.write i, " "
    count += 1
  i += 1
echo ""

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

This program ran in 13 seconds.

Perfect Totient Numbers in Go

No gcd in plementation in go, so we rolled out our own.

import "fmt"

var cache [10000]int

func gcd(i int, j int) int {
    for j != 0 {
        temp := i % j
        i = j
        j = temp
    }
    return i
}

func is_perfect_totient(n int) bool {
    tot := 0
    for i := 1; i < n; i++ {
        if gcd(n, i) == 1 {
            tot++
        }
    }
    sum := tot + cache[tot]
    cache[n] = sum
    return n == sum
}

func main() {
    i := 0
    count := 0
    for count <= 20 {
        if is_perfect_totient(i) {
            fmt.Printf("%d ", i)
            count++
        }
        i++
    }
    fmt.Println("")
}

Output:

0 3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in JavaScript

var cache = new Array(10000)
cache[0] = 0

function gcd (i, j) {
    while(j != 0) {
        k = j
        j = i % j
        i = k
    }
    return i
}

function is_perfect_totient (n) {
    let tot = 0
    for (var i = 1; i < n; i++) {
          if (gcd(n, i) == 1) {
            tot++
        }
    }
    sum = tot + cache[tot]
    cache[n] = sum
    return n == sum
}

let count = 0
let i = 1
while (count < 20) {
    if (is_perfect_totient(i)) {
        process.stdout.write(i + " ")

        count++
    }
    i++
}
process.stdout.write("\n")

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Dart

Dart has a gcd method, which we will use.

import "dart:io";

var cache = List<int>.filled(10000, 0, growable: true);

void main() {
    cache[0] = 0;
    var count = 0;
    var i = 1;
    while (count < 20) {
        if (is_perfect_totient(i)) {
            stdout.write("$i ");
            count++;
        }
        i++;
    }
    print(" ");
}

bool is_perfect_totient(n) {
    var tot = 0;
    for (int i = 1; i < n; i++ ) {
       if (i.gcd(n) == 1) {
            tot++;
        }
    }
    int sum = tot + cache[tot];
    cache[n] = sum;
    return n == sum;
}

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Ruby

Ruby has a gcd mehod, so we’ll use it.

$cache = Array.new(10000, 0) # global variables require $

def is_perfect_totient(n)
    tot = 0
    for i in 1..(n - 1)
        if n.gcd(i) == 1
            tot += 1
        end
    end
    sum = tot + $cache[tot]
    $cache[n] = sum;
    return sum == n
end

i = 1
count = 0
while count < 20
    if is_perfect_totient(i)
        printf("%d ", i)
        count += 1
    end
    i += 1
end
print("\n")

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Scala

Scala has a gcd function, but only for big integers (probably because Scala relies on Java, which has the same property). For a program performing heavy number crunching, I did not think it was reasonable to accept the performance penalty associated with big integers. So, I wrote my own gcd function for plain integers.

object PerfectTotient extends App {

  var cache = new Array[Int](10000)

  def gcd(a: Int, b: Int): Int = {
    var (i, j) = (a, b)
    while (j > 0) {
      var t = i
      i = j
      j = t % j
    }
    return i
  }

  def is_perfect_totient(n: Int): Boolean = {
    var tot = 0
    for (i <- 1 to (n - 1)) {
      if (gcd(n, i) == 1) {
        tot += 1
      }
    }
    val sum = tot + cache(tot)
    cache(n) = sum
    return n == sum
  }

  var i = 1
  var count = 0
  while (count < 20) {
    if (is_perfect_totient(i)) {
      count += 1
      printf("%d ", i)
    }
    i += 1
  }
  println("")
}

Output:

3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

Perfect Totient Numbers in Tcl

Tcl doesn’t have a built-in gcd function, so I wrote one.

array set cache {}

set cache(0) 0

proc gcd {i j} {
   while {$j != 0} {
      set t [expr {$i % $j}]
      set i $j
      set j $t
   }
   return $i
}

proc is_perfect_totient {n} {
    global cache
    set tot 0
    for {set i 1} {$i < $n} {incr i} {
        if [ expr [gcd $i $n] == 1 ] {
            incr tot
        }
    }
    set sum [expr $tot + $cache($tot)]
    set cache($n) $sum
    return [ expr $n == $sum ? 1 : 0]
}

set i 1
set count 0
while { $count < 20 } {
    if [ is_perfect_totient $i ] {
        puts -nonewline  "${i} "
        incr count
    }
    incr i
}
puts ""

As a fully interpreted language, Tcl is quite slow, as it can be seen in the following output:

$ time tclsh ./perfect-totient.tcl
3 9 15 27 39 81 111 183 243 255 327 363 471 729 2187 2199 3063 4359 4375 5571

real    1m18,058s
user    1m17,593s
sys     0m0,046s

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 August 7, 2022. And, please, also spread the word about the Perl Weekly Challenge if you can.

Part of the Dancer2 video course available both to Pro subscribers and attendees of the Perl Dancer course on Leanpub.

1. App::Netdisco - An open source web-based network management tool.
   • Version: 2.052010 on 2022-07-27
   • Votes: 14
   • Previous version: 2.052008 was 15 days before
2. Devel::CheckOS - require that we are running on a particular OS
   • Version: 1.94 on 2022-07-24
   • Votes: 13
   • Previous version: 1.93 was 2 months, 29 days before
3. HTTP::Tiny - A small, simple, correct HTTP/1.1 client
   • Version: 0.082 on 2022-07-25
   • Votes: 103
   • Previous version: 0.080 was 8 months, 20 days before
4. Memoize - Make functions faster by trading space for time
   • Version: 1.08 on 2022-07-28
   • Votes: 24
   • Previous version: 1.05 was 5 days before
5. Search::Elasticsearch - The official client for Elasticsearch
   • Version: 7.717 on 2022-07-28
   • Votes: 43
   • Previous version: 7.715 was 9 months, 8 days before
6. Sereal - Fast, compact, powerful binary (de-)serialization
   • Version: 4.025 on 2022-07-28
   • Votes: 59
   • Previous version: 4.023 was 5 months, 8 days before
7. Sereal::Decoder - Fast, compact, powerful binary deserialization
   • Version: 4.025 on 2022-07-28
   • Votes: 21
   • Previous version: 4.023 was 5 months, 8 days before
8. Sereal::Encoder - Fast, compact, powerful binary serialization
   • Version: 4.025 on 2022-07-28
   • Votes: 20
   • Previous version: 4.023 was 5 months, 8 days before
9. SPVM - SPVM Language
   • Version: 0.9630 on 2022-07-29
   • Votes: 26
   • Previous version: 0.9627 was 7 days before
10. Type::Tiny - tiny, yet Moo(se)-compatible type constraint
    • Version: 1.016006 on 2022-07-25
    • Votes: 131
    • Previous version: 1.016005 was 2 days before
11. WWW::Mechanize - Handy web browsing in a Perl object
    • Version: 2.13 on 2022-07-29
    • Votes: 93
    • Previous version: 2.12 was 9 days before

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

Week's winner (+3): Storable::Improved 

Build date: 2022/07/30 19:39:07 GMT

Clicked for first time:

• Linux::Statm::Tiny - simple access to Linux /proc/../statm

Increasing its reputation:

• Authen::TOTP (+1=2)
• BioPerl (+1=29)
• Book::Chinese::MasterPerlToday (+1=5)
• Cache::FastMmap (+1=22)
• CGI (+1=41)
• Chart (+1=8)
• Data::Enum (+1=2)
• DBI (+1=257)
• DBIx::Class::InflateColumn::FS (+1=4)
• DBIx::Class::UUIDColumns (+1=2)
• Devel::CheckOS (+1=13)
• Excel::Writer::XLSX (+1=56)
• Feature::Compat::Try (+1=10)
• LaTeX::Driver (+1=3)
• libnet (+1=27)
• Minion::Backend::mysql (+1=13)
• Mite (+1=5)
• Module::Starter (+1=29)
• Mojo::mysql (+1=36)
• Mojo::RabbitMQ::Client (+1=4)
• Net::SSLeay (+1=22)
• Nice::Try (+1=6)
• PDF::Reuse (+1=9)
• PDF::Reuse::Tutorial (+1=2)
• Pepper (+1=8)
• Perl::Critic::Community (+1=4)
• perlsecret (+1=50)
• RocksDB (+1=4)
• Safe::Isa (+1=31)
• SQL::Translator (+1=42)
• Storable::Improved (+3=3)
• Template::Toolkit (+2=137)
• Term::Graille (+1=2)
• Test::Log::Dispatch (+1=2)
• Text::CleanFragment (+1=2)
• Type::Tiny (+1=131)
• URI::Router (+1=2)

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

Write a script to list the last sunday of every month in the given year.

Solution

use strict;
use warnings;
use Time::Piece; 

sub last_sunday_month{
    my($month, $year) = @_;
    $month = "0$month" if $month < 10;
    my $sunday;
    my $t = Time::Piece->strptime("$month", "%m");   
    for my $day (20 .. $t->month_last_day()){
        $t = Time::Piece->strptime("$day $month $year", "%d %m %Y");
        $sunday = "$year-$month-$day" if $t->wday == 1;
    }  
    return $sunday;  
}

sub last_sunday{
    my($year) = @_;
    my @sundays; 
    for my $month (1 .. 12){
        push @sundays, last_sunday_month($month, $year);  
    }
    return @sundays;   
}

MAIN:{
    print join("\n", last_sunday(2022)) . "\n"; 
} 

Sample Run

$ perl perl/ch-1.pl
2022-01-30
2022-02-27
2022-03-27
2022-04-24
2022-05-29
2022-06-26
2022-07-31
2022-08-28
2022-09-25
2022-10-30
2022-11-27
2022-12-25

Notes

When dealing with dates in Perl you have a ton of options, including implementing everything on your own. I usually use the Time::Piece module. Here you can see why I find it so convenient. With strptime you can create a new object from any conceivable date string, for setting the upper bounds on iterating over the days of a month we can use month_last_day, and there are many other convenient functions like this.

Part 2

Write a script to generate the first 20 Perfect Totient Numbers.

Solution

use strict;
use warnings;
use constant EPSILON => 1e-7;   

sub distinct_prime_factors{
    my $x = shift(@_); 
    my %factors;    
    for(my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        $factors{$y} = undef;
        redo;
    }
    return keys %factors;  
}

sub n_perfect_totients{
    my($n) = @_; 
    my $x = 1;
    my @perfect_totients;
    {
        $x++;
        my $totient = $x;
        my @totients;
        map {$totient *= (1 - (1 / $_))} distinct_prime_factors($x);   
        push @totients, $totient; 
        while(abs($totient - 1) > EPSILON){
            map {$totient *= (1 - (1 / $_))} distinct_prime_factors($totient);   
            push @totients, $totient; 
        }  
        push @perfect_totients, $x if unpack("%32I*", pack("I*", @totients)) == $x;
        redo if @perfect_totients < $n;
    }
    return @perfect_totients;
}

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

Sample Run

$ perl perl/ch-2.pl
3, 9, 15, 27, 39, 81, 111, 183, 243, 255, 327, 363, 471, 729, 2187, 2199, 3063, 4359, 4375, 5571

Notes

This code may look deceptively simple. In writing it I ended up hitting a few blockers that weren't obvious at first. The simplest one was my own misreading of how to compute totients using prime factors. We must use unique prime factors. To handle this I modified my prime factorization code to use a hash and by returning the keys we can get only the unique values. Next, while Perl is usually pretty good about floating point issues, in this case it was necessary to implement a standard epsilon comparison to check that the computed totient was equal to 1.

Actually, maybe I should say that such an epsilon comparison is always advised but in many cases Perl can let you get away without one. Convenient for simple calculations but not a best practice!

For doing serious numerical computing in Perl the best choice is of course to use PDL!

References

Time::Piece

Perfect Totient Number

Challenge 175

Hi there,

The community spirit among Perl fans is always the highlight of any event. I am sure you have experience it too. Little while ago, there was discussion to give new life to Perl Advent Calendar. Many volunteers came forward to help the project, like, Adam Russell. As we are getting close to the next edition, Olaf Alders and Julien Fiegehenn came together and kickstarted the project with a big push. I noticed in the recent weeks, lots of activities on GitHub repository, thanks to all the volunteers. Olaf Alders made an official call for papers in the blog post. I request all Perl fans to submit proposal. If you need any help submitting an article, then please do checkout the page for guidance. I would encourage first timer to come forward and share their experience with CPAN distributions. I am sure, everyone has few favourite distributions or their own creations that they want to talk about and share with the community. There are plenty of help available, if you need, so just give us a shout.

Talking about revival, recently I spoke about CPAN Weekly, creation of Neil Bowers. I shared my intention of getting it back up. In no time, I got plenty of offer. One of them was Cheok-Yin Fung. She even shared the initial draft that I am currently reviewing. Thank you, Cheok-Yin for the help. The plan is to launch it on the birthday of Perl i.e. 18th Dec. I will share more about it soon. Wish me luck.

Maintaining CPAN distribution is a big responsibility. I have seen regular release of WWW::Mechanize, thanks to Julien Fiegehenn for all the care and love. You can find the details in the Twitter thread. I know it takes a lot of efforts to keep the distribution live and active as I too have the responsibilities of handful of distributions. Having said, credit must be given to all the contributors who provide patches.

Enjoy the rest of the newsletter.

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

Write a script to generate the first 19 Disarium Numbers.

Solution

use strict;
use warnings;
use POSIX;

sub disarium_n{
    my($n) = @_;
    my @disariums;
    map{
        return @disariums if @disariums == $n;
        my @digits = split(//, $_);
        my $digit_sum = 0;
        map{
            $digit_sum += $digits[$_] ** ($_ + 1);
        } 0 .. @digits - 1;
        push @disariums, $digit_sum if $digit_sum == $_;
    } 0 .. INT_MAX / 100;
}

MAIN:{
    print join(", ", disarium_n(19)) . "\n";
}

Sample Run

$ perl perl/ch-1.pl
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798

Notes

I gave myself a writing prompt for this exercise: only use map. This turned out to present a small issue and that is, how do we terminate out of a map early? This comes up because we do not need to examine all numbers in the large range of 0 .. INT_MAX / 100. Once we find the 19 numbers we require we should just stop looking. last will not work from within a map it turns out. In this case a return works well. But suppose we did not want to return out of the subroutine entirely? Well, I have tested it out and it turns out that goto will work fine from within a map block as well!

That code would look something like this, where the CONTINUE block would have some more code for doing whatever else was left to do.

sub disarium_n{
    my($n) = @_;
    my @disariums;
    map{
        goto CONTINUE if @disariums == $n;
        my @digits = split(//, $_);
        my $digit_sum = 0;
        map{
            $digit_sum += $digits[$_] ** ($_ + 1);
        } 0 .. @digits - 1;
        push @disariums, $digit_sum if $digit_sum == $_;
    } 0 .. INT_MAX / 100;
    CONTINUE:{
        ##
        # more to do before we return
        ##
    }
    return @disariums;
}

Part 2

You are given a list of integers with no duplicates, e.g. [0, 1, 2]. Write two functions, permutation2rank() which will take the list and determine its rank (starting at 0) in the set of possible permutations arranged in lexicographic order, and rank2permutation() which will take the list and a rank number and produce just that permutation.

Solution

use strict;
use warnings;
package PermutationRanking{
    use Mars::Class;
    use List::Permutor;

    attr q/list/;
    attr q/permutations/;
    attr q/permutations_sorted/;
    attr q/permutations_ranked/;

    sub BUILD{
        my $self = shift;
        my @permutations;
        my %permutations_ranked;
        my $permutor = new List::Permutor(@{$self->list()});
        while(my @set = $permutor->next()) {
            push @permutations, join(":", @set);
        }
        my @permutations_sorted = sort @permutations;
        my $rank = 0;
        for my $p (@permutations_sorted){
            $permutations_ranked{$p} = $rank;
            $rank++;
        }
        @permutations_sorted = map {[split(/:/, $_)]} @permutations_sorted;
        $self->permutations_sorted(\@permutations_sorted);
        $self->permutations_ranked(\%permutations_ranked);
    }

    sub permutation2rank{
        my($self, $list) = @_;
        return $self->permutations_ranked()->{join(":", @{$list})};
    }

    sub rank2permutation{
        my($self, $n) = @_;
        return "[" . join(", ", @{$self->permutations_sorted()->[$n]}) . "]";
    }
}

package main{
    my $ranker = new PermutationRanking(list => [0, 1, 2]);
    print "[1, 0, 2] has rank " . $ranker->permutation2rank([1, 0, 2]) . "\n";
    print "[" . join(", ", @{$ranker->list()}) . "]"  . " has permutation at rank 1 --> " . $ranker->rank2permutation(1) . "\n";
}

Sample Run

$ perl perl/ch-2.pl
[1, 0, 2] has rank 2
[0, 1, 2] has permutation at rank 1 --> [0, 2, 1]

Notes

I've been enjoying trying out Al Newkirk's Mars OOP framework. When it comes to Object Oriented code in Perl I've usually just gone with the default syntax or Class::Struct. I am far from a curmudgeon when it comes to OOP though, as I have a lot of experience using Java and C++. What I like about Mars is that it reminds me of the best parts of Class::Struct as well as the best parts of how Java does OOP. The code above, by its nature does not require all the features of Mars as here we don't need much in the way of Roles or Interfaces.

Perhaps guided by my desire to try out Mars more I have taken a definitively OOP approach to this problem. From the problem statement the intent may have been to have two independent functions. This code has two methods which depend on the constructor (defined within sub BUILD) to have populated the internal class variables needed.

There is a small trick here that the sorting is to be by lexicograohic order, which conveniently is the default for Perl's default sort. That doesn't really buy us any algorithmic improvement in performance, in fact it hurts it! Other approaches exist for this problem which avoid producing all permutations of the list.

References

Disarium Numbers

Mars

Challenge 174

Chris Nandor (Pudge) is the recipient of the White Came Award in 2000.

As I have not heard much from him in recent years I thought it would be interesting to ask where is he now and what does he do.

We would like to present Todd Rinaldo as a candidate to join the foundation Board. He has worked with the foundation for many years as a conference organizer and in other capacities.

The board will vote on Todd's appointment at the board meeting scheduled for 19th August 2022.

Below is Todd's application, answering the questions of why he wants to be a member of the board and what he would like the foundation to work on.

I am Todd Rinaldo. I've been programming for 40 years and coding Perl since my first Perl programming class in 1995. I've been a resident of Houston, TX most of my life. I've been an active Perl Monger with Houston.pm since 2006. I'm married with 1 boy. I've been an employee of cPanel for 13 years. Prior to cPanel, I worked for JP Morgan and Century Maintenance Supply before that. This has given me some very helpful perspectives on how things work in a small/medium/large company.

As a boy and now an adult, I have been an active member of The Boy Scouts of America. This is the other organization I've donated a significant amount of time to. The organization taught me to embrace servant leadership. I think that experience more than any has instilled in me a want to give back to the organizations that have helped me. Perl has been a big part of my life, so I certainly want to help where I can.

I do not represent any community. I have been a part of Perl 5 Porters and am now a voting member. My interests also include the improvement of CPAN as well as ongoing maintenance and testing of the existing modules on that platform. I of course have been an active organizer with most YAPC::NAs since 2013.

I'm interested in becoming a board member to offer assistance in the Foundation's mission to help the community. I have no specific agenda. As I understand things, the purpose of the board is to provide support to active projects so they can focus on coding, etc., and not the logistical, financial, and legal details. I'm not sure how much scope the board has outside of this but I am interested to know more.

I hope to help find ways the board can support The Perl and Raku Conference going forward. Potentially this might also include the EU which has stopped holding conferences though it is unclear if this is because of COVID or lack of interest.

I would also like to assure TPF continues to maintain a tight bond with the steering councils of the organizations it supports. I don't have clarity on the level of communication so it's hard to say if there is enough communication already.

Please share your thoughts and comments on Todd's candidacy before the board meeting on 19th August 2022.

Hi there!

Last week Mohammad raised the idea of a GitHub-pages-based central blogging platform for Perl to which Dave Cross added his comment pointing out a misunderstanding. At first I liked the idea of Mohammad as way of making it easier for people who don't know how to setup a blog, but on a second thought. Setting up a site for blogging on GitHub pages is less than 5 minutes. On GitLab and Codeberg it might take a bit more, but still way less than the whole writing part. If you need help ask Flavio, David, Mohammad, or myself.

A few years ago the Perl community got really enthusiastic by the idea of supporting each other via one of the monthly-support platforms. The problem, as I understood, was, that most people received only some small pocket money that did not make any real impact. So most people thought: Instead of taking home 20-40 USD a month I will use this money to support others. We ended up with a circular support in which no one received any substantial support. If you go over the amounts the Perl related people receive you'll see that most of them only receive a few 10s of USD. For most people living in the economically advanced world that's just pocket money. Manwar is the person closest to some substantial amount, but he still needs more.

This is our challenge now. Can we, as a community, increase his support to reach 500 UK pound? We are already half-way there. If you already support him, please consider increasing the amount so we reach USD 10/supporter! (we are at about USD 5.5). If you are not supporting him yet, do it now: Manwar

Enjoy your week

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

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

Solution

use strict;
use warnings;
use boolean;

sub is_esthetic{
    my($n) = @_;
    my @digits = split(//, $n);
    my $d0 = pop @digits;
    while(@digits){
        my $d1 = pop @digits;
        return false if abs($d1 - $d0) != 1;
        $d0 = $d1;
    }
    return true;
}

MAIN:{
    my $n;
    $n = 5456;
    print "$n is ";
    print "esthetic\n" if is_esthetic($n);
    print "not esthetic\n" if !is_esthetic($n);
    $n = 120; 
    print "$n is ";
    print "esthetic\n" if is_esthetic($n);
    print "not esthetic\n" if !is_esthetic($n);
}

Sample Run

$ perl perl/ch-1.pl
5456 is esthetic
120 is not esthetic

Notes

I started to write this solution and then kept coming back to it, considering if there is a more elegant approach. If there is I could not come up with it on my own over this past week! This doesn't seem all that bad, just a bit "mechanical" perhaps?

1. Break the number into an array of digits
2. Do a pairwise comparison of successive digits by popping them off the array one at a time and retaining the most recently popped digit for the next iteration's comparison.
3. If at any point the "different by 1" requirement is not met, return false.
4. If we complete all comparisons without a failure, return true.

Part 2

Write a script to generate first 10 members of Sylvester's sequence.

Solution

use strict;
use warnings;
use bigint; 

sub sylvester_n{
    my($n) = @_;
    my @terms = (2, 3);
    my %product_table;
    $product_table{"2,3"} = 6;
    while(@terms < $n){
        my $term_key = join(",", @terms);
        my $term = $product_table{$term_key} + 1;
        push @terms, $term;
        $product_table{"$term_key,$term"} = $term * $product_table{$term_key}; 
    }
    return @terms;
}


MAIN:{
    print join(", ", sylvester_n(10)). "\n";
}

Sample Run

$ perl perl/ch-2.pl
2, 3, 7, 43, 1807, 3263443, 10650056950807, 113423713055421844361000443, 12864938683278671740537145998360961546653259485195807, 165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443

Notes

Much like the first part I considered what might be an optimal way to compute this. Here the standard recursion and memoization would be most appropriate, I believe. Just to mix things up a little I implemented my own memoization like lookup table and computed the terms iteratively. Otherwise though, the effect is largely the same in that for each new term we need not reproduce any previous multiplications.

These terms get large almost immediately! use bigint is clearly necessary here. An additional optimization would be the use of Tie::Hash and Tie::Array to save memory as we compute larger and larger terms. Since TWC 173.2 only specified 10 terms I left that unimplemented.

Finally, I should note that the title of this blog draws from Sylvester the Cat, not Sylvester the Mathematician! Sylvester the Cat's famous phrase is "Suffering Succotash!". See the link in the references for an example. Not everyone may not be familiar, so see the video link below! The comments on that video have some interesting facts about the phrase and the character.

References

Challenge 173

Thufferin' thuccotash!

Part of the Dancer2 video course available both to Pro subscribers and attendees of the Perl Dancer course on Leanpub.

Name

John Napiorkowski

Amount Requested:

The minimum budget for this project is $8,800 USD

Synopsis

This grant proposal is for the development of a Perl API to Google TensorFlow, a software library for machine learning (ML) and artificial intelligence (AI).

TensorFlow is generally considered to be the most mature and well-supported ML/AI library, and will benefit the Perl community tremendously.

Benefits to the Perl Community

Most new software development projects tend to incorporate or utilize machine learning in some way.

Most machine learning libraries, including TensorFlow, provide a well-documented Python API with example Python applications.

Thus, due to these (and other) reasons, most new software projects are implemented using Python or some other non-Perl language.

The availability of a fully-featured and up-to-date Perl API for TensorFlow would have far-reaching and long-lasting effects on the Perl community.

To begin with, software developers will be able to much more easily convince corporate management to adopt Perl for new software projects requiring ML/AI.

Secondly, students and teachers alike will be empowered to teach Perl in ML/AI courses at countless high schools, colleges, and universities.

Third, open source Perl developers will have essential new tools for working on brilliant breakthroughs in ML/AI software, to the benefit of all humanity.

Fourth, the overall creation of new Perl ML/AI projects and educational courses will naturally result in the critically-needed creation of new Perl jobs.

Last but not least, new corporate projects using Perl ML/AI will also translate into new corporate funding and sponsorship for Perl non-profits such as TPF.

Deliverables

An implementation of Perl API bindings to all applicable symbols in the TensorFlow C API, using FFI::Platypus from CPAN.

A comprehensive Perl test suite with automatically-provable coverage for 100% of the Perl API, using Test2 from CPAN.

A carefully-written and explanatory collection of documentation with coverage for 100% of the Perl API, using normal POD fully compatible with CPAN.

A small collection of user-friendly example Perl applications, using popular TensorFlow components to effectively showcase the Perl API.

A public GitLab repository with all source code and components of the Perl API, including unstable or experimental components.

A public CPAN distribution with all stable source code and components of the Perl API.

A public DockerHub repository with all stable source code and components of the Perl API, along with all dependencies, ready to run out-of-the-box.

The TensorFlow C API does NOT yet support gradients, functions, and control flow operations. These features will be addressed in future grant proposals.

This grant proposal specifically does NOT include any re-implementation of TensorFlow's Python layer, such as NumPy NDarrays or Keras, which is far beyond the scope of a single grant and will be addressed in future proposals.

Project Details

All the technical details of how a TensorFlow API should behave and how to implement it in Perl can be found at the following websites:

• https://www.tensorflow.org/api_docs
• https://github.com/tensorflow/tensorflow
• https://github.com/tensorflow/docs/blob/master/site/en/r1/guide/extend/bindings.md
• https://github.com/tensorflow/tensorflow/blob/master/tensorflow/c/c_api.h
• https://metacpan.org/pod/FFI::Platypus
• https://metacpan.org/pod/Test2

Project Schedule

Total development time is estimated at 60 to 90 days, with the normal disclaimer about the difficulty of predicting software project durations.

During the first work cycle of approximately 30 days, implement the initial Perl API.

During the second work cycle, implement the Perl test suite.

During the third work cycle, write the Perl documentation and implement the Perl example applications.

If a fourth work cycle is required, continue until the public releases on CPAN and DockerHub are complete.

Completeness Criteria

This grant is deemed complete when all the above-listed deliverables are reviewed and accepted by the official TPF-assigned grant manager.

Bio

I'm a prolific CPAN author, with 86 distributions so far.

I've been one of the core maintainers of Catalyst, the premier Perl MVC web application framework, for over a decade.

I'm an active and dedicated member of the Perl community, including long-term participation at TPF-sponsored events such as The Perl Conference.

I live outside of Austin, Texas with my family, pets, and farm animals.

Tony writes: ``` [Hours] [Activity] 2022/06/01 Wednesday 0.28 comment on Win32 p5p thread 0.60 #18882 review, comment briefly 1.17 review github notifications 1.40 #19668 fail to build perl (using tools from strawberry), get it built, reproduce, work on test

0.17 #19668 finish test, fix, start test run, push for CI

3.62

2022/06/02 Thursday 0.07 #19668 open PR 1.42 review coverity report 351943, diagnose, research, fix, testing, push change for CI, open PR #19807 0.77 cid 351946 - diagnose and reject as false positive, review some other coverity issues 1.68 more coverity cid 351960 - try to make it crash, review

other coverity issues

3.94

2022/06/03 Friday 1.38 more coverity, upload a simple modelling file (how to prevent byte swapping tainting?) 0.20 #19807 review CI results and apply to blead 0.30 #19806 apply to blead, perldelta updates

0.43 #19791 review, look over Configure, hints/freebsd

2.31

2022/06/06 Monday 0.17 #19825 review and approve 0.37 #19795 review and comment 0.33 #19797 review and comment 0.40 #19826 try to reproduce, comment 1.68 #19704 work on a fix, testing 1.15 #19704 try to break it, commit, push for CI 0.67 #19826 follow-up

1.12 #6841/#12227 testing, comments

5.89

2022/06/07 Tuesday 1.07 #19797 try to test build with clang-cl (and fail) 1.27 review new coverity alerts 0.70 yield true feature discussion: comment, try a simple patch, look over referenced true module.

1.63 #6841 testing, work on a fix, more testing

4.67

2022/06/08 Wednesday 0.28 #19797 followup 1.05 #19704 re-word commit message 0.62 #6841 more testing, push for CI 0.10 #6841 check CI results, make PR #19833 0.17 #18882 recheck and apply to blead 0.83 #18534 review and briefly comment 0.52 #19829 testing, review Makefile and make PR #19834 0.98 #19791 review Configure and hints, start on a fix (tests

are slow on qemu)

4.55

2022/06/09 Thursday 0.10 #19797 followup - restart failing CI test (looks like a timing issue) 0.17 #19833 apply to blead, perldelta 0.48 #19795 review and approve 0.53 #19791 rebase, start a(nother) test Configure 0.20 #19834 review discussion and apply to blead, perldelta 0.67 #19826 try on 21H2, still can’t reproduce 0.17 #19791 slight re-work, start another test run 0.72 look over history of requirement for true from required files (goes back to 5.000) 0.37 #19797 check CI results and apply to blead 0.48 #19822 review and approve 0.13 #19820 review (no decision)

0.47 #19791 make a commit, test on amd64 VM, make PR 19843

4.49

2022/06/13 Monday 0.83 review github notifications 0.38 #19847 review and approve 1.65 look at floor/ceil overloading, debug an assert, create

#19857

2.86

2022/06/14 Tuesday 0.40 #19854 review and comment 0.40 #19791 comment 0.28 #19837 review and approve 0.20 #19836 review and approve

1.57 #19846 review, testing

2.85

2022/06/15 Wednesday 0.18 #14448 research and comment 1.02 #19846 look into PERL_MEM_LOG build issues 1.40 #19846 more look into PERL_MEM_LOG build issues, push for CI 0.53 #19861 review and approve 0.22 #19858 review and approve 0.17 #19769 review and approve 0.15 #19755 review, research and comment with suggestion

0.48 #19851 research and comment

4.15

2022/06/16 Thursday 0.08 #19864 apply to blead 0.05 #19755 review new changes and apply to blead 0.87 #19846 look at CopSTASHPV problem, testing and comment 1.02 #19848 review, briefly comment 1.12 research implementation of yield true, comment to list

0.70 #18606 rebase, look over code, testing

3.84

2022/06/20 Monday 0.38 #19870 try to see why it fails, find out, comment 0.82 #19871 try to see why it fails and comment 0.45 cygwin CI setup re-work - use cygwin setup action 3.32 more cygwin CI setup re-work - more use cygwin setup action, try to use standard checkout action but thwarted

by safe directories

4.97

2022/06/21 Tuesday 0.60 #19832 rebase 0.80 cygwin CI setup re-work - retest and make PR #19876 0.27 #19871 review comments and comment 0.22 #19846 review latest and apply to blead

0.87 #19814 review code and comments, comment

2.76

2022/06/22 Wednesday 0.77 #12082 research, write up a simple doc change and make PR #19881 0.27 #19870 review updated version and comment 0.22 #19857 follow-up 0.23 #19876 apply to blead (also some unrelated #p5p discussion) 0.80 #19851 reproduce, work on fixes 0.32 #19851 more, comment

1.32 #18606 more testing

3.93

2022/06/23 Thursday 0.10 review github notifications 1.77 #19857 debugging

2.15 #19857 debugging

4.02

2022/06/27 Monday 0.25 review github notifications 1.28 #19894 review, research and comment, reproduce on DFBSD 5.8, start a bisect 1.33 #19894 review bisect results, try to make a short reproducer, debugging, comment 0.62 #19867 research and comment 0.77 #19857 find immediate cause of parent link not being set,

more to do.

4.25

2022/06/28 Tuesday 0.42 review github notifications 0.67 #19894 test and make a smoke-me branch 0.20 #19896 review 0.13 #19895 testing and comment

1.13 #19857 debugging

2.55

2022/06/29 Wednesday 0.48 #19874 testing, comment 0.97 Karl’s UTF8-API - research and comment

1.77 #19857 more debugging, think I found the cause

3.22

2022/06/30 Thursday 2.48 #19894 debugging, create https://bugs.dragonflybsd.org/issues/3319 work on a SKIP patch, testing, push for smoke-me, comment 0.48 #19903 review, research and comment

0.60 #19901 review, research and comment

3.56 ``` Which I calculate is 72.43 hours.

Approximately 45 tickets were reviewed or worked on, and 10 patches were applied.

Hi there,

Are you a Perl blogger?

The state of Perl blogging is not hidden from anyone. Dave Cross wrote an extensive blog post explaining not just the issues but also suggestions to get around it.

I proposed an idea on my personal twitter handle and asked for public opinion. As of today, it got 22 likes. I know, it isn't big number.

By the way, what was the proposal?

The proposal was to setup dedicated domain (https) powered by GitHub Pages. The static site would be generated by Hugo. It would be open to public to submit blog post as Markdown formatted page as pull request. After a quick review, the post would be live.

Sounds simple, isn't it?

The proposal should be familiar to those who have ever wrote an article for Perl.com. It has the same the process as I mentioned above, I was reminded the same in response to my Twitter post by a friend of mine. It makes me sad to see that the last post on the site was published on 25th May 2021. I came to know about the site for the first time when I found out about the monthly post "What's new on CPAN" by David Farrell. In the early days of my CPAN association, every time I upload a new distribution, I would wait for the article to see if my distribution made it or not. Some of my distributions did appear in the article, just for record. I even did interview series, The Perl Ambassador for the site in the year 2020. I had the honour to interview, Gabor Szabo, Curtis 'Ovid' Poe and Damian Conway. What a shame, I couldn't continue even though I had the list of high profile Perl Ambassadors to interview.

I have mostly blogged on blogs.perl.org. I don't consider myself an active blogger, although I used to blog frequently before. I don't feel comfortable now a days blogging on bpo, so I decided to blog on Perl Weekly Challenge and cross linked on bpo. It is (cross linking) something not approved by many as I understand. I am likely to setup my personal blog site instead, just for Perl. I will share the details when it is live. You are all welcome to contribute.

I am up for new ideas and suggestions too. Please do share if you have one.

Enjoy rest of the newsletter.

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given two positive integers, $n and $k. Write a script to find out the Prime Partition of the given number. No duplicates are allowed.

Solution

use strict;
use warnings;
use boolean;
use Math::Combinatorics;

sub sieve_atkin{
    my($upper_bound) = @_;
    my @primes = (2, 3, 5);
    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 prime_partition{
    my($n, $k) = @_;
    my @partitions;
    my @primes = sieve_atkin($n);
    my $combinations = Math::Combinatorics->new(count => $k, data => [@primes]);
    while(my @combination = $combinations->next_combination()){
        push @partitions, [@combination] if unpack("%32I*", pack("I*", @combination)) == $n;
    }
    return @partitions;
}

MAIN:{
    my($n, $k);
    $n = 18, $k = 2;
    map{ 
        print "$n = " . join(", ", @{$_}) . "\n"
    } prime_partition($n, $k);
    print"\n\n";
    $n = 19, $k = 3;
    map{ 
        print "$n = " . join(", ", @{$_}) . "\n"
    } prime_partition($n, $k);
}

Sample Run

$ perl perl/ch-1.pl
18 = 7, 11
18 = 5, 13


19 = 3, 11, 5

Notes

Only when writing this short blog did I realize there is a far more efficient way of doing this!

Here we see a brute force exhaustion of all possible combinations. This works alright for when $n and $k are relatively small. For larger values a procedure like this would be better,

1. Obtain all primes $p < $n
2. Start with $n and compute $m = $n - $p for all $p
3. If $m is prime and $k = 2 DONE
4. Else set $n = $m and repeat, computing a new $m with all $p < $m stopping with the same criteria if $m is prime and $k is satisfied

This procedure would be a natural fit for recursion, if you were in the mood for that sort of thing.

Part 2

You are given an array of integers. Write a script to compute the five-number summary of the given set of integers.

Solution

use strict;
use warnings;
sub five_number_summary{
    my @numbers = @_;
    my($minimum, $maximum, $first_quartile, $median, $third_quartile);
    my @sorted = sort {$a <=> $b} @numbers;
    $minimum = $sorted[0];
    $maximum = $sorted[@sorted - 1];
    if(@sorted % 2 == 0){
        my $median_0 = $sorted[int(@sorted / 2) - 1];
        my $median_1 = $sorted[int(@sorted / 2)];
        $median = ($median_0 + $median_1) / 2;
        my @lower_half = @sorted[0 .. int(@sorted / 2)];
        my $median_lower_0 = $lower_half[int(@lower_half / 2) - 1];
        my $median_lower_1 = $lower_half[int(@lower_half / 2)];
        $first_quartile = ($median_lower_0 + $median_lower_1) / 2;       
        my @upper_half = @sorted[int(@sorted / 2) .. @sorted];
        my $median_upper_0 = $upper_half[int(@upper_half / 2) - 1];
        my $median_upper_1 = $upper_half[int(@upper_half / 2)];
        $third_quartile = ($median_upper_0 + $median_upper_1) / 2;
    }
    else{
        $median = $sorted[int(@sorted / 2)];
        $first_quartile = [@sorted[0 .. int(@sorted / 2)]]->[int(@sorted / 2) / 2];
        $third_quartile = [@sorted[int(@sorted / 2) .. @sorted]]->[(@sorted - int(@sorted / 2)) / 2];
    }
    return {
        minimum => $minimum, 
        maximum => $maximum, 
        first_quartile => $first_quartile, 
        median => $median, 
        third_quartile => $third_quartile
    };
}

MAIN:{
    my @numbers;
    my $five_number_summary;
    @numbers = (6, 3, 7, 8, 1, 3, 9);
    print join(", ", @numbers) . "\n";
    $five_number_summary = five_number_summary(@numbers);
    map{
        print "$_: $five_number_summary->{$_}\n";
    } keys %{$five_number_summary};
    print "\n\n";
    @numbers = (2, 6, 3, 8, 1, 5, 9, 4);
    print join(", ", @numbers) . "\n";    
    $five_number_summary = five_number_summary(@numbers);
    map{
        print "$_: $five_number_summary->{$_}\n";
    } keys %{$five_number_summary};
    print "\n\n";
    @numbers = (1, 2, 2, 3, 4, 6, 6, 7, 7, 7, 8, 11, 12, 15, 15, 15, 17, 17, 18, 20);
    print join(", ", @numbers) . "\n";      
    $five_number_summary = five_number_summary(@numbers);
    map{
        print "$_: $five_number_summary->{$_}\n";
    } keys %{$five_number_summary};
}

Sample Run

$ perl perl/ch-2.pl
6, 3, 7, 8, 1, 3, 9
third_quartile: 8
maximum: 9
minimum: 1
first_quartile: 3
median: 6


2, 6, 3, 8, 1, 5, 9, 4
median: 4.5
first_quartile: 2.5
minimum: 1
maximum: 9
third_quartile: 7


1, 2, 2, 3, 4, 6, 6, 7, 7, 7, 8, 11, 12, 15, 15, 15, 17, 17, 18, 20
maximum: 20
third_quartile: 15
first_quartile: 5
median: 7.5
minimum: 1

Notes

Note that the case of an even or odd number of elements of the list (and sublists) requires slightly special handling.

References

Challenge 172