Skip to content

Commit aadb91c

Browse files
authored
Merge pull request manwar#2901 from jo-37/contrib
Solutions to challenge 089
2 parents 51d9a30 + 189ab16 commit aadb91c

File tree

2 files changed

+56
-0
lines changed

2 files changed

+56
-0
lines changed

challenge-089/jo-37/perl/ch-1.pl

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
#!/usr/bin/perl
2+
3+
use Test2::V0;
4+
use Math::Utils 'gcd';
5+
use List::Util 'reduce';
6+
7+
sub gcd_sum {
8+
my $n = shift;
9+
reduce {
10+
local *_ = \$b;
11+
$a + reduce {$a + gcd($_, $_ + $b)} 0 .. $n - $b;
12+
} 0 .. $n - 1;
13+
}
14+
15+
is gcd_sum(3), 3, 'Example 1';
16+
is gcd_sum(4), 7, 'Example 2';
17+
is gcd_sum(5), 11;
18+
is gcd_sum(6), 20;
19+
20+
done_testing;

challenge-089/jo-37/perl/ch-2.pl

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
#!/usr/bin/perl
2+
3+
use 5.012;
4+
use PDL;
5+
use Test2::V0 '!float';
6+
7+
# Siamese method to construct an odd order magic square.
8+
# See https://en.wikipedia.org/wiki/Siamese_method
9+
$::verbose = 0;
10+
sub siamese {
11+
my $n = shift;
12+
my $ord = 2 * $n + 1 ;
13+
my $msq = zeroes(long, $ord, $ord)->inplace->setvaltobad(0);
14+
my $idx = long $n, 0;
15+
for my $val (1 .. $ord ** 2) {
16+
$msq->range($idx, 0, 'periodic') .= $val;
17+
say $msq if $::verbose;
18+
$idx += $val % $ord ? long(1, -1) : long(0, 1);
19+
}
20+
# Return order, magic constant and magic square
21+
($ord, ($ord**3 + $ord) / 2, $msq);
22+
}
23+
24+
# Create some magic squares and check row, column and diagonal
25+
# sums.
26+
for my $n (1 .. 3) {
27+
my ($ord, $magic, $sq) = siamese $n;
28+
say $sq;
29+
30+
is $sq->sumover->unpdl, [($magic) x $ord], 'row sums';
31+
is $sq->xchg(0, 1)->sumover->unpdl, [($magic) x $ord], 'col sums';
32+
is sum($sq->diagonal(0, 1)), $magic, 'diag sum';
33+
is sum($sq->slice('-1:0')->diagonal(0, 1)), $magic, 'antidiag sum';
34+
}
35+
36+
done_testing;

0 commit comments

Comments
 (0)