Perl Weekly Challenge: The World Turned Upside Down!

Posted on by

Perl Weekly Challenge 382‘s tasks are “Hamiltonian Cycle” and “Replace Question Mark”.

As soon as I saw “Hamiltonian”, I knew I needed to use a song from Hamilton: An American Musical… but I couldn’t decide which song best fit with “Cycle”. So I did what I always do when I’m stumped for a creative choice: I asked my wife.

“The Hamilton Polka“, she immediately responded.1 “It’s a five-minute song cycle.”

When she’s right, she’s right.

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.

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

Approach

I’ll be honest, I needed to look up what a Hamiltonian cycle was. It’s a path through a graph that visits each node in the graph exactly once, and ends up where it began. In our case, the graph connects each of the numbers from 1 to $n to any other number where their sum is a square.

One thing I’m going to do is pre-calculate the squares that we can have as sums. To do that, I’m going to find the largest possible sum in the set, which is $n + $n-1, and then take the square root of it, truncate it to an integer, and then loop from 2 to that number and calculate the squares. If I store these in a hash, I can check to see if any sum is a square just by checking to see if it’s in the hash.

According to Frank Rubin’s 1974 paper, “A Search Procedure for Hamilton Paths and Circuits” the algorithm for finding a Hamilton circuit through the graph is:

  1. Select any single node as the initial path.
  2. Test the path for admissibility.
  3. If the path so far is admissible, list the successors of the last node chosen, and extend the path to the first of these. Repeat step 2.
  4. If the path so far is inadmissible, delete the last node chosen and choose the next listed successor of the preceding node. Repeat step 2.
  5. If all extensions from a given node have been shown inadmissible, repeat step 4.
  6. If all extensions from the initial node have been shown inadmissible, then no circuit exists.
  7. If a successor of the last node is the origin, a Hamilton circuit is formed.

Step 2 is testing to see if the two numbers chosen sum to a square.

Raku

One of the things I realized while I was implementing the Raku solution was that I didn’t need to test all the paths in step 2. Rather than loop over the remaining numbers, add them to the previous number on the path, and see if the sum is a square, I could loop over the squares, subtract the previous number on the path, and check to see if the difference was in my list of remaining numbers. For instance, after I’ve chosen 1 as the starting number, instead of looping through [2..32] to see if any of them sum up to a square, I loop through [4, 9, 16, 25, 36, 49, 64] to see if subtracting 1 from any of them yields a number still in the numbers I haven’t added to the path. That’s when I swapped from keeping my remaining values in an array and the squares in a hash (because I thought I’d be checking squares) to keeping my squares in an array (because in all but the final check I would be looping over them) and the numbers that hadn’t been slotted into the path in a hash.

multi hamiltonianCycle($n, @path, %nums is copy, @square) {
  # do we have $n numbers in the path
  if ($n == @path.elems) {
    # is first+last a square? if it is, we're done!
    my $sum = @path[0] + @path[*-1];
    # it doesn't sum to a square, ditch the last in path
    @path.pop unless $sum == @square.any;
    return;
  }
  for @square -> $s {
    my $diff = $s - @path[*-1];
    next unless %nums{$diff}:exists; # not a num that's waiting

    # it's a possibility, add it to the path
    @path.push($diff);

    # remove $diff from nums that are waiting
    %nums{$diff}:delete;

    # call with this proposed path, and all the remaining nums
    hamiltonianCycle($n, @path, %nums, @square);

    # we have a full path, so let's return!
    return if ($n == @path.elems);

    # put $diff back on the waiting list
    %nums{$diff} = $diff;
  }
  @path.pop; # we didn't find a path, pop off the last & return
  return;
}

multi hamiltonianCycle($n) {
  # precaclulate squares
  my $m = sqrt($n + $n-1).Int;
  my @square = (2 .. $m).map({ $_ ** 2 });
  my %nums   = (1 .. $n).map({ $_ => $_});
  my @path   = ( %nums{1}:delete ); # start with 1
  hamiltonianCycle($n, @path, %nums, @square);
  return @path;
}

View the entire Raku script for this task on GitHub

$ raku/ch-1.raku
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
30 +  6 = 36
 6 +  3 =  9
 3 + 13 = 16
13 + 12 = 25
12 + 24 = 36
24 + 25 = 49
25 + 11 = 36
11 +  5 = 16
 5 + 31 = 36
31 + 18 = 49
18 +  7 = 25
 7 + 29 = 36
29 + 20 = 49
20 + 16 = 36
16 +  9 = 25
 9 + 27 = 36
27 + 22 = 49
22 + 14 = 36
14 +  2 = 16
 2 + 23 = 25
23 + 26 = 49
26 + 10 = 36
10 + 15 = 25
15 +  1 = 16

Example 2:
Input: $n = 15
Output: ()

No valid circular list of numbers exists.

Example 3:
Input: $n = 34
Output: 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 +  3 =  4
 3 + 13 = 16
13 + 12 = 25
12 +  4 = 16
 4 + 32 = 36
32 + 17 = 49
17 +  8 = 25
 8 + 28 = 36
28 + 21 = 49
21 + 15 = 36
15 + 34 = 49
34 + 30 = 64
30 + 19 = 49
19 +  6 = 25
 6 + 10 = 16
10 + 26 = 36
26 + 23 = 49
23 +  2 = 25
 2 + 14 = 16
14 + 22 = 36
22 + 27 = 49
27 +  9 = 36
 9 + 16 = 25
16 + 33 = 49
33 + 31 = 64
31 + 18 = 49
18 +  7 = 25
 7 + 29 = 36
29 + 20 = 49
20 +  5 = 25
 5 + 11 = 16
11 + 25 = 36
25 + 24 = 49
24 +  1 = 25

Perl

Really, the Perl solution is the same as the Raku solution, but instead of passing arrays, I’m passing array references. Oh, and Perl doesn’t have a built-in Multiple-dispatch concept like Raku does, so I just gave the four-argument version of the function a different name.

use List::AllUtils qw( any );

sub hamiltonianCycleMulti($n, $path, $square, %nums) {
  # do we have $n numbers in the path
  if ($n == scalar @$path) {
    # is first+last a square? if it is, we're done!
    my $sum = $path->[0] + $path->[-1];
    # it doesn't sum to a square, ditch the last in path
    pop @$path unless any { $sum == $_ } @$square;
    return;
  }
  for my $s ( @$square ) {
    my $diff = $s - $path->[-1];
    next unless exists $nums{$diff}; # not a num that's waiting

    # it's a possibility, add it to the path
    push @$path, $diff;

    # remove $diff from nums that are waiting
    delete $nums{$diff};

    # call with this proposed path, and all the remaining nums
    hamiltonianCycleMulti($n, $path, $square, %nums);

    # we have a full path, so let's return!
    return if ($n == scalar @$path);

    # put $diff back on the waiting list
    $nums{$diff} = $diff;
  }
  pop @$path; # we didn't find a path, pop off the last & return
  return;
}

sub hamiltonianCycle($n) {
  # precaclulate squares
  my $m = int(sqrt($n + $n-1));
  my @square = map { $_ ** 2 } (2 .. $m);
  my %nums   = map { $_ => $_} (1 .. $n);
  my @path   = ( delete $nums{1} ); # start with 1
  hamiltonianCycleMulti($n, \@path, \@square, %nums);
  return @path;
}

View the entire Perl script for this task on GitHub.

Python

And the Raku solution translated into Python fairly quickly, too. Since Python passes function arguments by “assignment” (references to objects, and everything is an object in Python), I’m able to modify the path array in my functions and have the changes reflected in the code that called the function. Similarly, Python does not have built-in multiple dispatch, so I just renamed the four-argument version of the function.

from math import sqrt

def hamiltonian_cycle_multi(n, path, nums, square):
  # do we have n numbers in the path
  if n == len(path):
    # is first+last a square? if it is, we're done!
    sum = path[0] + path[-1]
    # it doesn't sum to a square, ditch the last in path
    if sum not in square:
      path.pop(-1)
    return

  for s in square:
    diff = s - path[-1]
    if diff not in nums: continue # not a num that's waiting

    # it's a possibility, add it to the path
    path.append(diff)

    # remove diff from nums that are waiting
    nums.pop(diff)

    # call with this proposed path, and all the remaining nums
    hamiltonian_cycle_multi(n, path, nums, square)

    # we have a full path, so let's return!
    if n == len(path): return

    # put diff back on the waiting list
    nums[diff] = diff

  path.pop(-1) # we didn't find a path, pop off the last & return
  return

def hamiltonian_cycle(n):
  # precaclulate squares
  m = int(sqrt(n + n-1))
  square = [ i**2 for i in range(2, m+1) ]
  nums   = { i: i for i in range(1, n+1) }
  path   = [ nums.pop(1) ] # start with 1
  hamiltonian_cycle_multi(n, path, nums, square)
  return path

View the entire Python script for this task on GitHub.

Elixir

Elixir, however, does have multiple dispatch! There were, however, some complicating factors:

  • There isn’t a built-in Elixir sqrt function. I could either use Mix.import to install the Math module, which has an excellent Math.isqrt(x) function, or just use the underlying Erlang :math.sqrt(x) function and pass that through Kernel.trunc/1, which I did on line 53.
  • I finally managed to use Enum.reduce_while/3, which lets you loop over an enumerable and abort the loop early, like last in Raku/Perl or break in Python.
  • Because the only way to get information out of an Elixir function is to return it as a return value, I modified the hamiltonian_cycle functions to all return path.
defp hamiltonian_cycle(n, path, _, square)
when n == length(path) do
  # we have n numbers in the path
  # is first+last a square? if it is, we're done!
  sum = List.first(path) + List.last(path)
  cond do
    # we found a complete cycle!
    Enum.any?(square, &( &1 == sum )) -> path
    # it doesn't sum to a square, ditch the last in path
    true -> List.delete_at(path, -1)
  end
end

defp hamiltonian_cycle(n, path, nums, square) do
  {path, _} = Enum.reduce_while(square, {path, nums},
    fn s, {path, nums} ->
      diff = s - List.last(path)
      if Map.has_key?(nums, diff) do
        # it's a possibility, add it to the path
        path = path ++ [diff]

        # remove diff from nums that are waiting
        nums = Map.delete(nums, diff)

        # call with this proposed path, and all remaining nums
        path = hamiltonian_cycle(n, path, nums, square)

        # we have a full path, so let's return!
        if n == length(path) do
          {:halt, {path, nums}}
        else
          # put diff back on the waiting list
          nums = Map.put(nums, diff, diff)
          # continue with next s
          {:cont, {path, nums}}
        end
      else
        {:cont, {path, nums}} # diff not a num that's waiting
      end
    end)
  if n == length(path) do
    path
  else
    # we didn't find a path, pop off the last
    List.delete_at(path, -1)
  end
end

def hamiltonian_cycle(n) do
  # precaclulate squares
  m = :math.sqrt(n + n-1) |> trunc
  square = Enum.map(2..m, &( &1**2 ))
  nums   = Map.new(2..n, &( { &1, &1 } ))
  path   = [ 1 ] # start with 1
  hamiltonian_cycle(n, path, nums, square)
end

View the entire Elixir script for this task on GitHub.

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.

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")

Approach

I think the easiest way to handle this is not to try to do the permutations in place. First, we count the number of question marks in the string. If there are 0, we return the string unmodified. Then we produce all the combinations of that many 0s and 1s. Finally, we loop over the permutations and substitute the characters where question marks appear in the source string.

And how do we produce the combinations? Well, if n is the number of question marks, those are just the binary representations of the numbers from 0 to 2n-1.

Raku

To produce binary representations, I immediately reached for sprintf (yeah, because I’m an old Perl hacker). comb gets me a list of all the question marks in the string, and elems counts them for me. I handle the trivial case first, then loop over the binary numbers I’ve generated. I use comb again to break them up into individual digits, and then I use subst with a callable to replace the question marks with the digits, pushing the result onto an array to return as the result.

sub nums($n) {
  my @nums;
  for (0 .. (2**$n - 1)) -> $i {
    @nums.push: sprintf "%0*b", $n, $i;
  }
  @nums;
}

sub replaceQuestionMark($str) {
  # how many question marks
  my $marks = $str.comb(/\?/).elems;
  # trivial case: no question marks
  return [$str] if $marks == 0;
  # produce all the combinations
  my @output;
  for nums($marks) -> $bits {
    my @b = $bits.comb;
    @output.push: $str.subst(/\?/, { @b.shift }, :g);
  }
  @output
}

View the entire Raku script for this task on GitHub.

$ raku/ch-2.raku
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")

Perl

The Perl solution is almost exactly like the Raku solution, with the standard changes in syntax between the two languages.

sub nums($n) {
  my @nums;
  for my $i (0 .. (2**$n - 1)) {
    push @nums, sprintf "%0*b", $n, $i;
  }
  @nums;
}

sub replaceQuestionMark($str) {
  # how many question marks
  my $marks = scalar(@{[ $str =~ /\?/g ]});
  # trivial case: no question marks
  return $str if $marks == 0;
  # produce all the combinations
  my @output;
  for my $bits ( nums($marks) ) {
    my @b = split //, $bits;
    push @output, $str =~ s/\?/shift @b/ger;
  }
  @output
}

View the entire Perl script for this task on GitHub.

OMG – I love this solution

I was looking at other people’s solutions to this week’s tasks, and I came across Reinier Maliepaard‘s solution:

sub replace_question_mark {
    glob '{' . ($_[0] =~ s/\?/{0,1}/gr) . '}';
}

I had never thought to use glob this way! Read his blog post and his quick explainer on the brace expansion feature in glob to get how this works.

Python

Because I’m an old Perl hacker, I reached for Python’s format string. I couldn’t find a way to pass the width in as a parameter, so I just built the format string as a string

import re

def nums(n):
  nums = []
  for i in range(2 ** n):
    fmt = '{:0' + str(n) + 'b}'
    nums.append(fmt.format(i))
  return nums

def replace_question_mark(string):
  # how many question marks
  marks = len([ c for c in string if c == '?' ])
  # trivial case: no question marks
  if marks == 0: return [string]
  # produce all the combinations
  output = []
  for bits in nums(marks):
    b = [ c for c in bits ]
    output.append(re.sub(r'\?', lambda m: b.pop(0), string))
  return output

View the entire Python script for this task on GitHub.

Elixir

However, in Elixir I slightly changed up how I’m doing the replacement of the question marks. Instead of doing some kind of regular expression replacement, I chose to use String.split/3 to split the string on the question marks, and then use Enum.zip_with/3 and Enum.join/2 to reconstitute the string. Because all the Enum.zip* functions finish as soon as either enumerable runs out of elements, and the result of the split will always have one more element than the list of bits I’m replacing the question marks with, I’m padding the list of bits by adding an empty string to the end.

def nums(n) do
  Enum.map(0..(2 ** n-1), &(
    Integer.to_string(&1, 2) |> String.pad_leading(n, "0")
  ))
end

# trivial case: no question marks
def replace_question_mark(marks, str) when marks == 0, do:
  List.wrap(str)

# produce all the combinations
def replace_question_mark(marks, str) do
  Enum.reduce(nums(marks), [], fn bits, output ->
    b = String.graphemes(bits)
    output ++ [ String.split(str, "?")
    |> Enum.zip_with(b ++ [""], fn x, y -> x <> y end)
    |> Enum.join ]
  end)
end

def replace_question_mark(str) do
  # how many question marks
  marks = String.graphemes(str)
  |> Enum.filter(fn c -> c == "?" end)
  |> length
  replace_question_mark(marks, str)
end

View the entire Elixir script for this task on GitHub.

Here’s all my solutions in GitHub: https://github.com/packy/perlweeklychallenge-club/tree/challenge-382-packy-anderson/challenge-382/packy-anderson

  1. For complete transparency, I must point out that less than 12 hours earlier, my wife was watching Weird Al Yankovic perform as part of his Bigger & Weirder 2026 tour. ↩︎

Leave a Reply