Autumn Challenge 2024: Numbrix Puzzle

Hi,

A path inside a rectangular grid can be encoded by numbering
the cells so that successive integers are in adjacent cells.

Example:

  3---2---1  20--21
  |           |   |
  4  17--18--19  22
  |   |           |
  5  16--15--14  23
  |           |   |
  6   9--10  13  24
  |   |   |   |   |
  7---8  11--12  25

Turn it into a so called Numbrix puzzle, created by Marilyn vos
Savant, in that you reveal a few numbers, and the solitaire player

has to find and fill the remaining numbers. Similar approach
as in Sudoku, except the constaints are different.

Implement the following in Prolog:

a) A solver for Numbrix

b) A riddle generator for Numbrix

c) Some game play for Numbrix

Have Fun!

As a quick skeleton:

:- use_module(library(clpfd)).

numbrix(Steps) :-
    init_steps(5, Steps).

init_steps(RowLen, Steps) :-
    Size is RowLen * RowLen,
    length(Steps, Size),
    Steps ins 1..Size,
    all_different(Steps),
    % Sum of incrementing integers
    SumList is (Size * (Size + 1)) / 2,
    sum(Steps, #=, SumList),
    constrain_movement(Steps, RowLen).

constrain_movement([_], _).
constrain_movement([A,B|T], R) :-
    M in -1 \/ 1,
    D in 1 \/ R,
    B #= A + (M * D),
    constrain_movement([B|T], R).

Sample result using the example path, giving it some of the positions:

?- time((numbrix(S), nth1(1, S, 3), nth1(25, S, 25), nth1(7, S, 21), nth1(14, S, 14), nth1(19, S, 9), label(S))).
% 436,743 inferences, 0.063 CPU in 0.064 seconds (99% CPU, 6912710 Lips)
S = [3, 2, 1, 6, 11, 16, 21, 22, 17, 18, 23, 24, 19, 14, 13, 12, 7, 8, 9, 4, 5, 10, 15, 20, 25] ;
% 5,377,212 inferences, 0.355 CPU in 0.357 seconds (100% CPU, 15135283 Lips)
false.

What prevents a wrap around? I guess the fact
that you don’t use modulo in constrain_movement/2 ?
So sum/3 is used to speed up the search? Would it

also work without sum/3 and all_distinct/1 instead?
About the used path encoding, if you use this decoder:

decode_path(S, T) :-
   findall(V-N, nth1(N,S,V), L),
   keysort(L, R),
   pairs_values(R, T).

It gives the numbering of the path placed on the cells:

?- decode_path([3, 2, 1, 6, 11, 16, 21, 22, 17, 18, 23, 24, 19, 
    14, 13, 12, 7, 8, 9, 4, 5, 10, 15, 20, 25], L).
L = [3, 2, 1, 20, 21, 4, 17, 18, 19, 22, 5, 16, 15, 14, 23, 6, 
9, 10, 13, 24, 7, 8, 11, 12, 25].

It happens that L is this solution, see also A096969:

BTW: It gives another solution to @kuniaki.mukai problem. If you only
constrain left top and bottom right and would allow gaps, but is CLP(FD)
powerful enough to count rect(5,5), it does not have sat_count/2 ?

But because of a wrap condition is missing, it has
somewhere a bug. It counts too many solutions:

?- time(aggregate_all(count, (init_steps(4, S), label(S)), C)).
% 247,690,063 inferences, 15.141 CPU in 15.334 seconds (99% CPU, 16359302 Lips)
C = 2368.

But according to A096969 it should only count:

... 552 ...

Ah yeah, I was wondering how robust the wrap-around protection would be, with the sum/3 - it’s not robust.

Here’s alternative (slower) code which guards against horizontal wrap-around:

constrain_movement([_], _).
constrain_movement([A,B|T], R) :-
    Mul in -1 \/ 1,
    D in 1 \/ R,
    B #= A + (Mul * D),
    Mod #= A mod R,
    % Left edge wrap-around guard
    Mod #= 1 #==> B #\= A - 1,
    % Right edge wrap-around guard
    Mod #= 0 #==> B #\= A + 1,
    constrain_movement([B|T], R).

Result:

?- time(aggregate_all(count, (init_steps(4, S), label(S)), C)).
% 190,035,122 inferences, 11.910 CPU in 11.932 seconds (100% CPU, 15956246 Lips)
C = 552.

I expect this can be made faster :grinning:

2 Likes

Challenge accepted! How about vanilla Prolog:

?- time(aggregate_all(count, (between(0,3,X), 
    between(0,3,Y), path((X,Y), [(X,Y)])), C)).
% 952,151 inferences, 0.047 CPU in 0.059 seconds (80% CPU, 20312555 Lips)
C = 552.

Its a variation without any symmetry breaking
of my take on @kuniaki.mukai’s rect(4,4):

% next(+Pair, -Pair)
next((X,Y), (Z,Y)) :- X < 3, Z is X+1.
next((X,Y), (Z,Y)) :- X > 0, Z is X-1.
next((X,Y), (X,Z)) :- Y < 3, Z is Y+1.
next((X,Y), (X,Z)) :- Y > 0, Z is Y-1.

% path(+Pair, +List)
path(_, L) :- length(L, 16), !.
path(P, L) :-
   next(P, H), \+ member(H, L),
   path(H, [H|L]).

But didn’t try yet for larger grid sizes. Also the above is
without any cutting plane or otherwise memoization.

1 Like

Is this the same as https://loopypuzzle.com/, except that first integer must be adjacent to last integer?

A few times faster than previous, although still nowhere near impressive:

numbrix(Steps) :-
    init_steps(5, Steps).

init_steps(RowLen, Steps) :-
    Size is RowLen * RowLen,
    length(Steps, Size),
    Steps ins 1..Size,
    all_different(Steps),
    constrain_movement(Steps, RowLen).

constrain_movement([_], _).
constrain_movement([A,B|T], R) :-
    MR is -R,
    PR = R \/ MR,
    P in PR \/ 1 \/ -1,
    Mod #= A mod R,
    % Left edge wrap-around guard
    Mod #= 1 #==> P #\= -1,
    % Right edge wrap-around guard
    Mod #= 0 #==> P #\= 1,
    B #= A + P,
    constrain_movement([B|T], R).

Result:

?- time(aggregate_all(count, (init_steps(4, S), label(S)), C)).
% 39,539,104 inferences, 2.306 CPU in 2.316 seconds (100% CPU, 17143523 Lips)
C = 552.

But, nevertheless challenge accepted again. Lets experiment with
coding the coordinate pairs as single numbers, like in @brebs
solution, but still subscribe to vanilla Prolog. Plus code the list

itself also as a bigint, a bigint that represents a bitset:

?- time(aggregate_all(count, (between(0,15,P),
    Q is 1<<P, path(P, Q)), C)).
% 471,690 inferences, 0.031 CPU in 0.046 seconds (68% CPU, 15094080 Lips)
C = 552.

Only ca 20% speedier from 0.058 secs to 0.046 secs. Because
recreating integers is also expensive compared to just list consing.
Should use getbit/2 but there is no setbit/2 or resetbit/2 in SWI-Prolog.

next(P, Q) :- P mod 4 < 3, Q is P+1.
next(P, Q) :- P mod 4 > 0, Q is P-1.
next(P, Q) :- P div 4 < 3, Q is P+4.
next(P, Q) :- P div 4 > 0, Q is P-4.

path(_, L) :- 16 =:= popcount(L), !.
path(P, L) :-
   next(P, H), J is 1<<H,
   L /\ J =:= 0,
   R is L \/ J,
   path(H, R).

P.S.: First time I use popcount/1 evaluable function. Alternatively
one could use another test, but popcount/1 is closer to length/2.

That only made 0.3 seconds difference :grinning:

The clpfd reorg in constrain_movement made the big difference.

Hopefully as inspiration, this puzzle looks very similar to prolog - Optimized CLP(FD) solver for number board puzzle - Stack Overflow

Loopy allows me to make islands, that violates
a few Numbrix constraints:

image

But numbrix should have one single connected
path, that is also filling the whole space. If you can

add these constraints to loopy your are done and you got
a kind of “cellular” representation of Numbrix.

Just a wild guess: For all odd squares (3x3, 5x5, …) it is impossible without an island.
But even square works (2x2, 4x4, …)

What do you mean by that? I don’t understand.
This here is a Numbrix solution for 5x5,

it doesn’t have some untouched (X,Y) locations, and you
can follow the path conectedly through all (X,Y) locations:

But some folks call it also rect(4,4), because you can
number by way of rows 0…4 and columns 0…4.

I meant a closed sequence (a loop).

Hamilton Paths or the circuit constraint are not directly
in the scope of Numbrix. But you can turn every

Numbrix solution, for odd and even squares into a circuit,
but adding an aditional edge, without adding a vertex.

Here is the same example as a circuit, by adding an
additional edge, from the vertex 25 to the vertex 1:

          +-----------+
          |           |
  3---2---1  20--21   |
  |           |   |   |
  4  17--18--19  22   |
  |   |           |   |
  5  16--15--14  23   |
  |           |   |   |
  6   9--10  13  24   |
  |   |   |   |   |   |
  7---8  11--12  25---+

This possibly leads to an alternative CLP(FD) solution
of the Numbrix puzzle, by means of circuit/1.

My solution:

next(X-Y, X2-Y) :- X < 3, X2 is X+1.
next(X-Y, X2-Y) :- X > 0, X2 is X-1.
next(X-Y, X-Y2) :- Y < 3, Y2 is Y+1.
next(X-Y, X-Y2) :- Y > 0, Y2 is Y-1.
point(X-Y) :- 
  between(0, 3, X),
  between(0, 3, Y).
line([P1, P2]) :-
   point(P1),
   point(P2),
   next(P1, P2).
line([P1 | Rs]) :-
   point(P1),
   Rs = [P2 | _],
   next(P1, P2),
   line(Rs),
   \+ member(P1, Rs).

Query:

time(aggregate_all(count, (_L = [_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _], line(_L)), C))

Result:

% 27,407,070,828 inferences, 1541.560 CPU in 1546.396 seconds (100% CPU, 17778789 Lips)
{'truth': True, 'C': 552}

Seems to me I am last :frowning:
Any review welcome.

I think a fast method would be to keep a list, for each cell, of the adjacent cells unvisited.

When an unvisited cell has an empty list of unvisited adjacent cells, can abort early.

When an adjacent unvisited cell has the current cell as its 1-cell list, then the choice is clear :grinning:

A simple change make it a magnitude faster:

next(X-Y, X2-Y) :- X < 3, X2 is X+1.
next(X-Y, X2-Y) :- X > 0, X2 is X-1.
next(X-Y, X-Y2) :- Y < 3, Y2 is Y+1.
next(X-Y, X-Y2) :- Y > 0, Y2 is Y-1.
point(X-Y) :- 
  between(0, 3, X),
  between(0, 3, Y).
line([P1, P2]) :-
  point(P1),
  point(P2),
  next(P1, P2).
line([P1 | Rs]) :-
  line(Rs),
  point(P1),
  Rs = [P2 | _],
  next(P1, P2),
  \+ member(P1, Rs).
Query: time(aggregate_all(count, (_L = [_, _, _, _,  _, _, _, _,  _, _, _, _,  _, _, _, _], line(_L)), C))
% 2,503,988 inferences, 0.157 CPU in 0.158 seconds (100% CPU, 15905236 Lips)
{'truth': True, 'C': 552}

It has still somewhere brakes compared to this solution,
which uses essentially the same next/2. Mostlikely the introduction
of point/1 makes it slow. point/1 is also not found here:

Solve a Numbrix puzzle - Rosetta Code
https://rosettacode.org/wiki/Solve_a_Numbrix_puzzle#Prolog

But Rosetta suggests something else, instead of \+ member/2
we could also use select/3. But there is not much speed differenece
between the two:

?-  pairlist(L), time(aggregate_all(count, 
    (between(0,3,X), between(0,3,Y),
    select((X,Y), L, R), path2((X,Y),R)), C)).
% 755,294 inferences, 0.047 CPU in 0.054 seconds
(86% CPU, 16112939 Lips)
C = 552.

The code with select/3 inspired by Rosetta Code is quite short:

path2(_, []) :- !.
path2(P, L) :-
   next(P, H),
   select(H, L, R),
   path2(H, R).

pairlist(L) :-
   findall((X,Y), (between(0,3,X),between(0,3,Y)), L).