Originally published at Perl Weekly 693

Hi there!

Throughout the years I had many brilliant ideas regarding Perl and the Perl community. I know they were brilliant because, as I found out later, they were already done by Dave Cross before me. This always gave me mixed feelings. On one hand it was always rather disappointing that my ideas weren't new or original. On the other hand it was of a great pride that my ideas aren't that dumb if Dave also had them.

Today I think I can celebrate. I think this is the first time where I had the idea (and the implementation) first.

In a recent article Dave writes about Advertising Perl. A very good idea to use the existing platforms to advertise Perl events. As I can see it is exactly 10 years after I announced shutting down the Perl Community Adserver. Wow, I am rather shocked that so many years have passed and unfortunately I can't find the posts in which I started to talk about it so I can't really verify the timeline.

In any case, I hope his attempt will be more successful than mine was.

Enjoy your week!

--
Your editor: Gabor Szabo.

Announcements

Perl and Raku Conference 2025 News

It will take place June 27-29, 2025 in Greenville, South Caroline

Articles

A Regexp::Debugger visualization for Abigail's prime number checker

Do you know how to generate prime numbers using a Regular Expression?

Advertising Perl

About the creation of the Perl Ad Server

London Perl & Raku Workshop 2024

LPW 2024

My London Perl And Raku Workshop 2024

London Perl & Raku Workshop 2024: Quick Afterwords

Perl

This week in PSC (166) | 2024-10-31

The Weekly Challenge

The Weekly Challenge by Mohammad Sajid Anwar will help you step out of your comfort-zone. You can even win prize money of $50 by participating in the weekly challenge. We pick one champion at the end of the month from among all of the contributors during the month, thanks to the sponsor Lance Wicks.

The Weekly Challenge - 294

Welcome to a new week with a couple of fun tasks "Consecutive Sequence" and "Next Permutation". If you are new to the weekly challenge then why not join us and have fun every week. For more information, please read the FAQ.

RECAP - The Weekly Challenge - 293

Enjoy a quick recap of last week's contributions by Team PWC dealing with the "Similar Dominos" and "Boomerang" tasks in Perl and Raku. You will find plenty of solutions to keep you busy.

TWC293

Yet another compact and elegant solutions in Perl. You must checkout if you are Perl fans.

Boomerang or Similar

Cool use of subset of Raku giving us the elegant solutions. Great work, keep it up.

Taking A New Angle

Here is another gem from CPAN, Math::Trig. The end result is worth checking out. Thanks for sharing.

Perl Weekly Challenge: Week 293

We all know the compact solution in Raku but replicating the same in Perl is awesome, very impressive. Keep sharing.

Perl Weekly Challenge 293: Similar Dominoes

Comparative approach to a task in Perl and Raku is never to be missed. It always special for me. Thanks for sharing knowledge.

Perl Weekly Challenge 293

Master of in-house Perl one-liners came up with yet another creative solution. Highly recommended.

Domino Frequencies and the Vectorized Boomerang

Any maths lover? I am one, so loved the pure mathematical approach and narrative. Cool work, keep it up.

Oh, oh, Domino!

Nice to see, how to deal edge cases. Very brave move and that too in multiple languages.

Matching and returning

Another mathematical angle to deal with Boomerang task. And on top, DIY tool is handy to play with.

The Weekly Challenge #293

Modularised approach makes the solution easy to read and follow. Short and concise narration comes handy. Great work.

Domino Boomerang

Python is my new love and it doesn't take any effort to decode it. Credit goes to the master, Roger.

Similar boomerang

Keep it sweet and simple, yet end up with classic end result. This is for both Perl and Python lovers.

Weekly collections

NICEPERL's lists

Great CPAN modules released last week.

Events

Boston.pm monthly meeting

November 12, 2024, Virtual event

Purdue Perl Mongers

November 13, 2024, Virtual event

Toronto Perl Mongers monthly meeting

November 28, 2024, Virtual event

Purdue Perl Mongers

December 11, 2024, Virtual event

You joined the Perl Weekly to get weekly e-mails about the Perl programming language and related topics.

Want to see more? See the archives of all the issues.

Not yet subscribed to the newsletter? Join us free of charge!

(C) Copyright Gabor Szabo
The articles are copyright the respective authors.

Weekly Challenge 293

Each week Mohammad S. Anwar sends out The Weekly Challenge, a chance for all of us to come up with solutions to two weekly tasks. My solutions are written in Python first, and then converted to Perl. It's a great way for us all to practice some coding.

Challenge, My solutions

Task 1: Similar Dominos

Task

You are given a list of dominos, @dominos.

Write a script to return the number of dominoes that are similar to any other domino.

$dominos[i] = [a, b] and $dominos[j] = [c, d] are same if either (a = c and b = d) or (a = d and b = c).

My solution

I'm not sure if it's a British/US English thing or something else, but I'm using Dominoes as the plural of Domino. Dominos what what you get when you are hungry.

For this task, I take integers from the command line and convert them to a list of lists (arrays of arrays in Perl). If this was an actual real-world project, I'd probably use a Dataclass, and have an equality operator.

I have a double loop. The outer loop - called i - is from 0 to one less than the number of dominoes. The inner loop - called j - is also the same. I skip the case when i and j are the same. If the dominoes at position i and j are the same (either same number or opposite numbers), I add one to count and exit the inner loop.

def similar_dominoes(dominoes: list) -> int:
    count = 0

    for i in range(len(dominoes)):
        for j in range(len(dominoes)):
            if i == j:
                continue
            if (dominoes[i][0] == dominoes[j][0] and dominoes[i][1] == dominoes[j][1]) \
                    or (dominoes[i][0] == dominoes[j][1] and dominoes[i][1] == dominoes[j][0]):
                count += 1
                break

    return count

Examples

$ ./ch-1.py 1 3 3 1 2 4 6 8
2

$ ./ch-1.py 1 2 2 1 1 1 1 2 2 2
3

Task 2: Boomerang

Task

You are given an array of points, (x, y).

Write a script to find out if the given points are a boomerang.

A boomerang is a set of three points that are all distinct and not in a straight line.

My solution

Like with the last task, I take integers from the command line and convert them to a list of lists (arrays of arrays in Perl).

I remember enough from high school math to know we can get the slope (gradient) of two points with the formula (x2 - x1) ÷ (y2 - y1). However if y1 and y2 are the same, we get a division by zero error.

Therefore I use the following checks:

1. If all y values (second item in each list) are the same, return False as the points make a flat line.
2. If any y values are the same as the first y value, return True (as we know at least one y value is different).
3. Calculate the absolute slop between the first point and the other points using the above formula. Store this as a set. Sets don't store duplicate values.
4. If the set only has one value, it's a straight line and return False. If there is more than one value, then it's a boomerang. I'm not here to determine if it is a good boomerang :)

def is_boomerang(points: list) -> bool:
    if all(points[0][1] == points[i][1] for i in range(1, len(points))):
           return False

    if any(points[0][1] == points[i][1] for i in range(1, len(points))):
           return True

    degrees = set(abs((points[0][0] - points[i][0]) / (points[0][1] - points[i][1])) for i in range(1, len(points)))
    return False if len(degrees) == 1 else True

Examples

$ ./ch-2.py 1 1 2 3 3 2
true

$ ./ch-2.py 1 1 2 2 3 3
false

$ ./ch-2.py 1 1 1 2 2 3
true

$ ./ch-2.py 1 1 1 2 1 3
false

$ ./ch-2.py 1 1 2 1 3 1
false

$ ./ch-2.py 0 0 2 3 4 5
true

Perl Weekly Challenge 293 gave us a problem that didn't really look that hard, yet I did it wrong at least three times before finishing. It reminded me of the song How to Save a Life, where the refrain goes "Where did I go wrong?"

The Task

You are given a list of dominos, @dominos. 
Write a script to return the number of 
dominoes that are similar to any other domino.

$dominos[i] = [a, b] and $dominos[j] = [c, d]
are the same if either (a = c and b = d) or
(a = d and b = c).

Example 1

• Input: @dominos = ([1, 3], [3, 1], [2, 4], [6, 8])
• Output: 2
• Similar Dominos: $dominos[0], $dominos[1]

Example 2

• Input: @dominos = ([1, 2], [2, 1], [1, 1], [1, 2], [2, 2])
• Output: 3
• Similar Dominos: $dominos[0], $dominos[1], $dominos[3]

Bad Start

First thought: oh, this is one of those compare-all-pairs problems. Double loop, count up the matches. Simple.

my $count = 0;
while ( defined(my $d1 = shift @dominos) )
{
    for my $d2 ( @dominos) 
    {
        if ( ( $d1->[0] == $d2->[0] && $d1->[1] == $d2->[1] )
          || ( $d1->[0] == $d2->[1] && $d1->[1] == $d2->[0] ) )
        {
            $count++;
        }
    }
}
return $count;

Nope. This double-counts the pairs in Example 2. The first time through the loop it finds the three similar dominoes, but then it loops again and finds the matching pair 1 and 3.

Strike 2

Okay, so we need to remove an element from consideration once it's been noted as similar. Let's delete the second member of the pair when we find a match. Annoyingly, I now need to know the index of the matches, but I can take advantage of the indexed feature that was added to Perl a couple of releases ago.

my $count = 0;
while ( defined(my $d1 = shift @dominos) )
{
    for my ($i, $d2) ( indexed @dominos ) 
    {
        if ( ( $d1->[0] == $d2->[0] && $d1->[1] == $d2->[1] )
          || ( $d1->[0] == $d2->[1] && $d1->[1] == $d2->[0] ) )
        {
            $count++;
            delete $dominos[$i];
        }
    }
}
return $count;

Derp. delete replaces the deleted element with an undef, so now the program dies by trying to reference an undefined array element. I need to add code to check for undef. Not very demure; not very mindful.

Strike 3

Easy enough. Instead of delete, use splice. That will compress the deleted element out of the array -- no undef checking needed.

[...]
while ( ... ) {
    for ... {
        if ( ... ) {
            count++;
            splice(@dominos, $i, 1);
        }

Fail. splice does indeed remove the element of the array, but doing that resets the indexes, so my $i index variable is now pointing at the wrong element after the operation, so I'll be skipping some pairs.

Engage Brain

Finally, it dawns on me that pair-wise checking may not be the way to go here. What if we enter the dominoes into a hash, and count the frequencies that way? All we have to do is force dominoes to look similar by always listing the smaller dots first.

sub similar(@dominos)
{
    my %count;
    while ( defined( my $tile = shift @dominos ) )
    {
        my @d = $tile->@*;
        @d = ($d[1], $d[0]) if $d[1] < $d[0];

        $count{ "[$d[0],$d[1]]" }++;
    }
    return sum0 values %count;
}

That looks better. We're only making one pass over the list, and O(1) is always nice. We form a key for the hash that has the pair of numbers in a string, which is going to be useful for debugging, if we need to dump the hash table (but surely we have it right now). Retrieving the counts is easy with applying values to the hash, and List::Util::sum0 will add them up.

And ... nope, still a bug. The hash now contains dominoes that are unique. We need to add a little filter to only count dominoes that show up at least twice.

[...]
    return sum0 { grep $_ > 1 } values %count;

Good grief. Finally, something I'm willing to push to Github

Last weekend, we had a very successful (and very enjoyable) London Perl Workshop. After a five-year break, it was great to see so many old faces again. But in addition to people who had been regular attendees at recent workshops, two other groups of people were there in large numbers—people who had moved away from the Perl community (and who were coming back for the nostalgia) and new Perl users who hadn’t been to any Perl conference before. In both cases, it seems that one marketing move was particularly effective at telling both of these groups about the workshop.

It was a small, text advert that ran on MetaCPAN.

I had nothing to do with the organisation of the workshop, so I have no idea who had the idea of running that ad, but it was (like so many great ideas) obvious in retrospect. It’s great to publish blog posts about upcoming events and mention events in the Perl Weekly newsletter. But marketing like that is mostly going to be read by people who are already part of the Perl community. And they (hopefully) already know about the workshop.

Whereas, sites like MetaCPAN are visited by Perl programmers who don’t consider themselves part of the community. People who don’t attend Perl Mongers meetings. People who don’t read blogs.perl.org. People who are (to use terminology that has been used to explain this problem for about twenty years) outside the echo chamber.

Advertising Perl community events to as large an audience as possible is a really good idea, and I think we should do more of it. But it has its downsides. Someone has to do some work to create a pull request to add the advert (and another one to remove it once the event is over). That’s not hard, but it requires thought and planning. I started to wonder if we could simplify this process and, in doing so, encourage more people to run ads like these on sites where more people might see them.

After an hour or so, I had a prototype of the Perl Ad Server – which I have subsequently cleaned up and improved.

It’s a simple enough concept. You add a tiny fragment of Javascript to your website. And that then automatically adds a small banner ad to the top of your site. We can control the ads that are being promoted by simply editing the JSON that we serve to the client sites.

It’s experimental. So I’d like to get as many people as possible to try it out.

It comes with a tiny caveat. I’m neither a web designer nor a Javascript expert. So it may interact with some web frameworks in weird ways (I added it to CPAN Dashboard and the ad appeared under the navbar – which isn’t supposed to happen). If it doesn’t work with your site for some reason, please remove the Javascript and raise an issue so I can investigate.

And if you’d like your event added to the current list of ads, let me know too.

The post Advertising Perl appeared first on Perl Hacks.

Challenge 293 solutions in Perl by Matthias Muth

Summary

Similar Dominos:
Two lines of code to compute frequencies of Domino value combinations
and then to sum them up.

Boomerang:
Thank you for helping me to get a refresher in vector geometry!
It only needs two formulas and one comparison for checking whether the input points form a 'boomerang', using integer arithmetics only (no divisions, no square roots).

Code:
Find the complete source code for both tasks, including tests, on Github.

Task 1: Similar Dominos

You are given a list of dominos, @dominos.
Write a script to return the number of dominos that are similar to any other domino.
$dominos[i] = [a, b] and $dominos[j] = [c, d] are same if either (a = c and b = d) or (a = d and b = c).

Example 1
Input: @dominos = ([1, 3], [3, 1], [2, 4], [6, 8])
Output: 2
Similar Dominos: $dominos[0], $dominos[1]

Example 2
Input: @dominos = ([1, 2], [2, 1], [1, 1], [1, 2], [2, 2])
Output: 3
Similar Dominos: $dominos[0], $dominos[1], $dominos[3]

My thinking process:

• For counting the number of similar dominos, we can first count for each distinct value combination how often it exists, and then sum up the numbers of those that exist more than once.
• Counting how often each value combination exists is the same as getting their frequencies. That's something we've done quite often before. In Perl typically a hash is used, with the domino combination as the key, and the frequency as the value. Today, I will let List::MoreUtils do the job of creating the frequency hash. Less typing ;-).
• To use the two numbers on a domino as a key, we have to combine them into a string. Let's join the two numbers with a separator (like '-') in between them.
• A combination and its inverse (like [3, 1] and [1, 3]) should be considered as being equal. They need to be mapped to the same key. To get that, it's easiest to just sort the two numbers (even if there are only two of them) before turning them into a key string. Both dominos [3, 1] and [1, 3] will then be counted using "1-3" as the key.
• The type of sort (numerical or lexical, ascending or descending) does not matter at all, it is only important that the result is the same if the input is in reversed order. The default lexical sort will therefore do nicely.
• Once we have the frequencies, we add them up, but we exclude those having a frequency of 1. (The frequencies are in the values of the frequency hash.)

My solution then is this little program:

use v5.36;
use List::MoreUtils qw( frequency );
use List::Util qw( sum );

sub similar_dominos( $dominos ) {
    my %frequencies = frequency( map { join "-", sort $_->@* } $dominos->@* );
    return sum( grep $_ > 1, values %frequencies );
}

(use v5.36; is short for getting subroutine signatures and automatic strict and warnings.)

I love how Perl makes this easy.

Task 2: Boomerang

You are given an array of points, (x, y).
Write a script to find out if the given points are a boomerang.
A boomerang is a set of three points that are all distinct and not in a straight line.

Example 1
Input: @points = ( [1, 1], [2, 3], [3,2] )
Output: true

Example 2
Input: @points = ( [1, 1], [2, 2], [3, 3] )
Output: false

Example 3
Input: @points = ( [1, 1], [1, 2], [2, 3] )
Output: true

Example 4
Input: @points = ( [1, 1], [1, 2], [1, 3] )

Output: false

Example 5
Input: @points = ( [1, 1], [2, 1], [3, 1] )
Output: false

Example 6
Input: @points = ( [0, 0], [2, 3], [4, 5] )
Output: true

We have the three input points
pi=(xiyi)∣i∈1…3\qquad \qquad p_i = \begin{pmatrix} x_i \\ y_i \end{pmatrix} |_{ i \in { 1 \dots 3 } } pi​=(xi​yi​​)∣i∈1…3​
My idea to solve this task is based on the two vectors that we get
when we connect these points:
v=(x2−x1y2−y1)w=(x3−x2y3−y2) \qquad \qquad \mathbf{v} = \begin{pmatrix} x_2 - x_1 \\ y_2 - y_1 \end{pmatrix} \qquad \mathbf{w} = \begin{pmatrix} x_3 - x_2 \\ y_3 - y_2 \end{pmatrix} v=(x2​−x1​y2​−y1​​)w=(x3​−x2​y3​−y2​​)

For a 'boomerang', we then need to check whether the two vectors have the same direction.

The reason why I'm using this 'vector' approach is that I hope to avoid any condition checking that would be necessary for the other possible approach: comparing the slope of the line segments defined by the points. As the points can have the same $x$ -coordinate (like in Example 4), I would have to deal with possibly infinite slopes (vertical lines). And in any case with floating point numbers, which I always try to avoid if possible.
Maybe my worries are exaggerated, but I also found it nice to get a little refresher in vector geometry!

So going with the two vectors:
I have re-learned (after around 50 years!) something about the dot product (or scalar product) of vectors.
In the Wikipedia article about the dot product, it says that if two vectors are codirectional, their dot product is equal to the product of their magnitudes.
That sounds complicated, but let's see what that means when we break it down.

The 'dot product' is a scalar number, and for our two vectors
v=(xvyv)w=(xwyw) \qquad \qquad \mathbf{v} = \begin{pmatrix} x_v \\ y_v \end{pmatrix} \qquad \mathbf{w} = \begin{pmatrix} x_w \\ y_w \end{pmatrix} v=(xv​yv​​)w=(xw​yw​​)
it is simply computed like this:
v⋅w=xvxw+yvyw \qquad \qquad \mathbf{v} \cdot \mathbf{w} = x_v x_w + y_v y_w v⋅w=xv​xw​+yv​yw​

The 'product of the magnitudes' of the two vectors is
∥v∥ ∥w∥=xv2+yv2⋅xw2+yw2=(xv2+yv2) (xw2+yw2) \qquad \qquad \| \mathbf{v} \| \, \| \mathbf{w} \| = \sqrt{ x_v^2 + y_v^2} \cdot \sqrt{x_w^2 + y_w^2} = \sqrt{ (x_v^2 + y_v^2) \, (x_w^2 + y_w^2)} ∥v∥∥w∥=xv2​+yv2​​⋅xw2​+yw2​​=(xv2​+yv2​)(xw2​+yw2​)​
The 'magnitude' of a vector is its length, and you recognize the Pythagorean theorem in the two-dimensional case here.

For doing the 'boomerang check', we need to check whether those two are equal:
xvxw+yvyw=(xv2+yv2) (xw2+yw2) \qquad \qquad x_v x_w + y_v y_w = \sqrt{ (x_v^2 + y_v^2) \, (x_w^2 + y_w^2)} xv​xw​+yv​yw​=(xv2​+yv2​)(xw2​+yw2​)​

To avoid floating point operations, and especially something as complicated as computing a square root, we use a trick and square both sides:
(xvxw+yvyw)2=(xv2+yv2) (xw2+yw2) \qquad \qquad ( x_v x_w + y_v y_w ) ^2 = (x_v^2 + y_v^2) \, (x_w^2 + y_w^2) (xv​xw​+yv​yw​)2=(xv2​+yv2​)(xw2​+yw2​)
Only integer arithmetics, not even a division in this one!

Squaring both sides also has another positive (pun intended!) effect:
If the two vectors have the same direction, but a different orientation
(one is a negative multiple of the other), their dot product is negative. Squaring both sides of the equation eliminates the negative sign, which is what we actually want.

Now we have something that we can turn into code:

use v5.36;

sub boomerang( $points ) {
    # Create vectors connecting the points.
    my $v = [ $points->[1][0] - $points->[0][0],
              $points->[1][1] - $points->[0][1] ];
    my $w = [ $points->[2][0] - $points->[1][0],
              $points->[2][1] - $points->[1][1] ];

    # Compute the dot product
    # and the *square* of the product of the magnitudes
    # (by not taking the square root).
    my $dot_product = $v->[0] * $w->[0] + $v->[1] * $w->[1];
    my $mag_product_squared =
        ( $v->[0] ** 2 + $v->[1] ** 2 )
            * ( $w->[0] ** 2 + $w->[1] ** 2 );

    # Compare the two.
    return $dot_product ** 2 != $mag_product_squared;
}

I added some more tests for corner cases, like two of the three points being identical, or even all three of them.

ok 1 - Example 1: boomerang( [[1, 1], [2, 3], [3, 2]] ) is true
ok 2 - Example 2: boomerang( [[1, 1], [2, 2], [3, 3]] ) is false
ok 3 - Example 3: boomerang( [[1, 1], [1, 2], [2, 3]] ) is true
ok 4 - Example 4: boomerang( [[1, 1], [1, 2], [1, 3]] ) is false
ok 5 - Example 5: boomerang( [[1, 1], [2, 1], [3, 1]] ) is false
ok 6 - Example 6: boomerang( [[0, 0], [2, 3], [4, 5]] ) is true
ok 7 - Extra 1: boomerang( [[1, 1], [2, 1], [1, 1]] ) is false (points 1 and 3 identical)
ok 8 - Extra 2: boomerang( [[1, 1], [1, 1], [2, 1]] ) is false (points 1 and 2 identical)
ok 9 - Extra 3: boomerang( [[1, 1], [2, 1], [2, 1]] ) is false (points 2 and 3 identical)
ok 10 - Extra 4: boomerang( [[1, 1], [1, 1], [1, 1]] ) is false (all points identical)
1..10

Glad all the tests run successfully!

Maybe next time dealing with vectors, I should try PDL!
There's always something new to learn!

Thank you for the challenge!

Find the complete source code for both tasks, including tests, on Github.