Perl Weekly Challenge 89.

Yesterday I submitted my second participation in the Perl Weekly Challenge (challenge 1 and challenge 2)

Task 1: GCD Sum

You are given a positive integer $N. Write a script to sum GCD of all possible unique pairs between 1 and $N.

I solved the problem in a straightforward way, by generating recursively all unique pairs between 1 and $N and calculating recursively their greatest common divisor.

First, load the required packages.

#!/usr/bin/env perl
# Perl weekly challenge 89
# Challenge 1.
# Given $N, calculate the sum of the greatest common divisors of all
# unique pairs of numbers between 1 and $N

# Load packages
use warnings;
use strict;
use v5.10;
use List::Util qw(sum0);

To calculate the greatest common divisor use Euclid’s algorithm. The greatest common divisor of two numbers $a and $b is $a if $b is zero, and it is the greatest common divisor of $b and the remainder of $a when divided by $b.

# I use a straight forward approach
# First I define a recursive function for the gcd using Euclid's algorithm
sub gcd {
    # I assume that both arguments are non-negative
    my ($a, $b)=@_;
    return $a if $b==0;
    return gcd($b, $a%$b);
}

The following routine generates all pairs between two integers $n and $m. They are given by all pairs of the form [$n,$n+1], [$n,$n+2]… [$n,$m] and all pairs from $n+1 to $m.

# Now I generate recursively all unique pairs of numbers between $n
# and $m
sub pairs {
    # I assume both arguments are integer and different
    my ($n, $m)=@_;
    return () if $n>=$m; #no more pairs
    return ((map {[$n,$_]} ($n+1..$m)),  #pairs starting in $n
	    pairs($n+1, $m));          # and the rest
}

To obtain the sum of all pairs I generate a list of all pairs, calculate their GCD and reduce the result through a sum.

sub sumgcd { # sum gcd for all pairs
    # I assume $N is a positive integer
    my $N=shift;
    sum0 map {gcd($_->[0], $_->[1])} pairs(1,$N);
}

Finally, I run a few cases.

# Test a few cases:
say join " ", map {sumgcd($_)} (2..20);
# Answer:
# 1 3 7 11 20 26 38 50 67 77 105 117 142 172 204 220 265 283 335

TASK 2: Magical Matrix

Write a script to display matrix with numbers 1 - 9. Please make sure numbers are used once where sum of elements horizontally, vertically and diagonally is 15.

I solved the problem by generating recursively all permutations of the numbers 1-9. However, in order not to store them in memory, I test each of them as they are generated by using a callback routine and they are discarded if they don’t satisfy the desired condition. By changing the callback, different families of matrices may be generated.

First I load the required packages.

#!/usr/bin/env perl
# Perl weekly challenge 89
# Challenge 2.
# Magical matrix. Build a 3x3 matrix so that the sums of all rows, columns and diagonals is 15

# Load packages
use warnings;
use strict;
use v5.10;

I define a routine to generate permutations and call the callback routine. Its parameters are the callback, a flag to generate all the permutations that fulfill the condition or only the first and the list of elements to permute.

# generate all permutations of a set using a callback function to test each
# permutation. Stop when callback returns success (true) or when no more permutations
# I use this technique to avoid storing all 9! permutations in
# memory. With a callback I can generate them and test them one at a time.

sub permutations {
    my ($callback, $all_flag, @set)=@_;
    permutations_ancillary($callback, $all_flag, [], [@set]); #use auxiliary function
}

The routine above uses an auxiliary routine that calculates all permutations recursively. It is given the initial elements of the permutation, which have been fixed, and the set of remaining elements. It works by adding in turn each element of the remaining elements to the first set, removing it from the second set and calling itself recursively to permute what remains of that second set.

# Append the permutations of @$rest to @$first and call the callback
# when a permutation is completed. Continue generating permutations
# until success or until no more  permutations. Returns success
# The idea is to fix the first element and recursively permute the
# rest. Then change the first element and iterate.
sub permutations_ancillary {
    my $callback=shift; # callback function
    my $all_flag=shift; # flag to generate all magical matrices
    my @first=@{shift @_}; # first elements
    my @rest=@{shift @_};  # elements to permute
    return $callback->($all_flag, @first) unless @rest; # finished?
    foreach (0..$#rest){
	# choose one element to add to first and permute the rest
	my @new_first=@first;
	my @new_rest=@rest;
	push @new_first, splice @new_rest, $_, 1;
	my $success=permutations_ancillary($callback, $all_flag, [@new_first], [@new_rest]);
	return $success if $success;
    }
}

The callback routine in this case tests if a given permutation, when arranged as a square matrix is a magic square. To that end, I use the Perl Data Language. Its function pdl constructs a piddle (PDL’s data element) from a Perl array, reshape(3,3) converts it into a square matrix, sumover sums over rows, transpose interchanges rows and columns, diagonal(0,1) returns a vector with the diagonal elements, ->(-1:0) inverts the order of the elements of each row and all returns true if all elements of a piddle satisfy a condition.

# Test if a permutation of 1..9 corresponds to a Magic Square
sub test_magic {
    use PDL; #Use perl data language to simplify coding matrix operations
    use PDL::NiceSlice;
    my $all_flag=shift;
    my $square=pdl(@_)->reshape(3,3); # turn array into pdl square matrix
    my $ok=    all($square->sumover==15)                    # check sum of rows
	    && all($square->transpose->sumover==15)         # of columns
	    && $square->diagonal(0,1)->sumover==15          # of main diagonal
	    && $square->(-1:0)->diagonal(0,1)->sumover==15; # and of inverted diagonal
    if($ok){
	say $square;
	return !$all_flag; # replace 1 by 0 to generate all magical matrices.
    }
    return 0;
}

Finally, I test the code by generating the first magical matrix and by generating all the magical matrices.

# Test
say "Generate one magical matrix";
permutations(\&test_magic, 0, 1..9);

say "Generate all magical matrices";
permutations(\&test_magic, 1, 1..9);
#Output

# Generate one magical matrix
#
# [
#  [2 7 6]
#  [9 5 1]
#  [4 3 8]
# ]
#
# Generate all magical matrices
#
# [
#  [2 7 6]
#  [9 5 1]
#  [4 3 8]
# ]
#
#
# [
#  [2 9 4]
#  [7 5 3]
#  [6 1 8]
# ]
#
#
# [
#  [4 3 8]
#  [9 5 1]
#  [2 7 6]
# ]
#
#
# [
#  [4 9 2]
#  [3 5 7]
#  [8 1 6]
# ]
#
#
# [
#  [6 1 8]
#  [7 5 3]
#  [2 9 4]
# ]
#
#
# [
#  [6 7 2]
#  [1 5 9]
#  [8 3 4]
# ]
#
#
# [
#  [8 1 6]
#  [3 5 7]
#  [4 9 2]
# ]
#
#
# [
#  [8 3 4]
#  [1 5 9]
#  [6 7 2]
# ]
Written on December 4, 2020