Solution to task 2

1 files changed, 36 insertions, 0 deletions

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;