TL;DR

Let’s look at an example of using ConstraintSolver.pm, introduced in previous post More constraint programming.

But first… a confession: I’m quite not satisfied with the code that I’m going to show… but time is a limited resource, so I’ll stick with it because it shows how to use ConstraintSolver.pm on a real problem and gets the job done.

Autobiographical numbers?

It sort of started from video Can you solve the Leonardo da Vinci riddle? - Tanya Khovanova, but not really. It’s complicated 🙄

Sure, the name autobiographical numbers comes from that video. But full credits have to be given to the stellar Coursera online course Discrete Optimization, by Professor Pascal Van Hentenryck and Dr. Carleton Coffrin. It’s taking more time than I anticipated, but it’s totally worth the effort.

In particular, class 6 CP 6 - redundant constraints, magic series, market split in week 3 deals about magic series… which are exactly the same concept.

So, in a nutshell, assume you have an array of $N$ elements, indexed starting from 0:

  0   1   2   3   4        n-2 n-1 
+---+---+---+---+---+ ... +---+---+
|   |   |   |   |   |     |   |   |
+---+---+---+---+---+ ... +---+---+

Each slot in the array is supposed to contain a non-negative integer number, representing the number of times that the slot’s index appears in the array itself. I guess Douglas Richard Hofstadter would feel at home.

Example? Let’s consider $N = 4$, this would be a solution:

  0   1   2   3
+---+---+---+---+
| 1 | 2 | 1 | 0 |
+---+---+---+---+

As you can see:

slot 0 contains a $1$, which means that there is exactly one $0$ the array. This is true indeed, it’s in slot 3;
slot 1 contains a $2$, which is consistent with the fact that $1$ appears exactly two times in the array (in slot 0 and in slot 2)
you get the idea for slots 2 and 3 😅

Let’s solve this!

Let’s use ConstraintSolver.pm then:

sub autobiographical_numbers ($n) {
  my $solution = [
     map {
        +{map { $_ => 1 } 0 .. $n - 1}
     } 1 .. $n
  ];
  my @constraints = map { main->can('constraint_' . $_) }
    (qw< basic total_sum weighted_sum last_is_zero >);
  my $state = solve_by_constraints(
     constraints    => \@constraints,
     is_done        => \&is_done,
     search_factory => \&explore,
     start          => {solution => $solution},
     logger         => ($ENV{VERBOSE} ? \&printout : undef),
  );
} ## end sub autobiographical_numbers ($n)

The function solve_by_constraints does the overall orchestration, but the heavy lifting is up to us: think about a data structure, as well as providing suitable callback functions for the different stages of the constraints programming search.

Our solution starts as an Array of Arrays where each slot contains the candidates for the specific slot. It’s initialized with all integers between $0$ and $N-1$ (both included) because there can be no less than $0$ and no more tha $N-1$, right?

The data structure is a hash reference passed via start (line 13). It’s a reference to a hash with a few keys inside. It’s initialized with solution, an array reference containing hashes whose keys are the possible candidate values to occupy the slot. This choice is probably something that should be revisited, because it makes it easier to look for specific elements, but it makes it very bad to e.g. look for the minimum or the maximum element. As anticipated, I’m not exactly proud of this code!

Accessories

The logger functions is quite simple:

sub printout ($phase, $status, $exception = undef) {
  if ($phase eq 'backtrack') {
     if ($@) {
        (my $e = $@) =~ s{\sat\s.*?\sline\s[0-9]+\.\s+\z}{}mxs;
        $phase = "backtrack[$e]";
     }
     else {
        $phase = 'explore';
     }
  }
  say $phase, ' => ', encode_json [
     map {
        my @candidates = sort { $a <=> $b } keys $_->%*;
        @candidates > 1 ? \@candidates
        : @candidates > 0 ? 0 + $candidates[0]
        : '[]'
     } $status->{solution}->@*
  ];
} ## end sub printout

Each hash reference is transformed back to a sorted array before being put in the output array, whose reference is encoded with json and then printed out. The logging function receives the step as the first argument, so we print that too; additionally, when backtracking, the function also receives the exception that was thrown, so we make sure to include it (line 5) or to mark this as a simple search start (line 8).

Function is_done tells us whether our quest is complete or not:

sub is_done ($status) {
   return scalar(grep { keys $_->%* > 1 } $status->{solution}->@*) == 0;
}

It basically counts the number of slots where we don’t have a decision yet (i.e. where there is more than one alternative), and gives green light only when all slots are decided.

Exploring

The search_factory function is supposed to give out a sub that iterates over possible alternative decisions at a specific level in our depth search. In this case, each level addresses one slot.

sub explore ($status) {
  my $solution = dclone($status->{solution});    # our working solution
  my $n        = $solution->@*;

  # this investigates a single slot...
  my $slot_id = 0;
  while ($slot_id < $n) {
     last if keys $solution->[$slot_id]->%* > 1;
     $slot_id++;
  }
  die 'wtf?!?' if $slot_id >= $n;
  my @candidates = sort { $a <=> $b } keys $solution->[$slot_id]->%*;
  my $amount;
  return sub ($status) {                         # get "next" solution
     return unless @candidates;
     $amount = shift @candidates;
     $status->{solution} = dclone($solution);
     $status->{solution}[$slot_id] = {$amount => 1};
     return 1;
  };
} ## end sub explore ($status)

This is why line 14 returns a sub. In the preparation phase (lines 2 to 13) we set up for a search in a suitable slot, i.e. a slot where we still have to take a decision (hence the test in line 8). When this slot is found in $slot_id, we take all of its alternatives and populate @candidates, which we will use for iterating different alternatives inside the iterator function.

At each step, we will first of all restore the status as in the beginning (line 17, to undo any pruning that was attempted in the previous step), then set the specific slot to a hash that has one single choice among the candidates (line 18).

Curious?

We’re at the end of this post now… if you’re curious about the constraints, please hold on until the next post, or take a sneak peek at the repository.

Update fix code with latest changes, and add reference to repository.

So long…

Curious about the whole series? Here it is:

Comments? Please comment below!