Solution to Smullyan's numerical machines

Question

Here I propose to find a solution to Smullyan's numerical machines as defined here.

Problem statement

They're machines that take a list of digits as input, and transform it to another list of digits following some rules based on the pattern of the input. Here are the rules of the machine given in the link above, expressed a bit more formally. Let say M is the machine, and M(X) is the transformation of X. We define a few rules like this:

M(2X) = X
M(3X) = M(X)2M(X)
M(4X) = reverse(M(X)) // reverse the order of the list.
M(5X) = M(X)M(X)

And anything that does not match any rule is rejected. Here are a few examples:

• M(245) = 45
• M(3245) = M(245)2M(245) = 45245
• M(43245) = reverse(M(3245)) = reverse(45245) = 54254
• M(543245) = M(43245)M(43245) = 5425454254

And the questions are, find X such that:

• M(X) = 2
• M(X) = X
• M(X) = X2X
• M(X) = reverse(X)
• M(X) = reverse(X2X)reverse(X2X)

Here is a second example a bit more complex with the exhaustive search (especially if I want the first 10 or 100 solutions).

M(1X2) = X
M(3X) = M(X)M(X)
M(4X) = reverse(M(X))
M(5X) = truncate(M(X)) // remove the first element of the list truncate(1234) = 234. Only valid if M(X) has at least 2 elements.
M(6X) = 1M(X)
M(7X) = 2M(X)

Questions:

• M(X) = XX
• M(X) = X
• M(X) = reverse(X)

(Non-)Solutions

Writing a solver in Prolog is pretty straightforward. Except that it's just exhaustive exploration (a.k.a brute force) and may take some time for some set of rules.

I tried but couldn't express this problem in terms of logic constraints with CLP(FD), so I tried CHR (Constraint Handling Rules) to express this in terms of constraints on lists (especially append constraints), but no matter how I express it, it always boils down to an exhaustive search.

Question

Any idea what approach I could take to resolve any problem of this kind in a reasonable amount of time? Ideally I would like to be able to generate all the solutions shorter than some bound.

Answer 1

Here is another improvement to @Celelibi's improved version (cele_n). Roughly, it gets a factor of two by constraining the length of the first argument, and another factor of two by pretesting the two versions.

cele_n SICStus  2.630s
cele_n SWI     12.258s 39,546,768 inferences
cele_2 SICStus  0.490s
cele_2 SWI      2.665s  9,074,970 inferences

---

appendh([], [], Xs, Xs).
appendh([_, _ | Ws], [X | Xs], Ys, [X | Zs]) :-
   appendh(Ws, Xs, Ys, Zs).

m([H|A], X) :-
   A = [_|_],                 % New
   m(H, X, A).

m(1, X, A) :-
   append(X, [2], A).
m(3, X, A) :-
   appendh(X, B, B, X),
   m(A, B).
m(4, X, A) :-
   reverse(X, B),
   m(A, B).
m(5, X, A) :-
   X = [_| _],
   m(A, [_|X]).
m(H1, [H2 | B], A) :-
   \+ \+ ( H2 = 1 ; H2 = 2 ),  % New
   m(A, B),
   (  H1 = 6, H2 = 1
   ;  H1 = 7, H2 = 2
   ).

answer3(X) :-
   between(1, 13, N),
   length(X, N),
   reverse(X, A),
   m(X, A).

run :-
   time(findall(X, (answer3(X), write(X), nl), _)).

Answer 2

I propose here another solution which is basically exhaustive exploration. Given the questions, if the length of the first argument of m/2 is known, the length of the second is known as well. If the length of the second argument is always known, this can be used to cut down the search earlier by propagating some constraints down to the recursive calls. However, this is not compatible with the optimization proposed by false.

appendh([], [], Xs, Xs).
appendh([_, _ | Ws], [X | Xs], Ys, [X | Zs]) :-
    appendh(Ws, Xs, Ys, Zs).

m([1 | A], X) :-
    append(X, [2], A).
m([3 | A], X) :-
    appendh(X, B, B, X),
    m(A, B).
m([4 | A], X) :-
    reverse(X, B),
    m(A, B).
m([5 | A], X) :-
    B = [_, _ | _],
    B = [_ | X],
    m(A, B).
m([H1 | A], [H2 | B]) :-
    m(A, B),
    (  H1 = 6, H2 = 1
    ;  H1 = 7, H2 = 2
    ).

answer3(X) :-
    between(1, 13, N),
    length(X, N),
    reverse(X, A),
    m(X, A).

Here is the time taken respectively by: this code, this code when swapping recursive calls with the constraints of each case (similar to solution of Sergey Dymchenko), and the solution of false which factor the recursive calls. The test is run on SWI and search for all the solution whose length is less or equal to 13.

% 36,380,535 inferences, 12.281 CPU in 12.315 seconds (100% CPU, 2962336 Lips)
% 2,359,464,826 inferences, 984.253 CPU in 991.474 seconds (99% CPU, 2397214 Lips)
% 155,403,076 inferences, 47.799 CPU in 48.231 seconds (99% CPU, 3251186 Lips)

All measures are performed with the call:

?- time(findall(X, (answer3(X), writeln(X)), _)).