If you’ve never worked with MooX::Role::Parameterized or MooseX::Role::Parameterized, you might wonder what is a parameterized role at all?
Roles are used when you need to share behaviour among several classes that don’t have to be related by inheritance. Normally, a role just adds a bunch of methods to the class that consumes it (there’s more, you can for example specify which other methods the role expects to already exist).
A parameterized role makes it possible to provide parameters for the consumed role. This way, you can adjust the behaviour for each consuming class.
]]> The old syntaxThe standard syntax to apply a role to a class before version 0.100 of the module was to use the apply
class method:
# My/Role.pm
package My::Role;
use Moo::Role;
use MooX::Role::Parameterized;
role {
my ($params, $mop) = @_;
$mop->has($params->{name} => is => $params->{is});
}
# My/Obj.pm
package My::Obj;
use Moo;
use My::Role;
'My::Role'->apply({
name => 'size',
is => 'ro',
});
If we now created an object $o
using my $o = 'My::Obj'->new(size => 2)
, we could get the value of the attribute size
using the $o->size
getter: the role created a new read-only attribute size
for us.
What I didn’t like about applying a role to a class the old standard way was it wasn’t declarative. You could easily overlook it as a block of code happening at runtime, while the meaning of the code was This is how a role is consumed. Therefore, I used the alternative experimental syntax:
package My::Obj;
use Moo;
use MooX::Role::Parameterized::With 'My::Role' => {
name => 'size',
is => 'ro',
};
It's part of a use
clause, so it’s clear that it’s happening at compile time.
I promoted one of my side-jobs to a full-time job recently. They gave me a new computer where I had to install all my code base to start working on it 8 hours a day instead of a couple a month.
Imagine my surprise when the code stopped with an error:
Can't locate object method "size" via package "My::Obj" at ./run.pl line 37.
Line 37 was where I called $o->size
!
When installing the dependencies for my code, the most recent version of MooX::Role::Parameterized
was installed from CPAN (0.501). The experimental syntax is no longer documented and as I found out, doesn’t work anymore.
The old non-experimental syntax still works, but there’s a new syntax, too. It uses the with
keyword that looks like the one that can be used to consume a Moo::Role, but if we first use MooX::Role::Parameterized::With
, it can also accept parameters for the role application.
package My::Obj;
use Moo;
use MooX::Role::Parameterized::With;
with 'My::Role' => {
name => 'size',
is => 'ro',
};
Moreover, we should change the definition of the role, too. Parameters should be predeclared using the parameter
keyword (similarly to MooseX::Role::Parameterized), and they can be then accessed via getters instead of peeking inside a parameter hash reference.
package My::Role;
use Moo::Role;
use MooX::Role::Parameterized;
parameter name => (is => 'ro');
parameter is => (is => 'ro');
role {
my ($params, $mop) = @_;
$mop->has($params->name => is => $params->is);
}
]]>
use Bio::AlignIO;
my $in = Bio::AlignIO->new(
-file => $inputfilename ,
-format => 'fasta',
);
while ( my $aln = $in->next_aln() ) {
foreach my $seq ($aln->each_seq) {
...; # do some thing
}
}
Bio::Perl is a famous library for managing bioinformatics data, although all knowledge mentioned here can fetch from documents on cpan or Bio::Perl webpages, but I believe there can be numerous articles to explain the same thing. :)
The most difficult aspect for me is understanding which classes' documentation should I read, which object will be generated? and then, which method on which object do I need to invoke for the data I wanted?
so let me descript how a Bio::AlignIO object formed.
Bio::AlignIO
object can contain multiple alignments.
Bio::SimpleAlign
contains one alignment.
Bio::LocatableSeq
contains one aligned sequence.
For example, let's presume I have a file containing COI alignment for ten samples. If I use this file to call Bio::AlignIO->new()
, the new Bio::AlignIO
object will contain only one Bio::SimpleAlign
object which contains this COI alignment. Then, the Bio::SimpleAlign
object contains ten Bio::LocatableSeq
objects for aligned COI sequences of each sample.
one alignment is tranditional one gene or multiple genes alignment, e.g., a COI alignment in here. Usually this type of alignment data is stored one file like phylip, nexus or fasta. but Bio::AlignIO
can manage blast output, too. so Authors keep the ability of contain multiple alignments in one Bio::AlignIO
object. In my condition, I just directly get first Bio::SimpleAlign
from it.
Today I just wanted to retrieve the sequences of each sample in my alignment file (fasta) and import them into Perl. To achieve this, first, we need to call the new method to create a new Bio::AlignIO
object, using the alignment file as an argument:
my $in = Bio::AlignIO->new(
-file => $inputfilename,
-format => 'fasta',
);
Then, we want to extract Bio::SimpleAlign
objects from the Bio::AlignIO
object. For convenience, we use the same method as described in the Bio::AlignIO
documentation. We use a while loop to iterate through each Bio::SimpleAlign
object contained in the Bio::AlignIO
object (although we know there is only one):
while ( my $aln = $in->next_aln() ) { ... ;}
Now, we need to extract Bio::LocatableSeq
objects from Bio::SimpleAlign
. Calling the each_seq()
method of Bio::SimpleAlign
allows us to retrieve Bio::LocatableSeq
objects, each storing a sequence:
foreach my $seq ($aln->each_seq) { ...; }
At this point, we're nearly done. Simply by calling the seq()
and id()
methods of Bio::LocatableSeq
objects, we can obtain the sequence ID and the actual sequence data. For instance, to print out the base pairs of each sequence:
foreach my $seq ($aln->each_seq) {print $seq->seq(), "\n"}
References:
]]>In absence of many other pressing issues, we spent some time thinking ahead to large-scale development work that might take place in the 5.41 series. We talked about “hooks” as a potential long-term thought to making a more powerful Magic-like structure, for implementing new features, attributes, etc..
]]>Spoiler Alert: This weekly challenge deadline is due in a couple of days from now (on March 3, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given an array of integers, @int
and an integer $k
.
Write a script to find the sum of values whose index binary representation has exactly $k
number of 1-bit set.
Example 1
Input: @ints = (2, 5, 9, 11, 3), $k = 1
Output: 17
Binary representation of index 0 = 0
Binary representation of index 1 = 1
Binary representation of index 2 = 10
Binary representation of index 3 = 11
Binary representation of index 4 = 100
So the indices 1, 2 and 4 have total one 1-bit sets.
Therefore the sum, $ints[1] + $ints[2] + $ints[4] = 17
Example 2
Input: @ints = (2, 5, 9, 11, 3), $k = 2
Output: 11
Example 3
Input: @ints = (2, 5, 9, 11, 3), $k = 0
Output: 2
Although it could easily be done in a one-liner, I've decided to split the solution in two statements, for the sake of clarity. The first statement finds the indexes whose binary representation contains exactly $k
"1" (sum of digits equal to $k
) and populates the @eligibles
array with the corresponding input values in @in
. The second statement simply returns the sum oh those values.
sub sum-of-values ($k, @in) {
my @eligibles = map { @in[$_] },
grep {$_.base(2).comb.sum == $k}, 0..@in.end;
return @eligibles.sum;
}
my @tests = (1, <2 5 9 11 3>),
(2, <2 5 9 11 3>),
(0, <2 5 9 11 3>);
for @tests -> @test {
printf "%-15s => ", "@test[]";
say sum-of-values @test[0], @test[1];
}
This program displays the following output:
$ raku ./sum-of-values.raku
1 2 5 9 11 3 => 17
2 2 5 9 11 3 => 11
0 2 5 9 11 3 => 2
This is a port to Perl of the above Raku program. I counted the number of "1" using the tr///
operator because has no built-in sum
function, only to find moments later that I needed to implement a sum
subroutine anyway.
use strict;
use warnings;
use feature 'say';
sub sum {
my $sum = 0;
$sum += $_ for @_;
return $sum;
}
sub sum_of_values {
my ($k, @in) = @_;
my @eligibles = map { $in[$_] }
grep {sprintf ("%b", $_) =~ tr/1/1/ == $k} 0..$#in;
return sum @eligibles;
}
my @tests = ( [1, [<2 5 9 11 3>]],
[2, [<2 5 9 11 3>]],
[0, [<2 5 9 11 3>]] );
for my $test (@tests) {
printf "%-3s - %-15s => ", "$test->[0]", "@{$test->[1]}";
say sum_of_values $test->[0], @{$test->[1]};
}
This program displays the following output:
$ perl ./sum-of-values.pl
1 - 2 5 9 11 3 => 17
2 - 2 5 9 11 3 => 11
0 - 2 5 9 11 3 => 2
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 March 10, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>Further chats on allowing a subsequent use VERSION
of the same value as is already prevailing
We continued going through the bug list to tag release blockers
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on March 3, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given a array of positive integers, @ints
.
Write a script to find out how many integers have even number of digits.
Example 1
Input: @ints = (10, 1, 111, 24, 1000)
Output: 3
There are 3 integers having even digits i.e. 10, 24 and 1000.
Example 2
Input: @ints = (111, 1, 11111)
Output: 0
Example 3
Input: @ints = (2, 8, 1024, 256)
Output: 1
We use the chars
function to count the characters of each integer, grep
with the %
modulo oprator to filter the counts that are even, and finally the elems
method to count the integers satisfying the desired condition. Altogether, a nice little oner-liner.
sub count-even-digits-ints (@in) {
(grep { .chars %% 2 }, @in).elems;
}
my @tests = <10 1 111 24 1000>, <111 1 11111>, <2 8 1024 256>;
for @tests -> @test {
printf "%-20s => ", "@test[]";
say count-even-digits-ints @test;
}
This program displays the following output:
$ raku ./count-even-digits.raku
10 1 111 24 1000 => 3
111 1 11111 => 0
2 8 1024 256 => 1
This is a port to Perl of the above Raku program, using scalar
and length
to replace elems
and chars
. Also a concise one-liner.
use strict;
use warnings;
use feature 'say';
sub count_even_digits_ints {
scalar grep { ! (length($_) % 2) } @_;
}
my @tests = ( [<10 1 111 24 1000>],
[<111 1 11111>], [<2 8 1024 256>] );
for my $test (@tests) {
printf "%-20s => ", "@$test";
say count_even_digits_ints @$test;
}
This program displays the following output:
$ perl ./count-even-digits.pl
10 1 111 24 1000 => 3
111 1 11111 => 0
2 8 1024 256 => 1
Again, a port of the two previous programs to Julia. The only significant difference is that we need to explicitly convert integers to strings to be able to find their length (number of characters).
using Printf
function count_even_digits_ints(invals)
evens = filter(x -> (mod(length(string(x)), 2 ) == 0), invals)
return size(evens, 1)
end
tests = [ [100, 1, 111, 424, 1000],
[111, 1, 11111], [2, 8, 1024, 256] ]
for test in tests
@printf "%-25s => " "$test"
println("$(count_even_digits_ints(test))")
end
This program displays the following output:
$ julia count-even-digits.jl
[100, 1, 111, 424, 1000] => 1
[111, 1, 11111] => 0
[2, 8, 1024, 256] => 1
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 March 10, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>click here to submit your abstract
You may submit your Science Track abstracts here! Don't wait, do this today! Prior registration to the Perl Conference is not a condition for acceptance, however individuals with accepted papers and posters are expected to register for and attend the Conference in person*. You may register for the Perl & Raku Conference here. (Note: in the past, the Conference registration fee has been waived for speakers; it is expected that this will be the case again this year, but at this time there are no guarantees.)
Deadlines:
When preparing your abstract, please bear in mind that the Science Perl Editorial Review Subcommittee is comprised of community members with a very wide range of scientific backgrounds, and any of them may be assigned to review your abstract and subsequent papers. When describing the goals of your paper, as well as the tools and approaches you use, write your abstract in such a way that it is informative to people working in the same or related fields, and understandable to a scientifically literate lay reader.
For more info, contact: science AT perlcommunity DOT org
Main conference site and registration links are at https://tprc.us/tprc-2024-las/.
]]>Warning: I wrote the program below and this blog post from an hospital bed in a heart intensive care unit. I think my mind is clear, but there may very well be a better way to solve the task. Also, I do not have the energy to port this Raku program to other languages, nor to provide lengthy explanations.
Given a matrix M, check whether the matrix is in reduced row echelon form.
A matrix must have the following properties to be in reduced row echelon form:
1. If a row does not consist entirely of zeros, then the first
nonzero number in the row is a 1. We call this the leading 1.
2. If there are any rows that consist entirely of zeros, then
they are grouped together at the bottom of the matrix.
3. In any two successive rows that do not consist entirely of zeros,
the leading 1 in the lower row occurs farther to the right than
the leading 1 in the higher row.
4. Each column that contains a leading 1 has zeros everywhere else
in that column.
For example:
[
[1,0,0,1],
[0,1,0,2],
[0,0,1,3]
]
The above matrix is in reduced row echelon form since the first nonzero number in each row is a 1, leading 1s in each successive row are farther to the right, and above and below each leading 1 there are only zeros.
*For more information check out this wikipedia article.
Example 1
Input: $M = [
[1, 1, 0],
[0, 1, 0],
[0, 0, 0]
]
Output: 0
Example 2
Input: $M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0],
[0, 0, 0, 0, 0]
]
Output: 1
Example 3
Input: $M = [
[1, 0, 0, 4],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 1
Example 4
Input: $M = [
[0, 1,-2, 0, 1],
[0, 0, 0, 0, 0],
[0, 0, 0, 1, 3],
[0, 0, 0, 0, 0]
]
Output: 0
Example 5
Input: $M = [
[0, 1, 0],
[1, 0, 0],
[0, 0, 0]
]
Output: 0
Example 6
Input: $M = [
[4, 0, 0, 0],
[0, 1, 0, 7],
[0, 0, 1,-1]
]
Output: 0
sub is-first-echelon (@mat) {
my @leading;
for 0..@mat.end -> $i {
my @row = |@mat[$i];
for 0..@row.end -> $j {
next if @row[$j] == 0;
if @row[$j] == 1 {
@leading[$i] = $j;
last;
} else {
}
}
@leading[$i] = Inf unless defined @leading[$i];
}
return False unless [<] grep { $_ < Inf }, @leading; # rules 2 and 3
return False unless [<=] @leading;
for 0..@leading.end -> $i {
last if @leading[$i] == Inf;
next unless defined @leading[$i];
for 0..@mat.end -> $k {
next if $i == @leading[$k];
return False if @mat[$k][$i] != 0;
}
}
return True;
}
my @tests =
[ [1,0,0,1], [0,1,0,2], [0,0,1,3]],
[ [1, 1, 0], [0, 1, 0], [0, 0, 0]],
[ [0, 1,-2, 0, 1], [0, 0, 0, 1, 3], [0, 0, 0, 0, 0], [0, 0, 0, 0, 0]],
[ [1, 0, 0, 4], [0, 1, 0, 7], [0, 0, 1,-1]],
[ [0, 1,-2, 0, 1], [0, 0, 0, 0, 0], [0, 0, 0, 1, 3], [0, 0, 0, 0, 0]],
[ [0, 1, 0], [1, 0, 0], [0, 0, 0]],
[ [4, 0, 0, 0], [0, 1, 0, 7], [0, 0, 1,-1]];
for @tests -> @test {
printf "%-20s => ", "@test[0] ...";
say is-first-echelon @test;
}
This program displays the following output:
$ raku ./first-echelon.raku
1 0 0 1 ... => True
1 1 0 ... => False
0 1 -2 0 1 ... => True
1 0 0 4 ... => True
0 1 -2 0 1 ... => False
0 1 0 ... => False
4 0 0 0 ... => False
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 March 3, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>A few people asked me about the distinctions between YAPC::Japan and other Perl events worldwide, prompting me to write below. Before delving into the specifics, I must preface that my experience is primarily rooted in YAPC::Hiroshima 2024, the only YAPC::Japan event I attended. It's important to say that comparing Perl events across different regions isn't about establishing superiority or inferiority; organizing conferences requires considerable resources and effort irrespective of location. Each conference has its unique approach and metrics for success. The observations I offer are purely subjective and reflect my personal views.
Size
Name
Donations
Structure
Volunteers
Minute-by-minute schedule
Sponsorship
Ticket pricing
Demographics
Alcohol
Post-event "YAYAPC" (Yet Another YAPC)
Other
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 25, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given a array of integers, @ints
.
Write a script to find out how many integers are smaller than current i.e. foreach ints[i]
, count ints[j] < ints[i]
where i != j
.
Example 1
Input: @ints = (5, 2, 1, 6)
Output: (2, 1, 0, 3)
For $ints[0] = 5, there are two integers (2,1) smaller than 5.
For $ints[1] = 2, there is one integer (1) smaller than 2.
For $ints[2] = 1, there is none integer smaller than 1.
For $ints[3] = 6, there are three integers (5,2,1) smaller than 6.
Example 2
Input: @ints = (1, 2, 0, 3)
Output: (1, 2, 0, 3)
Example 3
Input: @ints = (0, 1)
Output: (0, 1)
Example 4
Input: @ints = (9, 4, 9, 2)
Output: (2, 1, 2, 0)
First, we don't really care of the requirement that i != j
, because, if i == j
, there is no way we could have ints[j] < ints[i]
.
One thing that we could do is to sort the input data and build a structure (e.g. a hash) mapping each number of the input with its rank in the sorted array. This would give us directly the number of items less than any given item. That would work well with all four examples provided, but it might fail to provide the correct answer when the input contains duplicates. Since dealing with duplicates isn't so easy, it will be simpler to use brute-force nested loops.
As said above, we simply implement two nested for
loops, count the number of items less than the current one and store the counts in the @result
array.
sub count-smaller (@in) {
my @result;
for @in -> $i {
my $count = 0;
for @in -> $j {
$count++ if $j < $i;
}
push @result, $count;
}
return @result;
}
my @tests = <5 2 1 6>, <1 2 0 3>, <0 1>, <9 4 9 2>;
for @tests -> @test {
printf "%-12s => ", "@test[]";
say count-smaller @test;
}
This program displays the following output:
$ raku ./smaller-than-current.raku
5 2 1 6 => [2 1 0 3]
1 2 0 3 => [1 2 0 3]
0 1 => [0 1]
9 4 9 2 => [2 1 2 0]
This is a port to Perl of the above Raku program:
use strict;
use warnings;
use feature 'say';
sub count_smaller {
my @in = @_;
my @result;
for my $i (@in) {
my $count = 0;
for my $j (@in) {
$count++ if $j < $i;
}
push @result, $count;
}
return @result;
}
my @tests = ([<5 2 1 6>], [<1 2 0 3>], [<0 1>], [<9 4 9 2>]);
for my $test (@tests) {
printf "%-12s => ", "@$test";
say join " ", count_smaller @$test;
}
This program displays the following output:
$ perl ./smaller-than-current.pl
5 2 1 6 => 2 1 0 3
1 2 0 3 => 1 2 0 3
0 1 => 0 1
9 4 9 2 => 2 1 2 0
This is a port to Julia of the above Raku and Perl programs:
using Printf
function count_smaller(input)
result = []
for i in input
count = 0
for j in input
if j < i
count += 1
end
end
push!(result, count)
end
return join(result, " ");
end
tests = [ [5, 2, 1, 6], [1, 2, 0, 3], [0, 1], [9, 4, 9, 2] ]
for test in tests
@printf "%-15s => " "$test"
println("$(count_smaller(test))")
end
This program displays the following output:
$ julia ./smaller-than-current.jl
[5, 2, 1, 6] => 2 1 0 3
[1, 2, 0, 3] => 1 2 0 3
[0, 1] => 0 1
[9, 4, 9, 2] => 2 1 2 0
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 March 3, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>Repost from, https://news.perlfoundation.org/post/cfp2024
You can submit your talk Ideas at https://tprc.us/talks Talk submission deadline is April 5th, Midnight UTC. Talks must be given live and in-person. If you are looking for any talk ideas, try out the conference wiki.
New this year, we are accepting submissions for a peer reviewed Science track. Those talks should be submitted at https://science.perlcommunity.org/
Visit the TPRC 2024 website at https://tprc.us/ Follow us on Twitter: @PerlConferences Like us on Facebook: The Perl Foundation (@tpf.perl) Subscribe to the mailing list: https://tprc.us/subscribe
Any questions about the Science Track should be directed to "science at perlcommunity.org" or visit us at #science on irc.perl.org.
Looking forward to seeing all the submissions!
Cheers,
Brett Estrade (OODLER)
Chairman, Science Perl Committee
]]>Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 18, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given two strings, $str1
and $str2
.
Write a script to merge the given strings by adding in alternative order starting with the first string. If a string is longer than the other then append the remaining at the end.
Example 1
Input: $str1 = "abcd", $str2 = "1234"
Output: "a1b2c3d4"
Example 2
Input: $str1 = "abc", $str2 = "12345"
Output: "a1b2c345"
Example 3
Input: $str1 = "abcde", $str2 = "123"
Output: "a1b2c3de"
For such a task, the first thing that comes to mind in Raku is to use the built-in zip routine, which iterates through each of the input lists synchronously, 'Zipping' them together, so that elements are grouped according to their input list index, in the order that the lists are provided. The slight problem, though, is that, if the input lists have an unequal number of elements, then zip
terminates once the shortest input list is exhausted, and trailing elements from longer input lists are discarded. This is not what we want here, since the task says: "If a string is longer than the other, then append the remaining at the end." We could still use zip
and add at the end the left-overs from the longer list, but we can do better.
Raku has another built-in similar routine, roundrobin, which does not terminate once one or more of the input lists become exhausted, but proceeds until all elements from all lists have been processed. This is exactly what we need here, and the work is done with just one code-line.
sub merge-strings ($str1, $str2) {
my $res = join "", roundrobin $str1.comb, $str2.comb, :slip;
return $res;
}
my @tests = <abcd 1234>, <abc 12345>, <abcde 123>;
for @tests -> @test {
printf "%-12s => ", "@test[]";
say merge-strings @test[0], @test[1];
}
This program displays the following output:
$ raku ./merge-strings.raku
abcd 1234 => a1b2c3d4
abc 12345 => a1b2c345
abcde 123 => a1b2c3de
Perl doesn't have built-in routines such as zip
or roundrobin
, so we need to build the result manually. We loop over the indexes of the longer list and add the items from both lists (or an empty string if a value is not defined for a given index).
use strict;
use warnings;
use feature 'say';
sub merge_strings {
my ($str1, $str2) = @_;
my @let1 = split //, $str1;
my @let2 = split //, $str2;
my $end = scalar @let1 > scalar @let2 ? $#let1 : $#let2;
my @result = map { ($let1[$_] // "") .
($let2[$_] // "") } 0..$end;
return join "", @result;
}
my @tests = ([<abcd 1234>], [<abc 12345>], [<abcde 123>]);
for my $test (@tests) {
printf "%-12s => ", "@$test";
say merge_strings $test->[0], $test->[1];
}
This program displays the following output:
$ perl ./merge-strings.pl
abcd 1234 => a1b2c3d4
abc 12345 => a1b2c345
abcde 123 => a1b2c3de
Yet a slightly different method. We loop over the indexes of the shorter list and add the items from both lists. At the end, we add at the end the trailing items from the longer list.
using Printf
function merge_strings(str1, str2)
result = []
let1 = split(str1, "")
let2 = split(str2, "")
size1 = size(let1, 1)
size2 = size(let2, 1)
last_i = size1 > size2 ? size2 : size1
for i in 1:last_i
push!(result, let1[i], let2[i])
end
if size1 > size2
for i in last_i + 1:size1
push!(result, let1[i])
end
else
for i in last_i + 1:size2
push!(result, let2[i])
end
end
return join(result, "");
end
tests = [["abcd", "1234"], ["abc", "12345"], ["abcde", "123"]]
for test in tests
@printf "%-18s => " "$test"
println(merge_strings(test[1], test[2]))
end
This program displays the following output:
$ julia ./merge-strings.jl
["abcd", "1234"] => a1b2c3d4
["abc", "12345"] => a1b2c345
["abcde", "123"] => a1b2c3de
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 February 25, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 18, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given an array of distinct words, @words
.
Write a script to find the maximum pairs in the given array. The words $words[i]
and $words[j]
can be a pair one is reverse of the other.
Example 1
Input: @words = ("ab", "de", "ed", "bc")
Output: 1
There is one pair in the given array: "de" and "ed"
Example 2
Input: @words = ("aa", "ba", "cd", "ed")
Output: 0
Example 3
Input: @words = ("uv", "qp", "st", "vu", "mn", "pq"))
Output: 2
We just run two nested loops on the input array and increment a counter whenever one word is ther reverse of another one. The Raku routine for reversing a word is flip.
sub find-pairs (@in) {
my $nb-pairs = 0;
for 0..@in.end -> $i {
for $i^..@in.end -> $j {
$nb-pairs++ if @in[$i] eq @in[$j].flip;
}
}
return $nb-pairs;
}
my @tests = <ab de ed bc>, <aa ba cd ed>, <uv qp st vu mn pq> ;
for @tests -> @test {
printf "%-20s => ", "@test[]";
say find-pairs @test;
}
This program displays the following output:
$ raku ./find-pairs.raku
ab de ed bc => 1
aa ba cd ed => 0
uv qp st vu mn pq => 2
This is a port to Perl of the above Raku program, with also two nested loops.
use strict;
use warnings;
use feature 'say';
sub find_pairs {
my @in = @_;
my $nb_pairs = 0;
for my $i (0..$#in) {
for my $j ($i + 1 ..$#in) {
$nb_pairs++ if $in[$i] eq reverse $in[$j];
}
}
return $nb_pairs;
}
my @tests = ([<ab de ed bc>], [<aa ba cd ed>],
[<uv qp st vu mn pq>]);
for my $test (@tests) {
printf "%-20s => ", "@$test";
say find_pairs @$test;
}
This program displays the following output:
$ perl ./find-pairs.pl
ab de ed bc => 1
aa ba cd ed => 0
uv qp st vu mn pq => 2
This is a port to Julia of the above Raku program, with also two nested loops. Remember that Julia array indexes start at 1, not 0.
using Printf
function find_pairs(in)
nb_pairs = 0
for i in 1:size(in, 1)
for j in i+1:size(in, 1)
if in[i] == reverse(in[j])
nb_pairs += 1
end
end
end
return nb_pairs
end
tests = [ ["ab", "de", "ed", "bc"],
["aa", "ba", "cd", "ed"],
["uv", "qp", "st", "vu", "mn", "pq"] ]
for test in tests
@printf "%-40s => " "$test"
println(find_pairs(test))
end
This program displays the following output:
$ julia ./find-pairs.jl
["ab", "de", "ed", "bc"] => 1
["aa", "ba", "cd", "ed"] => 0
["uv", "qp", "st", "vu", "mn", "pq"] => 2
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 February 25, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>Crypt::Passphrase is a module for managing passwords. It allows you to separate policy and mechanism, meaning that the code that polices authorization doesn’t have to know anything about what algorithms are used behind the screen, and vice-versa; thus making for a cryptographically agile system.
It’s not only handling the technical details of password hashes for you but also it deals with a variety of schemes. It’s especially useful for transitioning between them.
A configuration might look like this (Koha):
]]> my $auth = Crypt::Passphrase->new( encoder => { module => 'BCrypt', cost => 8, }, validators => [ 'MD5::Base64' ], );Using it might look like this:
if (!$auth->verify_password($password, $hash)) { die "Invalid password"; } elsif ($auth->needs_rehash($hash)) { my $new_hash = $auth->hash_password($password); ... }
It supports a variety of algorithms, but argon2 and bcrypt are by far the most popular ones. That said, it can do much more that that: it can do peppers for you.
The function of peppers is to protect leaked passwords, especially the bad ones. Password hashes try making brute-force attacks so expensive that attackers won’t even bother, but in the end they can’t really protect passwords from a dictionary attack. The key-space of bad passwords is so small that you can’t really prevent that.
When you add a pepper, that means an attacker needs to brute-force both password and pepper, but because the pepper doesn’t need to be memorized by a human it can actually be a piece of high-entropy (e.g. a 16 or 32 byte chunk of good randomness). That would make it well outside of reach of any brute force attack for sheer physical reasons.
The most important thing you must understand about peppers is that like passwords the security they provide hinges entirely on their secrecy. If that secrecy is compromised they don’t do anything for security. If you remember nothing else of this blog post, please remember that.
The first thing you’d probably notice about my modules is that you don’t pass it a pepper, but a map of peppers. This is an essential quality of the system that a lot of naive pepper implementations are lacking. Peppers are keys, and all keys must be rotatable. Like passwords, you need to be able to change them if they may have been compromised. By using a map and adding the identifier in the metadata section of the hash, you can rotate in a new key while still able to check old ones. This gives the system the agility it needs to
The second thing you might notice is that I provide two very different styles of peppering; using some sort of MAC before the password hash, and using symmetric encryption after the password hash (e.g. Crypt::Passphrase::Argon2::AES and Crypt::Passphrase::Bcrypt::AES). The former approach appears to be more common out in the wild, but that latter is by far the better one. Firstly because its security is easily provable (it hinges only on symmetric encryption, not on an unusual combination of constructs), but secondly because it allows for easy re-peppering without needing the user’s password to recompute the password hash inside of it (essentially just decrypting with the old key and encrypting with the new one). For that reason I would strongly recommend the latter approach.
It can be as simple as this:
my $auth = Crypt::Passphrase->new( encoder => { module => 'Argon2::AES', peppers => \%peppers, }, );
All you really need to do is change the module name and pass in the peppers. The hardest part of it is probably securely storing the peppers. There are many tools to help you with this (e.g. vault, sealed secrets, and/or my own Mojolicious::Plugin::Credentials). How to best do this really depends on your setup.
Arguably the best option is using a hardware security module (e.g. CP::Argon2::HSM), but few people has a hardware security module laying around (good ones are rather expensive, though you might convince your TPM2 to function as one).
Using peppers doesn’t have to be that hard. If you have an appropriate credentials store, you can easily add it to your application and enhance the security of your passwords. Maybe you too should give Crypt::Passphrase::Argon2::AES
a try.
イベント参加者として
ボランティアとして
TPFの人間として
トークについて
アメリカのカンファレンス主催側の者として
まとめ
A longer version of this post, including the full timeline as we know it, is available at security.metacpan.org
Between Dec 2023 and Jan 2024, vulnerabilities in Spreadsheet::ParseExcel and Spreadsheet::ParseXLSX were reported to the CPAN Security Group (CPANSec). This document describes the timeline and analysis of events.
Đình Hải Lê discovered an arbitrary code execution (ACE) vulnerability in the Perl module Spreadsheet::ParseExcel, version 0.65 and earlier.
An attacker, exploiting this vulnerability, would craft an Excel file containing malicious code encoded as a number format string, which is executed when the file is parsed by Spreadsheet::ParseExcel. Basically, untrusted data is passed to the Perl eval
function enabling arbitrary code execution.
A detailed write up of the vulnerability and Proof of Concept (PoC) is available at
https://github.com/haile01/perl_spreadsheet_excel_rce_poc
It was allegedly used by UNC4841, a China-backed threat actor, to compromise Barracuda Email Security Gateway (ESG) appliances, and is considered a root cause for CVE-2023-7102. https://www.barracuda.com/company/legal/esg-vulnerability
Đình Hải Lê discovered a DoS vulnerability in Spreadsheet::ParseXLSX, version 0.27 and earlier, enabling denial of service attacks via out-of-memory bugs when parsing a crafted XLSX file.
Basically, an attacker could create a spreadsheet file and set a merged cell to include all possible cells in the spreadsheet. Because of the way vulnerable versions of Spreadsheet::ParseXLSX parsed the file, it would allocate huge amounts of ram to track the merged cell. Simply uploading a simple spreadsheet to a web application using the vulnerable module would cause a denial of service as all memory on the server was used.
A detailed write up of the vulnerability and PoC is available at https://github.com/haile01/perl_spreadsheet_excel_rce_poc/blob/main/parse_xlsx_bomb.md
It is not known whether this vulnerability was used to cause a denial of service on a production server.
An Pham discovered a XML external entity injection (XXE) vulnerability in Spreadsheet::ParseXLSX version 0.29 and earlier, enabling an attacker to interact with the system
This is a classic XML external entity (XXE) injection vulnerability, in which the attacker can cause the vulnerable code to include data (or a file) that should not be available, by simply instructing the XML parser to load external data. The PoC also includes an example that would cause a DoS.
Configuring an XML parser to allow loading external entities is dangerous and should never be the default.
A detailed write up of the vulnerability and PoC is available at https://gist.github.com/phvietan/d1c95a88ab6e17047b0248d6bf9eac4a
The full timeline and additional detail is available at: https://security.metacpan.org/2024/02/10/vulnerable-spreadsheet-parsing-modules.html
Thank you to everyone involved in reporting and fixing these issues. This write up was the joint effort of several members of CPANSec.
]]>In 2024, we will be meeting in Lisbon, Portugal, from Wednesday April 25 to Sunday April 28. As has become customary, participants will stay at the hotel, and work in the meeting rooms dedicated for the event.
]]> The first rounds of invitations have been sent. We plan on having about thirty participants. We are always looking for sponsors (ask for our sponsor prospectus!).The organisation is being handled by a small distributed team of people experienced with this event. This year, we're even more distributed, as none of the main organizers lives in Portugal! We are:
Started in 2008 by Salve Nilsen (SJN) as the Perl QA Hackathon in Oslo, the Perl Toolchain Summit is an annual event that brings together the key developers working on the Perl toolchain. Each year (except for 2020-2022), the event moves from country to country all over Europe, organised by local teams of volunteers. The surplus money from previous summits helps fund the next one.
The developers who maintain CPAN and associated tools and service are all volunteers, scattered across the globe. This event is the one time in the year when they can get together.
The summit provides dedicated time to work on the critical systems and tools, with all the right people in the same room. The attendees hammer out solutions to thorny problems and discuss new ideas to keep the toolchain moving forward.
Given the important nature of the attendees' work and their volunteer status, we try to pay for most expenses (travel, lodging, food, etc.) through sponsorship. If you're interested in helping sponsor the summit, please get in touch with Philippe Bruhat at book@cpan.org.
]]>use VERSION
restrictions have had mostly positive responsesData::Printer
can’t go in core as-is, but there’s a use case for a debugging helper, some of which might be hidden in D:P’s corebuiltin::numify
function (and the corresponding OP in core)Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 11, 2024, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given a paragraph $p
and a banned word $w
.
Write a script to return the most frequent word that is not banned.
Example 1
Input: $p = "Joe hit a ball, the hit ball flew far after it was hit."
$w = "hit"
Output: "ball"
The banned word "hit" occurs 3 times.
The other word "ball" occurs 2 times.
Example 2
Input: $p = "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge."
$w = "the"
Output: "Perl"
The banned word "the" occurs 3 times.
The other word "Perl" occurs 2 times.
We first use the tr/// in-place transliteration operator to remove punctuation characters from the input paragraph, which makes it possible to use the words to split the paragraph into words. We then use grep
to remove the banned word from the word list and convert the resulting list into a Bag, histo
(for histogram). Finally, we return the item from the bag having the highest frequency.
sub most-frequent-word ($para is copy, $banned) {
$para ~~ tr/,.:;?!//;
my $histo = $para.words.grep({$_ ne $banned}).Bag;
return $histo.keys.max({$histo{$_}});
}
my $t = "Joe hit a ball, the hit ball flew far after it was hit.";
printf "%-30s... => ", substr $t, 0, 28;
say most-frequent-word $t, "hit";
$t = "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge.";
printf "%-30s... => ", substr $t, 0, 28;
say most-frequent-word $t, "the";
This program displays the following output:
$ raku ./most-frequent-word.raku
Joe hit a ball, the hit ball ... => ball
Perl and Raku belong to the ... => Perl
This is a port to Perl of the Raku program above, using a hash instead of a Bag
and the split
function instead of words
.
use strict;
use warnings;
use feature 'say';
sub most_frequent_word {
my ($para, $banned) = @_;
$para =~ tr/,.:;?!//;
my %histo;
%histo = map { $_ => ++$histo{$_} }
grep {$_ ne $banned} split /\W/, $para;
return (sort { $histo{$b} <=> $histo{$a} } keys %histo )[0];
}
my $t = "Joe hit a ball, the hit ball flew far after it was hit.";
printf "%-30s... => ", substr $t, 0, 28;
say most_frequent_word $t, "hit";
$t = "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge.";
printf "%-30s... => ", substr $t, 0, 28;
say most_frequent_word $t, "the";
This program displays the following output:
$ perl ./most-frequent-word.pl
Joe hit a ball, the hit ball ... => ball
Perl and Raku belong to the ... => Perl
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 February 18, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 11, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given two strings, $s
and $t
. The string $t
is generated using the shuffled characters of the string $s
with an additional character.
Write a script to find the additional character in the string $t
.
Example 1
Input: $s = "Perl" $t = "Preel"
Output: "e"
Example 2
Input: $s = "Weekly" $t = "Weeakly"
Output: "a"
Example 3
Input: $s = "Box" $t = "Boxy"
Output: "y"
This task is really simple in Raku: we simply convert each input string into a Bag of its letters, and then use the (-)
infix set difference operator to find the extra item in $t
. So we end up with a short one-line subroutine.
sub odd-char ($s, $t) {
return ~ ($t.comb.Bag (-) $s.comb.Bag);
}
for <Perl Preel>, <Weekly Weeakly>, <Box Boxy> -> @test {
printf "%-8s %-8s => ", @test;
say odd-char @test[0], @test[1];
}
This program displays the following output:
$ raku ./odd-characters.raku
Perl Preel => e
Weekly Weeakly => a
Box Boxy => y
The solution is slightly more complicated in Perl, because Perl doesn't have Bags
and set difference operators. We can easily replace bags with hashes (with values being the frequency of each letter). Then we have to find the extra hash item in %t
.
use strict; use warnings; use feature 'say';
sub odd_char {
my (%s, %t);
%s = map { $_ => ++$s{$_} } split //, $_[0];
%t = map { $_ => ++$t{$_} } split //, $_[1];
my @result = grep { (not defined $s{$_})
or $t{$_} - $s{$_} > 0 } keys %t;
}
for my $test ([<Perl Preel>], [<Weekly Weeakly>], [<Box Boxy>]) {
printf "%-8s %-8s => ", @$test;
say odd_char $test->[0], $test->[1];
}
This program displays the following output:
$ perl ./odd-characters.pl
Perl Preel => e
Weekly Weeakly => a
Box Boxy => y
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 February 18, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>We only had one issue to discuss, the pressing matter of how to handle lexical unimports, builtin
version bundles, the integration with use VERSION
, and various related topics.
It’s complicated. We’ve been putting together a longer mail on the subject and that will come out as its own thread soon.
]]>📅 When: Saturday February 3rd, evening
📍 Where: Bruxelles
🎉 What's Cooking: An unforgettable evening filled with tech talks, networking, and delicious bites!
🤩 How to Join:
RSVP now by filling in this form below and secure your spot! Let's make this dinner a celebration of code and camaraderie.
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 4, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given a string, $s
.
Write a script to reverse all the vowels (a, e, i, o, u) in the given string.
Example 1
Input: $s = "Raku"
Output: "Ruka"
Example 2
Input: $s = "Perl"
Output: "Perl"
Example 3
Input: $s = "Julia"
Output: "Jaliu"
Example 4
Input: $s = "Uiua"
Output: "Auiu"
Example 4 just above shows us that we cannot simply reverse the vowels, but also need to deal with upper- and lower-case letters. To do this, I decided to reduce the whole input string to lowercase at the start, perform the required letter moves (or, rather, substitutions), and finally to turn the first letter of the result to uppercase (with the tc
method in Raku and the ucfirst
function in Perl).
We first turn the input string to lower-case (see above why). Then we use a Regex match to build a list of the vowels in the input string. Then we use a regex substitution to replace vowels in the input words by the same vowels in reverse order (using pop
). Finally, we use tc
(title case) to capitalize the first letter of the result.
sub reverse-vowels ($in) {
my $str = $in.lc;
my @vowels = map { .Str }, $str ~~ m:g/<[aeiou]>/;
$str ~~ s:g/<[aeiou]>/{pop @vowels}/;
return $str.tc;
}
for <Raku Perl Julia Uiua> -> $test {
say "$test \t => ", reverse-vowels $test;
}
This program displays the following output:
$ raku ./reverse-vowels.raku
Raku => Ruka
Perl => Perl
Julia => Jaliu
Uiua => Auiu
This is a port to Perl of the Raku program above, using equivalent regular expressions. Please refer to the above sections if you need additional explanations.
use strict;
use warnings;
use feature 'say';
sub reverse_vowels {
my $str = lc shift;
my @vowels = $str =~ /[aeiou]/g;
$str =~ s/[aeiou]/pop @vowels/ge;
return ucfirst $str;
}
for my $test (qw <Raku Perl Julia Uiua>) {
say "$test \t => ", reverse_vowels $test;
}
This program displays the following output:
$ perl ./reverse-vowels.pl
Raku => Ruka
Perl => Perl
Julia => Jaliu
Uiua => Auiu
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 February 11, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>perl -e 'print +(0b1000100).((3<<2)*10).(010)."\n"' # 681208
Spoiler Alert: This weekly challenge deadline is due in a few days from now (on February 4, 2024 at 23:59). This blog post provides 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 integer, $n
.
Write a script to return true if the given integer is a power of three otherwise return false.
Example 1
Input: $n = 27
Output: true
27 = 3 ^ 3
Example 2
Input: $n = 0
Output: true
0 = 0 ^ 3
Example 3
Input: $n = 6
Output: false
First, we look for the candidate exponent, by computing the base-3 logarithm of the input integer. Then we check that we've actually a power of 3. Since floating point arithmetic can be tricky, we test with the integer immediately below and the integer immediately above the candidate exponent thus found.
Please refer to the above section if you need explanations. Note that the Raku log routine can take two parameters, the number for which you want the logarithm and the base. The input number must be strictly positive, so we have to handle separately an input equal to 0. The returned value is a Boolean expression and will thus be either True
or False
.
sub exp-three ($in) {
return True if $in == 0;
my $exp = (log $in, 3).Int;
return (3 ** $exp == $in or 3 ** ($exp + 1) == $in);
}
say "$_ \t=> ", exp-three $_ for <27 26 0 6>;
This program displays the following output:
$ raku ./power-of-three.raku
27 => True
26 => False
0 => True
6 => False
This is a port to Perl of the Raku program above. Please refer to the above sections if you need additional explanations. Perl's built-in log
function computes only natural logarithms (base e
), but it is easy to compute base-3 logarithm of n
as log n / log 3
.
use strict;
use warnings;
use feature 'say';
sub exp_three {
my $in = shift;
return "true" if $in == 0;
my $exp = int (log $in / log 3);
return (3 ** $exp == $in or 3 ** ($exp + 1) == $in)
? "true" : "false";
}
say "$_ \t=> ", exp_three $_ for qw<27 26 0 6>;
This program displays the following output:
$ perl ./power-of-three.pl
27 => true
26 => false
0 => true
6 => false
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 February 11, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>builtin::nan
needs better documentation on the kind of NaN it provides.builtin
and lexical imports, and how to handle a few odd cornercases.The decision by the TPRC Planning Committee is the result of an overwhelmingly positive response to the Science Track Survey that was held late in 2023. Everyone involved in organizing the survey deeply appreciates those who filled out the survey or shared it with others.
The track is being organized in tight cooperation with the TPRC, by the Science Perl Committee (SPC); a separately organized group of Perl and STEM enthusiasts that anyone of good will is welcome to join.
What to expect now: ...
In the coming weeks, the SPC will begin to send out targeted calls for science paper-based talks to STEM organizations and professions. A general call for science paper-based talks will be included in the official Call for Papers that is traditionally made by the TPRC. This is to avoid any early confusion with deadlines and due dates.
If you're interested in submitting a science paper-based talk or serving as a paper reviewer as a subject matter expert, please start thinking about it now. Topics are not required to exclusively involve Perl or Raku, but should be germane to the technical interests of those attending the TPRC (Perl, Raku, Science).
Addition Info:
For more information on the 2024 Perl & Raku Conference, please visit the following sites for more information.
The Perl & Raku Conference 2024 main site (and book a room!)
Questions and comments that are beneficial to the Perl Community and overall effort to bring you an amazing 2024 Perl Conference are welcome below. You may also email me directly at, oodler@cpan.org.
Cheers!
Brett Estrade (OODLER)
Chairman, Science Perl Committee
]]>Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 28, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given an m x n
binary matrix i.e. only 0 and 1 where 1 always appear before 0.
A row i
is weaker than a row j
if one of the following is true:
a) The number of 1s in row i is less than the number of 1s in row j.
b) Both rows have the same number of 1 and i < j.
Write a script to return the order of rows from weakest to strongest.
Example 1
Input: $matrix = [
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 1]
]
Output: (2, 0, 3, 1, 4)
The number of 1s in each row is:
- Row 0: 2
- Row 1: 4
- Row 2: 1
- Row 3: 2
- Row 4: 5
Example 2
Input: $matrix = [
[1, 0, 0, 0],
[1, 1, 1, 1],
[1, 0, 0, 0],
[1, 0, 0, 0]
]
Output: (0, 2, 3, 1)
The number of 1s in each row is:
- Row 0: 1
- Row 1: 4
- Row 2: 1 Transform
- Row 3: 1
Note first that, for the purpose of this task, we don't really care whether the 1s come before the 0s in any row. We count the number of 1s in a given row by simply adding the items of the row.
Next, such a task is a perfect opportunity to use a powerful and efficient functional programming syntax construct called Schwartzian transform, named after Randal Schwartz, a famous author of Perl books. In its canonical form, the Schwartzian transform is a data pipeline consisting of three steps: map ... sort ... map
(to be read from bottom to top and right to left), in which: 1. the first map
(on the right) prepares the data by adding additional information, 2. the sort
uses the data thus enriched to reorder the records, and 3. the last map
(on the left) extract the desired data from the structure generated by the sort
. The Schwartzian transform is quite commonly used in Perl, but less so in Raku, because the built-in Raku sort
has some powerful features which can often cache the intermediate results in a simpler manner without this construct. In the specific case at hand, I felt that using the Schwartzian tranform was simpler.
The solution is quite simple once you understand the Schwartzian transform explained in the previous section. The input is simply a list of row indexes (bottom right). The first map
(at the bottom) creates a list of records containing the index and sum of items for each row, the sort
sorts the record according to the row sum and, in the event of a draw, the row index, ands, finally the last map
(at the top) extracts the row index from each record.
sub weakest-row (@matrix) {
# Schwartzian transform
return map { $_[0] },
sort { $^a[1] <=> $^b[1] || $^a[0] <=> $^b[0]},
map { [ $_, @matrix[$_].sum ] }, 0..@matrix[0].end;
}
my @tests = (
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 1]
),
(
[1, 0, 0, 0],
[1, 1, 1, 1],
[1, 0, 0, 0],
[1, 0, 0, 0]
);
for @tests -> @test {
printf "%-12s ... %-12s => ", "@test[0]", "@test[*-1]";
say weakest-row @test;
}
This program displays the following output:
$ raku ./weakest-row.raku
1 1 0 0 0 ... 1 1 1 1 1 => (2 0 3 1 4)
1 0 0 0 ... 1 0 0 0 => (0 2 3 1)
For the purpose of formatting the output on a reasonable line length, I only displayed the first and last rows of the input matrix.
This is a port to Perl of the Raku program above, also using the Schwartzian transform described in the above sections. The only significant difference is that I have added a sum
helper subroutine to compute the sum of the items of an input array.
use strict;
use warnings;
use feature 'say';
sub sum {
my $sum = 0;
$sum += $_ for @_;
return $sum;
}
sub weakest_row {
my @matrix = @_;
my $row_end = @{$matrix[0]} -1;
# Schwartzian transform
return map { "$_->[0] " }
sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0]}
map { [ $_, sum @{$matrix[$_]} ] } 0..$row_end;
}
my @tests = ( [
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 0, 0],
[1, 1, 1, 1, 1]
],
[
[1, 0, 0, 0],
[1, 1, 1, 1],
[1, 0, 0, 0],
[1, 0, 0, 0]
]
);
for my $test (@tests) {
printf "%-10s ... %-10s => ",
"@{$test->[0]}", "@{$test->[-1]}";
say weakest_row @$test;
}
This program displays the following output:
$ perl ./weakest-row.pl
1 1 0 0 0 ... 1 1 1 1 1 => 2 0 3 1 4
1 0 0 0 ... 1 0 0 0 => 0 2 3 1
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 February 4, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>Half of my new modules were related to my password framework Crypt::Passphrase
. To be honest most of them are either small (± 100 LOC) glue two or three other pieces of code together. And then there was Crypt::HSM
, a PKCS11 interface (to use cryptographic hardware without exposing cryptographic keys) that was probably more work (2600 LOC of XS) than the others combined.
Most of this was with the aim to add peppering support to Crypt::Passphrase
, a subject extensive enough that I should probably dedicate a separate blogpost to it.
ExtUtils::Typemaps::Magic
contains a set of typemaps that help me write XS based objects. In particular the MagicExt typemap allows me to write thread-safe objects (in my particular case: refcounted), which no built-in typemap does. App::typemap
helps one integrate typemap bundles into your local typemap file, and Dist::Zilla::Plugin::Typemap
does the same for dzil
.
I finally got around to publishing two pieces of toolchain that had been in the pipeline for years. CPAN::Static
contains a specification and reference implementation for static installation of modules in CPAN clients. For 90% of all dists, ExtUtils::MakeMaker and Module::Build are an overkill and all they really need is to copy some files and run tests.
CPAN::API::BuildPL
, a specification for Build.PL implementations was mostly written by David Golden but never got published, but now CPAN::Static depends on it so was published alongside with it.
These two modules add a little typing to Perl. Magic::Check
implements runtime (type) checking on a variable, and Magic::Coerce
implements coercers. They're both really more low-level backend modules that beg for a wrapper with a better syntax that I haven't come up with yet.
This module brings Thread::CSP style channels to threads.pm as an alternative to Thread::Queue
. As its name indicates, its semantics are close to that of Go channels, instead of the more asynchronous behavior of Thread::Queue
.
This is an implementation of a simpler and more predictable kind of smartmatching than the one that comes with core. It's intended to be usable even if smartmatching gets removed from core itself.
I had a productive year, and some pretty good leads to move forward this year. I'm looking forward to it.
]]>Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 28, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given an array of strings and a character separator.
Write a script to return all words separated by the given character excluding empty string.
Example 1
Input: @words = ("one.two.three","four.five","six")
$separator = "."
Output: "one","two","three","four","five","six"
Example 2
Input: @words = ("$perl$$", "$$raku$")
$separator = "$"
Output: "perl","raku"
Since we are passing two very different arguments to our split-strings
subroutine, a single character and an array of strings, I thought it was a good opportunity to brush up my knowledge of named arguments to a subroutine. The arguments are supplied at the subroutine call as a list of pairs using the pair constructor syntax. In the subroutine signature, the parameters are retrieved with the so-called colon-pair syntax.
Otherwise, this is quite simple. We're using a grep
to remove empty strings from the result.
sub split-strings (:$sep, :@strings) {
my @result = grep { /\w+/ }, flat
map { split $sep, $_ }, @strings;
return @result;
}
my @tests = {
'separator' => '.',
'string' => ("one.two.three","four.five","six")
}, {
'separator' => '$',
'string' => ('$perl$$', '$$raku$')};
for @tests -> %test {
printf "%-30s => ", %test<string>;
say split-strings(sep => %test<separator>,
strings => %test<string>);
}
This program displays the following output:
$ raku ./split-strings.raku
one.two.three four.five six => [one two three four five six]
$perl$$ $$raku$ => [perl raku]
This is a port to Perl of the above Raku program, except that we use here normal positional parameters. Please loop at the previous section if you need further explanations. Note that we use the quotemeta
operator to make sure that the separator will be properly backslashed (to transform the separator string into a regex).
use strict;
use warnings;
use feature 'say';
sub split_strings {
my ($sep, @strings) = @_;
$sep = quotemeta $sep;
my @result = grep { /\w+/ }
map { split $sep, $_ } @strings;
return @result;
}
my @tests = ( [ '.', ["one.two.three","four.five","six"] ],
[ '$', ['$perl$$', '$$raku$'] ] );
for my $test (@tests) {
printf "%-30s => ", "@{$test->[1]}";
say join " ", split_strings $test->[0], @{$test->[1]};
}
This program displays the following output:
$ perl ./split-strings.pl
one.two.three four.five six => one two three four five six
$perl$$ $$raku$ => perl raku
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 February 4, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>Spoiler Alert: This weekly challenge deadline is due in a few days from now (on January 21, 2024 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.
You are given an integer, $n
.
Write a script to find an array containing $n
unique integers such that they add up to zero.
Example 1
Input: $n = 5
Output: (-7, -1, 1, 3, 4)
Two other possible solutions could be as below:
(-5, -1, 1, 2, 3) and (-3, -1, 2, -2, 4).
Example 2
Input: $n = 3
Output: (-1, 0, 1)
Example 3
Input: $n = 1
Output: (0)
We just take a number of distinct strictly positive integers equal to the rounded half of the input number and take these numbers and their negative counterpart, so that the sum is always 0. And we add 0 if the input number was odd. For fun, I decided to use the built-in pick method (which generates in our case distinct random integers in the specified range). As you can see in the tests below, this makes it possible to get different solutions in successive runs of the program.
sub zero-sum ($n) {
my @result;
for (1..$n*2).pick(($n/2).Int) -> $i {
append @result, ($i, -$i);
}
append @result, 0 unless $n %% 2;
return @result;
}
for 3, 4, 5, 1 -> $test {
say "$test => ", zero-sum $test;
}
This program displays the following output (two successive runs):
$ raku ./zero-sum.raku
3 => [3 -3 0]
4 => [8 -8 6 -6]
5 => [7 -7 2 -2 0]
1 => [0]
~
$ raku ./zero-sum.raku
3 => [2 -2 0]
4 => [1 -1 5 -5]
5 => [6 -6 1 -1 0]
1 => [0]
This is essentially a port to Perl of the Raku program above, except that we don't pick random numbers, but simply consecutive integers. Please refer to the previous section if you need further explanations.
use strict;
use warnings;
use feature 'say';
sub zero_sum {
my $n = shift;
my @result;
for my $i (1.. int $n/2) {
push @result, ($i, -$i);
}
push @result, 0 if $n % 2;
return @result;
}
for my $test (3, 4, 5, 1) {
say "$test => ", join " ", zero_sum $test;
}
This program displays the following output:
$ perl ./zero-sum.pl
3 => 1 -1 0
4 => 1 -1 2 -2
5 => 1 -1 2 -2 0
1 => 0
The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on January 28, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.
]]>