This is my response to The Weekly Challenge #382.
Input: $n = 32
Output: 1, 8, 28, 21, 4, 32, 17, 19, 30, 6, 3, 13, 12, 24, 25, 11, 5, \
31, 18, 7, 29, 20, 16, 9, 27, 22, 14, 2, 23, 26, 10, 15
1 + 8 = 9
8 + 28 = 36
28 + 21 = 49
21 + 4 = 25
4 + 32 = 36
32 + 17 = 49
17 + 19 = 36
19 + 30 = 49
so on, all the way through the sequence.
Input: $n = 15
Output: ()
No valid circular list of numbers exists.
Input: $n = 34
Output: 1, 8, 28, 21, 4, 32, 17, 19, 6, 30, 34, 15, 10, 26, 23, 2, 14, \
22, 27, 9, 16, 33, 31, 18, 7, 29, 20, 5, 11, 25, 24, 12, 13, 3
[2026-07-13 11:45]: Output was incorrect, corrected by E. Choroba.
#! /usr/bin/env raku
unit sub MAIN (Int $n where $n > 1, :v(:$verbose));
my %perfect-squares
= (2 .. (2*$n).sqrt.Int).map: { $_ ** 2 => True };
say ":Perfect squares: { %perfect-squares.keys.sort({ \
$^a <=> $^b }).join(", ") }" if $verbose;
my @done = 1,;
my %todo = (2 .. $n).map: * => True;
say recurse(@done, %todo) ?? @done.join(", ") !! "()";
sub recurse (@done, %todo)
{
return %perfect-squares{ @done[*-1] + @done[0] } unless %todo;
my $current = @done[*-1];
for %todo.keys.sort({ $^a <=> $^b }) -> $candidate
{
my $is-perfect = %perfect-squares{$current + $candidate};
say ":Considering { @done.join(",") } + $candidate -> \
{ $is-perfect ?? "ok" !! "not ok, backtrack" }"
if $verbose;
next unless $is-perfect;
@done.push: $candidate.Int;
%todo{$candidate}:delete;
return True if recurse(@done, %todo);
@done.pop;
%todo{$candidate} = True;
}
return False;
}[3] An integer larger than 1.
[5] Set up a hash (for easy lookup) with «perfect square» values.
The upper limit was chosen to avoid calculating too many values,
but $n would have worked out just as well in practice.
[11] Numbers added to the cyclus end up here. We start with 1,
as the examples do so. (We are talking about cycluses, so we can
rotate them so that the 1 is anywhere in the list - anyway.
[12] A list of integers not yet placed in the cyclus. This is a hash, as it is easier to remove arbitrary values from a hash than from an array.
[14] Recursively populate the cycle. If the result is «False», print an empty array. If we got an array, print the content (i.e. the cycle).
[16] The recursive procedure.
The procedure name is a recurring joke in my recursive programs. It means that the programmer (or reader) can curse and recurse. Recursively.
[18] If we have done them all, a final check that the last and first values in the cycle match up is all that is missing. Return the result.
[20] The current value is the last one in the cycle so far.
[22] Iterate over the unused values, in sorted order, as candidates for the next value in the cycle.
[23] Does the candidate value add up to a perfect square?
[30] If not, skip it.
[32] If yes, add it to the cycle,
[33] and remove it from the unused values.
Note that we are in the middle of recursion here, and [37,38] is there to make backtracking work.
[35] Report success if the recursion ended with success.
[37] If not, remove the last value in the cycle (the current candidate, as it did not fit),
[38] and add it (the candidate) to the unused values.
[41] Report failure if have tried all the unused values.
Running it:
$ ./hamiltonian-cycle 32
1, 8, 28, 21, 4, 32, 17, 19, 30, 6, 3, 13, 12, 24, 25, 11, 5, 31, 18, 7, \
29, 20, 16, 9, 27, 22, 14, 2, 23, 26, 10, 15
$ ./hamiltonian-cycle 3
()
$ ./hamiltonian-cycle 34
1, 3, 13, 12, 4, 32, 17, 8, 28, 21, 15, 34, 30, 19, 6, 10, 26, 23, 2, 14, \
22, 27, 9, 16, 33, 31, 18, 7, 29, 20, 5, 11, 25, 24
The challenge lists this sequence for the third example:
1, 8, 28, 21, 4, 32, 17, 19, 6, 30, 34, 15, 10, 26, 23, 2, 14, 22, 27, 9, \
16, 33, 31, 18, 7, 29, 20, 5, 11, 25, 24, 12, 13, 3
Mine is equally valid, as demonstrated by this program that takes a comma separated list of integers and tells us if it is a Hamiltonian Cycle.
File: is-hamiltonian-cycle#! /usr/bin/env raku
unit sub MAIN ($str, :v(:$verbose));
my @seq = $str.split(/\s*\,\s*/)>>.Int;
my $n = @seq.max;
my $ok = True;
my %perfect-squares
= (2 .. $n).map: { $_ ** 2 => True };
die "Missing '1'" unless @seq.min == 1;
die "Missing '$n'" unless @seq.elems == $n;
die "Duplicates" unless @seq.elems == @seq.unique.elems;
for ^@seq.elems -> $index
{
my $left = @seq[$index];
my $right = $index == $n -1 ?? @seq[0] !! @seq[$index +1];
my $sum = $left + $right;
my $is-square = %perfect-squares{$sum}:exists;
say ":Index $index: $left + $right = $sum -> \
{ $is-square ?? "ok" !! "not ok" }" if $verbose;
unless $is-square
{
$ok = False;
last;
}
}
say $ok ?? "ok" !! "not ok";[5] Split the input string into a list of (integer) values. (You can
pass in numeric values instead of integers, and they will be coerced.
E.g. 3.14 -> 3.)
[10] Se «hamiltonian-cycle» => [5].
[12-14] Ensure that we have all the unique integers (1 .. $n)
that we need, and nothing else.
[16] Iterate over the indices.
[19] At the very end, the «left» value is a cliffhanger - so we use the beginning (index 0) as the «right» value.
[26+29] End on failure.
[33] Report failure or success (failure to fail in [26-30] means success).
Running it:
$ ./is-hamiltonian-cycle "1, 8, 28, 21, 4, 32, 17, 19, 6, 30, 34, 15, 10, \
26, 23, 2, 14, 22, 27, 9, 16, 33, 31, 18, 7, 29, 20, 5, 11, 25, 24, 12, \
13, 3"
ok
$ ./is-hamiltonian-cycle "1, 3, 13, 12, 4, 32, 17, 8, 28, 21, 15, 34, 30, \
19, 6, 10, 26, 23, 2, 14, 22, 27, 9, 16, 33, 31, 18, 7, 29, 20, 5, 11, \
25, 24"
ok
So, looking good.
Verbose mode on «my» cycle:
$ ./is-hamiltonian-cycle -v "1, 3, 13, 12, 4, 32, 17, 8, 28, 21, 15, 34, \
30, 19, 6, 10, 26, 23, 2, 14, 22, 27, 9, 16, 33, 31, 18, 7, 29, 20, 5, \
11, 25, 24"
:Index 0: 1 + 3 = 4 | ok
:Index 1: 3 + 13 = 16 | ok
:Index 2: 13 + 12 = 25 | ok
:Index 3: 12 + 4 = 16 | ok
:Index 4: 4 + 32 = 36 | ok
:Index 5: 32 + 17 = 49 | ok
:Index 6: 17 + 8 = 25 | ok
:Index 7: 8 + 28 = 36 | ok
:Index 8: 28 + 21 = 49 | ok
:Index 9: 21 + 15 = 36 | ok
:Index 10: 15 + 34 = 49 | ok
:Index 11: 34 + 30 = 64 | ok
:Index 12: 30 + 19 = 49 | ok
:Index 13: 19 + 6 = 25 | ok
:Index 14: 6 + 10 = 16 | ok
:Index 15: 10 + 26 = 36 | ok
:Index 16: 26 + 23 = 49 | ok
:Index 17: 23 + 2 = 25 | ok
:Index 18: 2 + 14 = 16 | ok
:Index 19: 14 + 22 = 36 | ok
:Index 20: 22 + 27 = 49 | ok
:Index 21: 27 + 9 = 36 | ok
:Index 22: 9 + 16 = 25 | ok
:Index 23: 16 + 33 = 49 | ok
:Index 24: 33 + 31 = 64 | ok
:Index 25: 31 + 18 = 49 | ok
:Index 26: 18 + 7 = 25 | ok
:Index 27: 7 + 29 = 36 | ok
:Index 28: 29 + 20 = 49 | ok
:Index 29: 20 + 5 = 25 | ok
:Index 30: 5 + 11 = 16 | ok
:Index 31: 11 + 25 = 36 | ok
:Index 32: 25 + 24 = 49 | ok
:Index 33: 24 + 1 = 25 | ok
ok
Verbose mode in «hamiltonian-cycle» gives a lot of output; 40402 rows for the first example, and 54141 rows for the third one. So I'll refrain from showing them...
The second example, the one that fails, is much shorter:
$ ./hamiltonian-cycle -v 3
:Perfect squares: 4
:Considering 1 + 2 -> not ok, backtrack
:Considering 1 + 3 -> ok
:Considering 1,3 + 2 -> not ok, backtrack
()
Input: $str = "01??0"
Output: ("01000", "01010", "01100", "01110")
Input: $str = "101"
Output: ("101")
Input: $str = "???"
Output: ("000", "001", "010", "011", "100", "101", "110", "111")
Input: $str = "1?10"
Output: ("1010", "1110")
Input: $str = "1?1?0"
Output: ("10100", "10110", "11100", "11110")
#! /usr/bin/env raku
unit sub MAIN ($str where $str ~~ /^ <[01\?]>+ $/,
:v(:$verbose));
my @todo = $str;
my @ok;
while @todo
{
my $current = @todo.shift;
my $pos = $current.index('?');
if defined $pos
{
for '0', '1' -> $digit
{
$current.substr-rw($pos, 1) = $digit;
@todo.push: $current;
say ":Added $current to todo list" if $verbose;
}
}
else
{
@ok.push: $current;
}
}
say "(" ~ @ok.map( '"' ~ * ~ '"' ).join(", ") ~ ")";[3] Ensure valid characters only in the string, with at least one.
[6] A working list of strings not yet parsed for question marks.
[7] The final result will end up in this list.
[9] As long as we have unfinished buiness.
[11] Get the first one.
[12] Get the position of the first question mark (from
the left) with index.
See docs.raku.org/routine/index for more information about index.
Related functions:
rindex - for searching from the right instead
contains - returns a Boolean value, not a position
[14] Did it contain a (at least one) question mark?
[16] For both digits 0 and 1;
[18] Replace the character at the question mark position with the
digit. The first time we replace ? with 0, and
the secomd time we replace the newly added 0 with 1.
[19] Add the modifed string to the working list. (Two in total, beacause of the loop.)
[23] No question mark in the string?
[25] Add it to the result.
[29] Pretty print the result. (This line of code is not pretty, though...)
Running it:
$ ./replace-question-mark "01??0"
("01000", "01010", "01100", "01110")
$ ./replace-question-mark "101"
("101")
$ ./replace-question-mark "???"
("000", "001", "010", "011", "100", "101", "110", "111")
$ ./replace-question-mark "1?10"
("1010", "1110")
$ ./replace-question-mark "1?1?0"
("10100", "10110", "11100", "11110")
Looking good.
With verbose mode:
$ ./replace-question-mark -v "01??0"
:Added 010?0 to todo list
:Added 011?0 to todo list
:Added 01000 to todo list
:Added 01010 to todo list
:Added 01100 to todo list
:Added 01110 to todo list
("01000", "01010", "01100", "01110")
$ ./replace-question-mark -v "101"
("101")
$ ./replace-question-mark -v "???"
:Added 0?? to todo list
:Added 1?? to todo list
:Added 00? to todo list
:Added 01? to todo list
:Added 10? to todo list
:Added 11? to todo list
:Added 000 to todo list
:Added 001 to todo list
:Added 010 to todo list
:Added 011 to todo list
:Added 100 to todo list
:Added 101 to todo list
:Added 110 to todo list
:Added 111 to todo list
("000", "001", "010", "011", "100", "101", "110", "111")
$ ./replace-question-mark -v "1?10"
:Added 1010 to todo list
:Added 1110 to todo list
("1010", "1110")
$ ./replace-question-mark -v "1?1?0"
:Added 101?0 to todo list
:Added 111?0 to todo list
:Added 10100 to todo list
:Added 10110 to todo list
:Added 11100 to todo list
:Added 11110 to todo list
("10100", "10110", "11100", "11110")
And that's it.