The Bear's Den

Enter at your own risk

17 July 2026 Challenge 382

Hamiltonian Marks

Task 1: Hamiltonian Cycle

Submitted by: Peter Campbell Smith

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.

Example 1

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.

Example 2

Input: $n = 15
Output: ()

No valid circular list of numbers exists.

Example 3

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

Solution

We build an undirected graph of vertices \(1,\ldots,n\) where two vertices \((i, j)\) are connected with an edge if \(i + j\) is a perfect square. In this graph we need to find a Hamiltonian cycle.

In general, finding an Hamiltonian cycle in a graph is known to be NP-complete. For some special classes of graphs there do exist more efficient solutions, but I can’t tell if this task’s graph belongs to any of those cases. Therefore the best I can do is using a known algorithm.

If the weather hadn’t been that good, I might have tried to implement Rubin’s procedure to find a Hamiltonian cycle. So I’ll keep this for a gray week in autumn and try something that is ready-to-use now.

Looking at the languages I’ve used to solve The Weekly Challenge, Maxima stands out with a built-in solver for this task.

Maxima

I cannot think of a solution simpler than this:

(%i1) batch("maxima/ch-1.mac")

read and interpret /home/jo/Programs/pwc/challenge-382/jo-37/maxima/ch-1.mac
(%i2) load("graphs")
(%i3) have_squaresum(i,j):=is(i+j = floor(sqrt(i+j))^2)
(%i4) squaresum_graph(n):=make_graph(n,have_squaresum)
(%i5) hamilton_cycle(squaresum_graph(32))
(%o5) [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]
(%i6) hamilton_cycle(squaresum_graph(15))
(%o6)                                 []
(%i7) hamilton_cycle(squaresum_graph(34))
(%o7) [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, 1]

The next example is still sub-second in running time and at the same time the largest I could handle at all:

(%i5) hamilton_cycle(squaresum_graph(118))
(%o5) [1, 3, 6, 10, 15, 21, 4, 5, 11, 14, 2, 7, 9, 16, 20, 29, 35, 46, 18, 31, 
33, 48, 52, 12, 13, 23, 98, 71, 50, 94, 27, 22, 42, 39, 25, 75, 69, 100, 96, 
73, 8, 17, 19, 102, 67, 54, 90, 79, 117, 108, 36, 28, 53, 47, 34, 30, 51, 49, 
72, 97, 24, 40, 41, 59, 62, 38, 106, 63, 37, 44, 77, 92, 104, 65, 56, 88, 81, 
115, 110, 86, 58, 111, 85, 84, 60, 61, 83, 113, 112, 32, 68, 101, 43, 57, 64, 
105, 91, 78, 66, 103, 93, 76, 45, 55, 114, 82, 87, 109, 116, 80, 89, 107, 118, 
26, 95, 74, 70, 99, 1]

Update:
A shot in the dark: It took 5:20 min.

%i5) hamilton_cycle(squaresum_graph(169))
(%o5) [1, 3, 6, 10, 15, 21, 4, 5, 11, 14, 2, 7, 9, 16, 20, 29, 35, 46, 18, 31, 
33, 48, 52, 12, 13, 23, 26, 38, 43, 57, 24, 25, 39, 42, 22, 27, 37, 44, 56, 8, 
17, 19, 30, 34, 47, 53, 28, 36, 45, 55, 66, 78, 91, 105, 64, 80, 41, 40, 60, 
61, 83, 86, 58, 63, 81, 88, 108, 117, 139, 150, 75, 69, 100, 96, 73, 71, 50, 
94, 162, 127, 98, 158, 67, 129, 160, 65, 131, 125, 164, 32, 49, 51, 70, 74, 
151, 138, 118, 107, 149, 76, 68, 101, 155, 134, 62, 163, 93, 132, 157, 99, 
126, 130, 95, 161, 128, 97, 159, 165, 124, 72, 153, 103, 122, 167, 89, 136, 
120, 169, 87, 82, 114, 111, 145, 144, 112, 113, 143, 146, 79, 90, 106, 119, 
137, 152, 104, 121, 135, 154, 102, 123, 166, 59, 110, 115, 54, 142, 147, 109, 
116, 140, 85, 84, 141, 148, 77, 92, 133, 156, 168, 1]

Task 2: Replace Question Mark

Submitted by: Simon Green

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.

Example 1

Input: $str = "01??0"
Output: ("01000", "01010", "01100", "01110")

Example 2

Input: $str = "101"
Output: ("101")

Example 3

Input: $str = "???"
Output: ("000", "001", "010", "011", "100", "101", "110", "111")

Example 4

Input: $str = "1?10"
Output: ("1010", "1110")

Example 5

Input: $str = "1?1?0"
Output: ("10100", "10110", "11100", "11110")

Solution

Question marks are replaced by zero/one and other characters will be preserved.

Perl

Convert the given string into an array, find the indices of question marks therein, use these indices to slice the array, assign an enumeration of all binary digits to the slice and gather the resulting strings.

use strict;
use warnings;
use List::MoreUtils 'indexes';
use List::Gather;
use Math::Prime::Util 'todigits';

sub replace_qm {
    my @arr = split //, shift;
    my @qmi = indexes {$_ eq '?'} @arr;

    gather {
        local $" = '';
        for (0 .. 2**@qmi - 1) {
            @arr[@qmi] = todigits $_, 2, @qmi;
            take "@arr";
        }
    };
}

See the full solution to task 2.

J

The J solution is basically the same, though a simple edge case requires more attention.

Find the indices of question marks in the given character array and amend the array at these indices with the enumerated binary digits.

If there is no question mark in the string, the list of indices is empty. However, the list of binary numbers with zero length has one element: \(2^0 = 1\). In the used implementation it would cause an argument x with a shape of 1 that is not compatible with an empty index list m in an amend operation x m} y. Using an appropriate “dynamic power” u^:*, a zero length binary enumeration produces a zero atom that is compatible with an empty index list.

Core of this implementation is the adverb a1_ux that encapsulates the explicit expression that is required to call the verb generated by “amend” with rank 1.

rqm =: _(adverb define)
   NB. find indices of question marks
   qmi =. I.@('?'&=)

   NB. enumerate binary numbers from 0 to 2^y - 1
   NB. as character arrays or pass a zero atom
   enum_bin_str =. ,"2@:(":"0)@:#:@i.@(2&^)^:*

   NB. specialized version of "amend":
   NB. - use x as the indices
   NB. - use u x as the replacement values
   NB. - operate on rows of u x
   a1_ux =. adverb def '(u x) (x })"1 y'

   NB. find indices of question marks in y and
   NB. replace these positions with all binary
   NB. digits in the respective length
   (qmi (enum_bin_str@# a1_ux) ]) f. : [:
)

Example 5:

   rqm '1?1?0'
10100
10110
11100
11110

See the full solution.