I’ve been doing the Weekly
Challenges. The
latest
involved a mathematical search and string substitution. (Note that
this ends today.)
Task 1: Hamiltonian Cycle
You are given a target number.
Write a script to arrange all the whole numbers from 1 up to the
given target number into a circle so that every pair of side-by-side
numbers adds up to a perfect square. Please make sure, the last
number and the first must also add up to a square.
This was made more complex by my chosen algorithm not being
deterministic, so I ended up writing a testing function which verified
the characteristics of the generated sequence.
It would be possible to generate all valid permutations, then return
the numerically first one, but that would be rather more work. And in
any case Ex3 does not contain the numerically first permutation for
case 34.
This comes down to a
DFS, but I
optimise by generating (a) a list of perfect squares that can be
validly produced, and (b) from that a map of valid neighbours. This is
definitely easier in a language that has "real" sets rather than just
hashes/dicts that can be abused as sets.
In Raku:
A library function for a quick square root rounded down to next integer.
sub isqrt($n) {
my $k=$n +> 1;
my $x=1;
while ($x) {
my $k1=($k+$n/$k) +> 1;
if ($k1 >= $k) {
$x=0;
}
$k=$k1;
}
return $k;
}
The testing function: return a boolean, is this sequence valid?
sub is_adjacentsquared($param, @hc) {
First, take the sequence in order, and ensure that that contains each
of the required numbers.
my @hcs = @hc.sort({$^a <=> $^b});
unless (all((1 .. $param) «==» @hcs)) {
return False;
}
Check that each internal pair of numbers sums to a perfect square.
for 0 .. $param - 2 -> $i {
my $pn = @hc[$i] + @hc[$i + 1];
my $sn = isqrt($pn);
if ($pn != $sn * $sn) {
return False;
}
}
Check that the first and last sum to a perfect square.
my $pn = @hc[0] + @hc[*-1];
my $sn = isqrt($pn);
if ($pn != $sn * $sn) {
return False;
}
True;
}
Generate the cycle.
sub hamiltoniancycle($a) {
I take advantage of a known thing which I can't now locate: there are
no solutions where the parameter is less than 31.
if ($a < 31) {
return [];
}
First I'll build a set of the possible perfect squares. (We can't
reach a * a but this is close enough.)
my %perfectsquares = Set.new((1 .. $a).map({$_ ** 2}));
Now I'll build the map of neighbours: each hash key will map to
another set.
my %neighbours;
Scan x over all possible values.
for 1 .. $a -> $x {
Scan y over all possible perfect square sums.
for %perfectsquares.keys -> $y {
We have no negative numbers, so y has to be larger.
if ($y > $x) {
Take the difference.
my $z = $y - $x;
If that is a number that will be in the list,
if ($z <= $a) {
Insert z into the set of possible neighbours for x.
unless (%neighbours{$x}:exists) {
%neighbours{$x} = SetHash.new;
}
%neighbours{$x}{$z}++;
And vice versa.
unless (%neighbours{$z}:exists) {
%neighbours{$z} = SetHash.new;
}
%neighbours{$z}{$x}++;
}
}
}
}
Now we'll do the DFS. (Depth-first because any solution will do.)
my @stack;
Each entry in the stack will be a list of numbers.
@stack.push([1]);
While we have an entry, unstack it.
while (@stack.elems > 0) {
my @lst = (@stack.pop).flat;
If it's the right length,
if (@lst.elems == $a) {
Check that the ends sum to a perfect square, and if so return it.
(Otherwise discard it.)
if (%perfectsquares{@lst[0] + @lst[*-1]}:exists) {
return @lst;
}
} else {
Make a lookup set of numbers in the current entry.
my %ls = Set(@lst);
Check each possible neighbour of the latest number in the entry.
for %neighbours{@lst[*-1]}.keys -> $candidate {
If it's not already in the entry,
unless (%ls{$candidate}:exists) {
Copy the entry, add the new neighbour to it, and put that on the
stack.
my @nlst = @lst.clone;
@nlst.push($candidate);
@stack.push(@nlst);
}
}
}
}
If we've run out of stack entries without finding a result, return an
empty list.
[];
}
(Typst ran foul of the infinite loop detector, so I have to give it an
arbitrarily large repetition count.)
Task 2: Replace Question Mark
You are given a string that contains only 0, 1 and ? characters.
Write a script to generate all possible combinations when replacing
the question marks with a zero or one.
I use a coincidence to generate the outputs in the same order as the
examples (with the rightmost ? incremented first) rather than
sorting at the end.
Scala:
def replacequestionmark(a: String): List[String] = {
Get the input into a list of characters.
val template = a.toList
Count the ?.
val q = template.filter(x => x == '?').size
This algorithm assumes at least one ?, so in the trivial case of none
we return early.
if (q == 0) {
List(a)
} else {
var out = new ListBuffer[String]
Work through each possible replacement value as a binary mask.
for (n <- 0 until (1 << q)) {
Build the list of replacement characters, least significant digit
first.
var qm = new ListBuffer[Char]
var nn = n
while (nn > 0) {
if (nn % 2 == 0) {
qm += '0'
} else {
qm += '1'
}
nn /= 2
}
Pad the list with zeroes if needed.
while (qm.length < q) {
qm += '0'
}
Build the string. Iterate through the template characters.
var entry = ""
for (tc <- template) {
If it's a ?, pop the last character (representing the most
significant remaining digit) off the replacement list.
if (tc == '?') {
entry += qm.last
qm = qm.dropRight(1)
Otherwise, just add the character.
} else {
entry += tc
}
}
Add this strong to the output list.
out += entry
}
And finally return that output list.
out.toList
}
}
Full code on
codeberg.