Smouldan Computing Solution

Question

Here I propose to find a solution for Smullyan numerical machines as given here .

Description of the problem

These are machines that accept a list of numbers as input and convert them to another list of numbers, following some rules based on an input pattern. Below are the machine rules specified in the link above, expressed somewhat more formally. Let them say that M is a machine, and M (X) is the transformation of X. We define several rules:

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 everything that does not comply with any rule is rejected. Here are some 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 questions, we find X that:

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

Here is a second example, more complex with an exhaustive search (especially if I need 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) decisions

Writing a solution in Prolog is pretty simple. Except that this is just exhaustive research (aka brute force) and may take some time for some set of rules.

I tried, but could not express this problem in terms of logical constraints using CLP (FD), so I tried CHR (Constraint Processing Rules) to express this in terms of list constraints (especially append constraints), but regardless as I express it, it always comes down to an exhaustive search.

Question

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

Answer 1

Here is another improvement for the improved version of @Celelibi ( cele_n ). For example, it gets a coefficient of two, limiting the length of the first argument, and the other coefficient is two, having previously tested 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

Look at your "more complex" problem. An exhaustive search works great!

Here is a comparison with Sergey’s decision, which can be significantly improved by factoring common goals:

 m([1|A], X) :- A = [_|_], append(X, [2], A). m([E | X], Z) :- m(X, Y), ( E = 3, append(Y, Y, Z) ; E = 4, reverse(Y, Z) ; E = 5, Y = [_ | Z] ; E = 6, Z = [1 | Y] ; E = 7, Z = [2 | Y] ). 

For the query time(findall(_, (question3(X), write(X), nl), _)). I get with B 8.1, SICStus 4.3b8:

 ́ B tabled 104.542s ́ B 678.394s false B 16.013s false B tabled 53.007s ́ SICStus 439.210s false SICStus 7.990s ́ SWI 1383.678s, 5,363,110,835 inferences false SWI 44.743s, 185,136,302 inferences 

Additional questions are not so difficult to answer. Only SICStus with above m/2 and call_nth/2 :

 | ?- time(call_nth( ( length(Xs0,N),append(Xs0,Xs0,Ys),m(Xs0,Ys), writeq(Ys),nl ), 10)). [4,3,7,4,3,1,4,3,7,4,3,1,2,4,3,7,4,3,1,4,3,7,4,3,1,2] [3,4,7,4,3,1,3,4,7,4,3,1,2,3,4,7,4,3,1,3,4,7,4,3,1,2] [4,3,7,3,4,1,4,3,7,3,4,1,2,4,3,7,3,4,1,4,3,7,3,4,1,2] [3,4,7,3,4,1,3,4,7,3,4,1,2,3,4,7,3,4,1,3,4,7,3,4,1,2] [3,5,4,5,3,1,2,2,1,3,5,4,5,3,1,2,3,5,4,5,3,1,2,2,1,3,5,4,5,3,1,2] [3,5,5,3,4,1,2,1,4,3,5,5,3,4,1,2,3,5,5,3,4,1,2,1,4,3,5,5,3,4,1,2] [5,4,7,4,3,3,1,2,5,4,7,4,3,3,1,2,5,4,7,4,3,3,1,2,5,4,7,4,3,3,1,2] [4,7,4,5,3,3,1,2,4,7,4,5,3,3,1,2,4,7,4,5,3,3,1,2,4,7,4,5,3,3,1,2] [5,4,7,3,4,3,1,2,5,4,7,3,4,3,1,2,5,4,7,3,4,3,1,2,5,4,7,3,4,3,1,2] [3,5,4,7,4,3,1,_2735,3,5,4,7,4,3,1,2,3,5,4,7,4,3,1,_2735,3,5,4,7,4,3,1,2] 196660ms | ?- time(call_nth( ( length(Xs0,N),m(Xs0,Xs0), writeq(Xs0),nl ), 10)). [4,7,4,3,1,4,7,4,3,1,2] [4,7,3,4,1,4,7,3,4,1,2] [5,4,7,4,3,1,_2371,5,4,7,4,3,1,2] [4,7,4,5,3,1,_2371,4,7,4,5,3,1,2] [5,4,7,3,4,1,_2371,5,4,7,3,4,1,2] [3,5,4,7,4,1,2,3,5,4,7,4,1,2] [4,3,7,4,5,1,2,4,3,7,4,5,1,2] [3,4,7,4,5,1,2,3,4,7,4,5,1,2] [4,7,5,3,6,4,1,4,7,5,3,6,4,2] [5,4,7,4,3,6,1,5,4,7,4,3,6,2] 6550ms | ?- time(call_nth( ( length(Xs0,N),reverse(Xs0,Ys),m(Xs0,Ys), writeq(Ys),nl ), 10)). [2,1,3,4,7,1,3,4,7] [2,1,4,3,7,1,4,3,7] [2,1,3,5,4,7,_2633,1,3,5,4,7] [2,1,5,4,7,3,2,1,5,4,7,3] [2,4,6,3,5,7,1,4,6,3,5,7] [2,6,3,5,4,7,1,6,3,5,4,7] [2,_2633,1,5,3,4,7,_2633,1,5,3,4,7] [2,_2633,1,5,4,3,7,_2633,1,5,4,3,7] [2,1,3,4,4,4,7,1,3,4,4,4,7] [2,1,3,4,5,6,7,1,3,4,5,6,7] 1500ms 

Answer 3

(I assume this is roughly a list of numbers, as you suggest. Unlike the link you gave, which talks about numbers. Perhaps there are differences with leading zeros. I did not find the time to think that through)

First of all, Prolog is a great brute force language. For even in this case, Prolog is able to mitigate the combinatorial explosion. Thanks to the boolean variable.

Your statements about the problems are essentially existential statements: is there an X such that such and such is true. Where Prolog is best. The point is how you ask the question. Instead of specifying specific values ​​like [1] , etc., just ask:

 ?- length(Xs, N), m(Xs,Xs). Xs = [3,2,3], N = 3 ... 

And similarly for other requests. Please note that there is no need to agree on specific values! This makes the search more expensive!

 ?- length(Xs, N), maplist(between(0,9),Xs), m(Xs,Xs). Xs = [3,2,3], N = 3 ... 

Thus, it is quite effective to find specific solutions, if they exist. Alas, we cannot decide that a solution does not exist.

To illustrate this point, here is the answer to the "hardest" riddle:

 ?- length(Xs0,N), append(Xs0,[2|Xs0],Xs1),reverse(Xs1,Xs2),append(Xs2,Xs2,Xs3), m(Xs0,Xs3). Xs0 = [4, 5, 3, 3, 2, 4, 5, 3, 3], N = 9, ... 

This happens instantly. However, the request:

 ?- length(Xs0,N), maplist(between(0,9),Xs0), append(Xs0,[2|Xs0],Xs1),reverse(Xs1,Xs2),append(Xs2,Xs2,Xs3), m(Xs0,Xs3). 

still working!

m/2 I used:

 m([2|Xs], Xs). m([3|Xs0], Xs) :- m(Xs0,Xs1), append(Xs1,[2|Xs1], Xs). m([4|Xs0], Xs) :- m(Xs0, Xs1), reverse(Xs1,Xs). m([5|Xs0],Xs) :- m(Xs0,Xs1), append(Xs1,Xs1,Xs). 

The reason this is more efficient is because a naive listing of all n digits has 10 ⁿ different candidates, while Prolog will only look for 3 ⁿ given by formula 3 recursive rules.

Here is another optimization: all 3 rules have the same recursive goal. So why do this three times, when times are more than enough:

 m([2|Xs], Xs). m([X|Xs0], Xs) :- m(Xs0,Xs1), ( X = 3, append(Xs1,[2|Xs1], Xs) ; X = 4, reverse(Xs1,Xs) ; X = 5, append(Xs1,Xs1,Xs) ). 

For the last request, this is reduced from 410.014 pins, 0.094s CPU to 57 611 pins, 0.015s CPU.

Edit: With further optimization, the two append/3 targets can be combined:

 m([2|Xs], Xs). m([X|Xs0], Xs) :- m(Xs0,Xs1), ( X = 4, reverse(Xs1,Xs) ; append(Xs1, Xs2, Xs), ( X = 3, Xs2 = [2|Xs1] ; X = 5, Xs2 = Xs1 ) ). 

..., which further reduces execution to 39,096 pins and execution time by 1 ms.

What else can be done? The length is limited by the length of the "entry". If n is the input length, then 2 ^(n-1) -1 is the longest output. It helps? Probably not.

Answer 4

I propose here another solution, which is basically an exhaustive study. Given the questions, if the length of the first argument m/2 known, the length of the second is also known. If the length of the second argument is always known, this can be used to shorten the search earlier by extending some restrictions to recursive calls. However, this is incompatible with the optimization suggested 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 spent accordingly: with this code, this code when replacing recursive calls with the restrictions of each case (similar to the decision of Sergey Dymchenko) and solving false ones that are factors of recursive calls. The test is run on a SWI and looks for all solutions whose length is less than 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 using a call:

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

Answer 5

Memoization can help with more complex problems.

Here is my implementation for the third question of the second example in B-Prolog (returns all solutions 13 or less in length):

 :- table m/2. m(A, X) :- append([1 | X], [2], A). m([3 | X], Z) :- m(X, Y), append(Y, Y, Z). m([4 | X], Z) :- m(X, Y), reverse(Y, Z). m([5 | X], Z) :- m(X, Y), Y = [_ | Z]. m([6 | X], Z) :- m(X, Y), Z = [1 | Y]. m([7 | X], Z) :- m(X, Y), Z = [2 | Y]. question3(X) :- between(1, 13, N), length(X, N), reverse(X, Z), m(X, Z). 

Run:

 B-Prolog Version 8.1, All rights reserved, (C) Afany Software 1994-2014. | ?- cl(smullyan2). cl(smullyan2). Compiling::smullyan2.pl compiled in 2 milliseconds loading... yes | ?- time(findall(_, (question3(X), writeln(X)), _)). time(findall(_, (question3(X), writeln(X)), _)). [7,3,4,1,7,3,4,1,2] [7,4,3,1,7,4,3,1,2] [3,7,4,5,1,2,3,7,4,5,1,2] [7,4,5,3,1,_678,7,4,5,3,1,2] [7,4,5,3,6,1,7,4,5,3,6,2] [7,5,3,6,4,1,7,5,3,6,4,2] [4,4,7,3,4,1,4,4,7,3,4,1,2] [4,4,7,4,3,1,4,4,7,4,3,1,2] [5,6,7,3,4,1,5,6,7,3,4,1,2] [5,6,7,4,3,1,5,6,7,4,3,1,2] [5,7,7,3,4,1,5,7,7,3,4,1,2] [5,7,7,4,3,1,5,7,7,4,3,1,2] [7,3,4,4,4,1,7,3,4,4,4,1,2] [7,3,4,5,1,_698,7,3,4,5,1,_698,2] [7,3,4,5,6,1,7,3,4,5,6,1,2] [7,3,4,5,7,1,7,3,4,5,7,1,2] [7,3,5,6,4,1,7,3,5,6,4,1,2] [7,3,5,7,4,1,7,3,5,7,4,1,2] [7,3,6,5,4,1,7,3,6,5,4,1,2] [7,4,3,4,4,1,7,4,3,4,4,1,2] [7,4,3,5,1,_698,7,4,3,5,1,_698,2] [7,4,3,5,6,1,7,4,3,5,6,1,2] [7,4,3,5,7,1,7,4,3,5,7,1,2] [7,4,4,3,4,1,7,4,4,3,4,1,2] [7,4,4,4,3,1,7,4,4,4,3,1,2] [7,4,5,6,3,1,7,4,5,6,3,1,2] [7,4,5,7,3,1,7,4,5,7,3,1,2] [7,5,6,3,4,1,7,5,6,3,4,1,2] [7,5,6,4,3,1,7,5,6,4,3,1,2] [7,5,7,3,4,1,7,5,7,3,4,1,2] [7,5,7,4,3,1,7,5,7,4,3,1,2] [7,6,5,3,4,1,7,6,5,3,4,1,2] [7,6,5,4,3,1,7,6,5,4,3,1,2] CPU time 25.392 seconds. yes 

So this is less than a minute for this particular problem.

I do not think that restriction programming will have any help in this type of problem, especially with the option to "find the first 20 solutions."

Update: while the same program is running on my computer on different systems:

 B-Prolog 8.1 with tabling: 26 sec B-Prolog 8.1 without tabling: 128 sec ECLiPSe 6.1 #187: 122 sec SWI-Prolog 6.2.6: 330 sec