Решение числовых машин Смулляна

Вот еще одно улучшение улучшенной версии @ Celelibi (cele_n). Грубо говоря, он получает коэффициент два, ограничивая длину первого аргумента, и еще один коэффициент, равный двум, путем предварительного тестирования двух версий.

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), _)).

Давайте посмотрим на вашу «немного более сложную» проблему. Исчерпывающий поиск работает отлично!

Вот сравнение с решением Сергея, которое можно значительно улучшить, если учесть общие цели:

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]
    ).

Для запроса time(findall(_, (question3(X), write(X), nl), _)). я получаю с 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

На дополнительные вопросы ответить не так уж и сложно. Только SICStus с указанными выше m/2 и _5 _:

| ?- 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

(Я предполагаю, что речь идет о списке цифр, как вы предлагаете. В отличие от приведенной вами ссылки, в которой говорится о числах. Могут быть различия с ведущими нулями. Я не нашел времени, чтобы обдумать это)

Прежде всего, Prolog - отличный язык для поиска грубой силы. Ведь даже в этом случае Пролог способен смягчить комбинаторный взрыв. Благодаря логической переменной.

Формулировки ваших проблем - это, по сути, экзистенциальные утверждения: существует ли X такое, что то-то и то-то истинно. Вот где лучше всего подходит Prolog. Дело в том, как вы задаете вопрос. Вместо того, чтобы запрашивать конкретные значения, такие как [1] и т. Д., Просто попросите:

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

То же самое и с другими запросами. Учтите, что нет необходимости останавливаться на конкретных значениях! Это однозначно удорожает поиск!

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

Таким образом можно довольно эффективно найти конкретные решения, если они существуют. Увы, мы не можем решить, что решения не существует.

Чтобы проиллюстрировать суть дела, вот ответ на «самую сложную» загадку:

?- 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,
...

Это происходит в мгновение ока. Однако запрос:

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

все еще работает!

m/2 Я использовал:

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

Причина, по которой это более эффективно, заключается просто в том, что простое перечисление всех n цифр имеет 10 ⁿ разных кандидатов, тогда как Prolog будет искать только 3 ⁿ, заданные 3 рекурсивными правилами.

Вот еще одна оптимизация: все 3 правила имеют одну и ту же рекурсивную цель. Так зачем делать это трижды, если одного раза более чем достаточно:

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

Для последнего запроса это сокращается с 410 014 выводов, 0,094 с ЦП до 57 611 выводов, 0,015 с ЦП.

Изменить: при дальнейшей оптимизации две append/3 цели могут быть объединены:

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

... что дополнительно сокращает выполнение до 39 096 выводов и время выполнения на 1 мс.

Что еще можно сделать? Длина ограничена длиной «входа». Если n - длина ввода, то 2 ^(n-1) -1 - самый длинный вывод. Это как-то помогает? Возможно нет.

Я предлагаю здесь другое решение, которое по сути является исчерпывающим исследованием. Учитывая вопросы, если известна длина первого аргумента m/2, известна и длина второго. Если длина второго аргумента всегда известна, это можно использовать, чтобы сократить поиск раньше, распространив некоторые ограничения на рекурсивные вызовы. Однако это несовместимо с оптимизацией, предложенной 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).

Вот время, которое заняло соответственно: этот код, этот код при замене рекурсивных вызовов с ограничениями для каждого случая (аналогично решению Сергея Дымченко) и решение false, которое учитывает рекурсивные вызовы. Тест запускается на SWI и ищет все решения, длина которых меньше или равна 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)

Все мероприятия выполняются при вызове:

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

Таблинг (мемоизация) может помочь с более сложными вариантами проблемы.

Вот моя реализация третьего вопроса второго примера в B-Prolog (возвращает все решения длиной 13 или меньше):

:- 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).

Бегать:

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

Так что для этой конкретной проблемы осталось меньше минуты.

Я не думаю, что программирование с ограничениями поможет с этим типом проблем, особенно с вариантом «найти 20 первых решений».

Обновление: время работы одной и той же программы на моем компьютере в разных системах:

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