Merge pull request #2901 from jo-37/contrib

Solutions to challenge 089

2 files changed, 56 insertions, 0 deletions

diff --git a/challenge-089/jo-37/perl/ch-1.pl b/challenge-089/jo-37/perl/ch-1.pl
new file mode 100755
index 0000000000..93510bb801
--- /dev/null
+++ b/challenge-089/jo-37/perl/ch-1.pl
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+
+use Test2::V0;
+use Math::Utils 'gcd';
+use List::Util 'reduce';
+
+sub gcd_sum {
+	my $n = shift;
+	reduce {
+		local *_ = \$b;
+		$a + reduce {$a + gcd($_, $_ + $b)} 0 .. $n - $b;
+	} 0 .. $n - 1;
+}
+
+is gcd_sum(3), 3, 'Example 1';
+is gcd_sum(4), 7, 'Example 2';
+is gcd_sum(5), 11;
+is gcd_sum(6), 20;
+
+done_testing;
diff --git a/challenge-089/jo-37/perl/ch-2.pl b/challenge-089/jo-37/perl/ch-2.pl
new file mode 100755
index 0000000000..b08d40b377
--- /dev/null
+++ b/challenge-089/jo-37/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use 5.012;
+use PDL;
+use Test2::V0 '!float';
+
+# Siamese method to construct an odd order magic square.
+# See https://en.wikipedia.org/wiki/Siamese_method
+$::verbose = 0;
+sub siamese {
+	my $n = shift;
+	my $ord =  2 * $n + 1 ;
+	my $msq = zeroes(long, $ord, $ord)->inplace->setvaltobad(0);
+	my $idx = long $n, 0;
+	for my $val (1 .. $ord ** 2) {
+		$msq->range($idx, 0, 'periodic') .= $val;
+		say $msq if $::verbose;
+		$idx += $val % $ord ? long(1, -1) : long(0, 1);
+	}
+	# Return order, magic constant and magic square
+	($ord, ($ord**3 + $ord) / 2, $msq);
+}
+
+# Create some magic squares and check row, column and diagonal
+# sums.
+for my $n (1 .. 3) {
+	my ($ord, $magic, $sq) = siamese $n;
+	say $sq;
+
+	is $sq->sumover->unpdl, [($magic) x $ord], 'row sums';
+	is $sq->xchg(0, 1)->sumover->unpdl, [($magic) x $ord], 'col sums';
+	is sum($sq->diagonal(0, 1)), $magic, 'diag sum';
+	is sum($sq->slice('-1:0')->diagonal(0, 1)), $magic, 'antidiag sum';
+}
+
+done_testing;