Perl Weekly Challenge 382.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 382.
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

[2026-07-13 11:45]: Output was incorrect, corrected by E. Choroba.
A very inneficient but simple solution is to keep a list of remaining numbers and try to recursively construct a list by adding unused numbers that add to a square until all numbers are used or failure is detected. The result fits a 3-liner.
Examples:
perl -E '
for(@ARGV){say"$_ -> @{f([1],[2..$_])}"}sub f($i, $r){my$l=$i->[-1];@$r||return
g($l+$i->[0])?$i:0;for(0..@$r-1){g($l+$r->[$_])||next;$o=f([@$i,$r->[$_]],
[@$r[0..$_-1,$_+1..@$r-1]]);return $o if $o;}0;}sub g($x){$x==floor(sqrt($x))**2}
' 32 15 34
Results:
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
15 ->
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
By the way, this problem has multiple solutions. My code shows the first one it finds.
The full code follows:
1 # Perl weekly challenge 382
2 # Task 1: Hamiltonian Cycle
3 #
4 # See https://wlmb.github.io/2026/07/13/PWC382/#task-1-hamiltonian-cycle
5 use v5.40;
6 use feature qw(try);
7 use Scalar::Util qw(looks_like_number);
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 N0 N1...
10 to build a Hamiltonian cycle that visits all numbers 1..Nn
11 such that two consecutive numbers in the cycle add to a perfect square.
12 FIN
13 for(@ARGV){
14 try {
15 die "Expected a number: $_"
16 unless looks_like_number $_;
17 say"$_ -> (@{hamiltonian([1],[2..$_])||[]})"
18 }
19 catch($e){warn $e; }
20 }
21 sub hamiltonian($so_far, $rest){
22 my $last=$so_far->[-1];
23 return is_square($last + $so_far->[0])?
24 $so_far : () unless @$rest; # all consumed
25 for(0..@$rest-1){
26 next unless is_square($last + $rest->[$_]);
27 my $result =
28 hamiltonian(
29 [@$so_far, $rest->[$_]],
30 [@$rest[0..$_-1, $_+1..@$rest-1]]
31 );
32 return $result if $result;
33 }
34 return 0;
35 }
36 sub is_square($x){
37 $x==floor(sqrt($x))**2;
38 }
Example:
./ch-1.pl 32 15 34
Results:
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)
15 -> ()
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)
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")
A simple solution is recursively substituting each question mark by 1 and by 0 until there are no more question marks. I use the option r to return the susbtitutions leaving the original string untouched. This yields a two-liner.
Examples:
perl -E '
for(@ARGV){say "$_ -> ", join " ", f($_);}sub f($s){for($s){
return ($_) unless /\?/;return (f(s/\?/0/r), f(s/\?/1/r));}}
' 01??0 101 ??? 1?10 1?1?0
Results:
01??0 -> 01000 01010 01100 01110
101 -> 101
??? -> 000 001 010 011 100 101 110 111
1?10 -> 1010 1110
1?1?0 -> 10100 10110 11100 11110
I guess there might be some more efficient solution in which the regular expression machine could perform the recursive replacements, but I didn’t pursue it.
The full code is
1 # Perl weekly challenge 382
2 # Task 2: Replace Question Mark
3 #
4 # See https://wlmb.github.io/2026/07/13/PWC382/#task-2-replace-question-mark
5 use v5.36;
6 use feature qw(try);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 S0 S1...
9 to substitute the each question mark (?) by 0 and by 1
10 in the strings Sn.
11 FIN
12 for(@ARGV){
13 try {
14 die "Only 1, 0 and ? are allowed: $_" unless /^[01\?]*$/;
15 say "$_ -> (", join(" ", replace($_)), ")";
16 }
17 catch($e){warn $e}
18 }
19 sub replace ($s){
20 for($s){
21 return ($_) unless /\?/;
22 return (replace(s/\?/0/r), replace(s/\?/1/r));
23 }
24 }
Example:
./ch-2.pl 01??0 101 ??? 1?10 1?1?0
Results:
01??0 -> (01000 01010 01100 01110)
101 -> (101)
??? -> (000 001 010 011 100 101 110 111)
1?10 -> (1010 1110)
1?1?0 -> (10100 10110 11100 11110)
/;
Written on July 13, 2026