Published by Nicholas Hubbard on Wednesday 10 August 2022 17:18
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.
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
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
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.
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
Published by laurent_r on Wednesday 10 August 2022 04:03
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.
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
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
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
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
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
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
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.
Published on Wednesday 10 August 2022 00:00
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.
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 |
Use regular expressions with caution. The complexity of regex carries a cost.
‘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.
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).
Of course, there are times when regular expressions can or should be used in programs:
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)
Regular expressions can be extremely powerful for quickly solving problems for yourself, where future maintenance is not a concern. E.g.:
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:
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.
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$"
| .
| 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 |
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.
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"): ..
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"))
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): ..
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)
That is all I have for now. If you want to learn more, there’s are a lot of useful resources out there:
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.
Published by Gabor Szabo on Monday 08 August 2022 08:17
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.
Write a script to find the smallest integer x such that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each other.
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";
}
$ perl perl/ch-1.pl
142857
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!
Write a script to find out all Reversible Numbers below 100.
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";
}
$ 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
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!
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.
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.
$ ./ch-1.py
142857
$ ./ch-1.pl
142857
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.
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.
$ ./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
Published by laurent_r on Sunday 07 August 2022 03:08
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.
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.
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.
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.
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
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
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.
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
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).
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
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
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
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
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
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.
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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.
Published by Unknown on Saturday 06 August 2022 23:15
Published by Unknown on Saturday 06 August 2022 23:12
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:
Increasing its reputation:
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
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
Implementation | Rate |
---|---|
sub { 1 } | 294117647.06/sec |
sub { m/ .? /smx } | 21645021.65/sec |
sub { m/ .{0} /smx } | 21598272.14/sec |
sub { m/ (*ACCEPT) /smx } | 20964360.59/sec |
sub { m/ (?) /smx } | 20876826.72/sec |
sub { m/ \A /smx } | 20746887.97/sec |
sub { m/ (?:) /smx } | 20618556.70/sec |
sub { m/ ^ /smx } | 20618556.70/sec |
qr/ (?) /smx | 2344665.89/sec |
qr/ (?:) /smx | 2344116.27/sec |
qr/ ^ /smx | 2336448.60/sec |
qr/ \A /smx | 2315350.78/sec |
qr/ .? /smx | 2208968.41/sec |
qr/ .{0} /smx | 2180074.12/sec |
qr/ (*ACCEPT) /smx | 1717327.84/sec |
Somewhat to my surprise, the subroutine-reference implementation was an
order of magnitude faster than the regular-expression-reference implementation.
I expected that, Regexp
s 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,
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
Published by Nicholas Hubbard on Wednesday 03 August 2022 23:03
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.
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.
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
.
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;
}
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.
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.
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);
}
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.
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.
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
Published by Jason A. Crome on Wednesday 03 August 2022 21:15
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 function
S_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.
Published by Jason A. Crome on Monday 01 August 2022 21:06
The Grants Committee has concluded voting on the July 2022 round. One grant request was submitted:
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!
Published by Yuki Kimoto on Monday 01 August 2022 04:45
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.
JSON - JSONMath - 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
Published by perlancar on Monday 01 August 2022 00:37
dist | author | first_version | latest_version | abstract |
---|---|---|---|---|
Alien-Tar-Size | GAHAYES | v0.1.0 | v0.2.0 | tar LD_PRELOAD hack to compute size of tar file without reading and writing, provided as Alien package |
Alien-libFLAC | GAHAYES | v0.1.0 | v0.2.0 | find or build and install libFLAC with development dependencies |
AnyEvent-SNMP-TrapReceiver | NABOJ | 0.15 | 0.16 | SNMP trap receiver by help of AnyEvent |
App-Changelord | YANICK | v0.0.1 | 0.0.2 | cli-based changelog manager |
App-Git-Perl | NHRNJICA | v0.1.0 | v0.1.15 | adds custom git command "git perl" to make it easier to monitor latest changes in perl modules, and make you collaborate faster. |
App-JYJ | INGY | 0.0.1 | 0.0.2 | Convert JSON to YAML to JSON to… |
App-KamstrupKemSplit | HOLLIE | 0.001 | 0.004 | Helper functions for the Kamstrup KEM file splitter application |
App-MHFS | GAHAYES | v0.4.0 | v0.4.1 | A Media HTTP File Server. Stream your own music and video library via your browser and standard media players. |
App-diff2vba | UTASHIRO | 0.99 | 0.99 | generate VBA patch script from diff output |
Array-Util-Shuffle | PERLANCAR | 0.004 | 0.004 | Shuffle an array |
Author-Daemon-DockerMetaBundle | DAEMON | 1 | 1 | A meta bundle that is used in the creation of a docker image. |
Bencher-Scenario-PERLANCAR-Tree-Examples | PERLANCAR | 0.031 | 0.031 | Benchmark PERLANCAR::Tree::Examples |
Bencher-Scenario-shuffle | PERLANCAR | 0.001 | 0.001 | Benchmark various algorithms & implementation of shuffle |
Bencher-Scenarios-Array-Sample-WeightedRandom | PERLANCAR | 0.001 | 0.001 | Scenarios to benchmark Array::Sample::WeightedRandom |
CatalystX-ControllerPerContext | JJNAPIORK | 0.001 | 0.001 | Map body and data parameters to a model |
CatalystX-RequestModel | JJNAPIORK | 0.001 | 0.007 | Map body and data parameters to a model |
Digest-BLAKE3 | BLGL | 0.002 | 0.002 | Perl extension for the BLAKE3 hash function |
Dist-Zilla-Plugin-Authors | JOENIO | 0.1.0 | 0.1.0 | Build AUTHORS file from Git history |
Dist-Zilla-Plugin-PruneAliases | AJNN | 1.00 | 1.00 | Prune macOS aliases from your dist |
Earth | AWNCORP | 0.01 | 0.04 | FP Library for Perl 5 |
Hashest | LSKATZ | v0.3.1 | v0.5.1 | |
Image-GIF-Encoder-PP | GAHAYES | v0.1.0 | v0.1.0 | Pure perl GIF encoding |
Linux-WireGuard | FELIPE | 0.01_90 | 0.03 | WireGuard in Perl |
Linux-Wireguard | FELIPE | 0.01 | 0.01 | Wireguard in Perl |
MHFS-XS | GAHAYES | v0.2.0 | v0.2.2 | XS extension module for Media HTTP File Server, for server side media encoding. |
Mac-Alias | AJNN | 1.00 | 1.01 | Read or create macOS alias files |
Mars | AWNCORP | 0.01 | 0.04 | OO Framework |
Math-Abacus | CYFUNG | 0.01 | 0.04 | A toy model of Chinese abacus |
Math-Notation-PostfixInfix | CCELSO | v2022.035.1 | v2022.035.1 | Perl extension for Math Postfix and Infix Notation |
Net-LibNFS | FELIPE | 0.01_01 | 0.02 | User-land NFS in Perl via libnfs |
PDL-IO-Touchstone | EWHEELER | 1.001 | 1.001 | |
Perl-Critic-Dancer2 | GEEKRUTH | 0.4000 | 0.4100 | A collection of handy perlcritic modules for Dancer2 |
PlayStation-MemoryCard | GAHAYES | v0.2.0 | v0.2.0 | Utilities for working with PlayStation memory card and save files |
RT-Extension-CopySubjectButton | AVERKIOS | 0.01 | 0.03 | RT-Extension-CopySubjectButton Extension |
Regexp-From-String | PERLANCAR | 0.001 | 0.001 | Convert '/…/' or 'qr(…)' into Regexp object |
Rofi-Script | STEWBEEF | 0.001 | 1.221970 | perl interface to the rofi menu |
SPVM-Cwd | KIMOTO | 0.01 | 0.02 | get pathname of current working directory |
SPVM-Digest-MD5 | KIMOTO | 0.01 | 0.06 | SPVM interface to the MD5 Algorithm |
SPVM-Digest-SHA | KIMOTO | 0.01 | 0.01 | SPVM extension for SHA-1/224/256/384/512 |
SPVM-Errno | KIMOTO | 0.01 | 0.04 | Error Number |
Sah-PSchemas-Re | PERLANCAR | 0.001 | 0.001 | Various regular-expression (parameterized) schemas |
Search-Fzf | LIYAO | 0.01 | 0.01 | Ported Fzf using perl. |
Software-Copyright | DDUMONT | 0.001 | 0.003 | Copyright class |
StandupGenerator | JTREEVES | 0.1 | 0.5 | Package to create and manage daily standup files |
Storable-Improved | JDEGUEST | v0.1.0 | v0.1.3 | Storable improved with core flaws mitigated |
Tags-HTML-Login-Button | SKIM | 0.01 | 0.01 | Tags helper for login button. |
Term-Graille | SAIFTYNET | 0.03 | 0.071 | Terminal Graphics using Braille |
Test-DBIC-Pg | ABELTJE | 0.99_01 | 0.99_01 | Connect to and deploy a DBIx::Class::Schema on Postgres |
Test-JSON-Type | SKIM | 0.01 | 0.04 | Test JSON data with types. |
Test-More-Bash | INGY | 0.0.1 | 0.0.3 | Write Perl tests in Bash |
Test-More-YAMLScript | INGY | 0.0.1 | 0.0.5 | Write Perl tests in YAMLScript |
Test-YAFT | BARNEY | 1.0.0 | 1.0.1 | Yet another testing framework |
Try-ALRM | OODLER | 0.1 | 0.6 | Provides alarm semantics similar to Try::Catch. |
Twitter-ID | AJNN | 1.00 | 1.00 | Parse the date from a Twitter Snowflake ID |
Type-Library-Compiler | TOBYINK | 0.001 | 0.007 | compile a bunch of type constraints into a library with no non-core dependencies |
UID2-Client | JIRO | 0.01 | 0.01 | Unified ID 2.0 Perl Client |
UID2-Client-XS | JIRO | 0.01 | 0.01 | Unified ID 2.0 Client for Perl (binding to the UID2 C++ library) |
URI-PackageURL | GDT | 1.00 | 1.02 | Perl extension for Package URL (aka "purl") |
URN-OASIS-SAML2 | WATERKIP | 0.001 | 0.003 | Constants for urn:oasis SAML2 implementations |
WebFetch-Input-Atom | IKLUFT | 0.1.0 | 0.1.0 | get headlines for WebFetch from Atom feeds |
WebFetch-Input-RSS | IKLUFT | 0.1.0 | 0.1.0 | get headlines for WebFetch from RSS feed |
WebFetch-Output-TT | IKLUFT | 0.1.0 | 0.1.0 | save data from WebFetch via the Perl Template Toolkit |
WebFetch-Output-TWiki | IKLUFT | 0.1.0 | 0.1.0 | save data from WebFetch into a TWiki web site |
YAMLScript | INGY | 0.0.1 | 0.0.16 | YAML as a Programming Language |
YAMLTest | INGY | 0.0.1 | 0.0.4 | Write tests in YAMLScript |
builtin-compat | HAARG | 0.001000 | 0.001002 | Provide builtin functions for older perl versions |
builtins | DCONWAY | 0.000002 | 0.000005 | Install all the new builtins from the builtin namespace |
builtins-compat | TOBYINK | 0.001 | 0.004 | install all the new builtins from the builtin namespace (Perl 5.36+), and try our best on older versions of Perl |
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:
No | Author | Distributions |
---|---|---|
1 | GAHAYES | 6 |
2 | PERLANCAR | 6 |
3 | INGY | 5 |
4 | IKLUFT | 4 |
5 | KIMOTO | 4 |
6 | FELIPE | 3 |
7 | AJNN | 3 |
8 | TOBYINK | 2 |
9 | JJNAPIORK | 2 |
10 | AWNCORP | 2 |
11 | JIRO | 2 |
12 | SKIM | 2 |
13 | GEEKRUTH | 1 |
14 | DAEMON | 1 |
15 | JTREEVES | 1 |
16 | EWHEELER | 1 |
17 | NABOJ | 1 |
18 | WATERKIP | 1 |
19 | JDEGUEST | 1 |
20 | BARNEY | 1 |
21 | CYFUNG | 1 |
22 | UTASHIRO | 1 |
23 | HAARG | 1 |
24 | DCONWAY | 1 |
25 | ABELTJE | 1 |
26 | HOLLIE | 1 |
27 | DDUMONT | 1 |
28 | YANICK | 1 |
29 | JOENIO | 1 |
30 | OODLER | 1 |
31 | STEWBEEF | 1 |
32 | GDT | 1 |
33 | BLGL | 1 |
34 | LSKATZ | 1 |
35 | NHRNJICA | 1 |
36 | CCELSO | 1 |
37 | AVERKIOS | 1 |
38 | LIYAO | 1 |
39 | SAIFTYNET | 1 |
Published by laurent_r on Sunday 31 July 2022 20:45
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.
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
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
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
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
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
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
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).
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.
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.
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).
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%.
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.
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
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.
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).
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
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
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
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).
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.
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
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.
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
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).
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.
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
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
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
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
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
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
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.
Published by Gabor Szabo on Sunday 31 July 2022 08:30
Part of the Dancer2 video course available both to Pro subscribers and attendees of the Perl Dancer course on Leanpub.
Published by Unknown on Saturday 30 July 2022 21:42
Published by Unknown on Saturday 30 July 2022 21:40
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:
Increasing its reputation:
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Write a script to list the last sunday of every month in the given year.
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";
}
$ 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
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.
Write a script to generate the first 20 Perfect Totient Numbers.
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";
}
$ 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
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
!
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.
Write a script to generate the first 19 Disarium Numbers.
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";
}
$ perl perl/ch-1.pl
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798
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;
}
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.
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";
}
$ perl perl/ch-2.pl
[1, 0, 2] has rank 2
[0, 1, 2] has permutation at rank 1 --> [0, 2, 1]
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.
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.
Published by Dave Rolsky on Tuesday 19 July 2022 14:39
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.
You are given a positive integer, $n. Write a script to find out if the given number is an Esthetic Number.
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);
}
$ perl perl/ch-1.pl
5456 is esthetic
120 is not esthetic
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?
Write a script to generate first 10 members of Sylvester's sequence.
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";
}
$ perl perl/ch-2.pl
2, 3, 7, 43, 1807, 3263443, 10650056950807, 113423713055421844361000443, 12864938683278671740537145998360961546653259485195807, 165506647324519964198468195444439180017513152706377497841851388766535868639572406808911988131737645185443
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.
Part of the Dancer2 video course available both to Pro subscribers and attendees of the Perl Dancer course on Leanpub.
Published by Jason A. Crome on Monday 11 July 2022 20:21
John Napiorkowski
The minimum budget for this project is $8,800 USD
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.
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.
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.
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:
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.
This grant is deemed complete when all the above-listed deliverables are reviewed and accepted by the official TPF-assigned grant manager.
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.
Published by Jason A. Crome on Monday 11 July 2022 18:35
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
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
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
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
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.
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
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)
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
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
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
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
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
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
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
3.93
2022/06/23 Thursday 0.10 review github notifications 1.77 #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,
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
2.55
2022/06/29 Wednesday 0.48 #19874 testing, comment 0.97 Karl’s UTF8-API - research and comment
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
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.
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.
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);
}
$ perl perl/ch-1.pl
18 = 7, 11
18 = 5, 13
19 = 3, 11, 5
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.
You are given an array of integers. Write a script to compute the five-number summary of the given set of integers.
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};
}
$ 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
Note that the case of an even or odd number of elements of the list (and sublists) requires slightly special handling.