Pull to refresh

Comments 10

UFO landed and left these words here

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


For now, those interested in Prolog need to find a good book and perform a lot of experiments.
Прочитал статью по ссылке от mikhailian
Особенно заинтересовала фраза автора «Further, many conventional applications (like pricing, order processing, inventory checking, accounting transactions, and tax computations) also involve pattern-matching and search. These too are pratical and enjoyable to implement in Prolog.»

Если не ошибаюсь, то первая версия Erlang-а была написана на Прологе и он похоже унаследовал достаточное количество фич из него. В частности pattern matching.

Кто нибудь может скинуть ссылку на нормальную книгу по Прологу или на код, которые реализует pricing, order processing?

Мне интересно что из этого можно в Erlang-е использовать.
Да, так и есть, Erlang синтаксически близок с Прологом. Но в нем реализована парадигма функционального программирования. Унификация Пролога более широкое понятие чем pattern matching, также в Пролог встроен поиск с возвратом и управление им.
Вот тут lpn.swi-prolog.org/lpnpage.php?pageid=online хорошее руководство с живыми примерами.

Перебор вариантов с отсечением повторов — тоже, наверно, можно сделать декларативным.


Во-первых, давайте поймём, что из списка [A,...,A,...,Z] мы получим все арифметические подпоследовательности, что и из его хвоста [A,...,Z], и даже больше.
Поэтому при откатах можем рекурсивно передавать — какие головы мы уже встречали.
Если не жалко производительности, — то просто разрезаем список в произвольном месте и требуем, чтобы первый элемент хвостовой части не входил в головную часть.
Если жалко — реализуем множество, можем даже сортировать.


Аналогично, — когда зафиксировали первый элемент A, — такая же ситуация с [B,...,B,...,Z], — так же надо проверять, не встречался ли головной элемент ранее. То есть, — тоже разрезаем список во всех местах.
Потом с элементами [A,B], — только теперь уже C из [C,...,Z] не должен встречаться ранее, но и быть участником прогрессии: A-B =:= B-C.


Ниже напишу своё решение.

Чтобы считать НЕуникальные последовательности, нужно — не мудрить, "как бы так обмануть setof", а прочитать внимательно документацию… и, вуаля! Взять bagof или findall.


Но, разумеется, вы должны побеспокоиться о том, чтобы ваша программа не пыталась выдавать повторы (как если бы мы реально различали позиции элементов).

Собственно, моя программа:


% управляемо проверяет, уникально ли значение (или же нас это не волнует)
check_unique(true, A, A0s) :- not(member(A,A0s)).
check_unique(false, _, _).

% перебирает арифметические подпоследовательности списка ABCs
% - списки не менее чем из 3 элементов, [A,B,C|Rest]
% Unique управляет уникальностью искомых подпоследовательностей
arithm(Unique, ABCs, [A,B,C|Rest]) :-
    [_,_,_|_] = ABCs, % ранняя проверка: в списке не менее 3 элементов
    append(A0s, [A|BCs], ABCs), [_,_|_] = BCs, check_unique(Unique,A,A0s),
    % извлекли первый элемент и остаток
    append(B0s, [B|Cs], BCs), [_|_] = Cs, check_unique(Unique,B,B0s),
    % извлекли второй элемент и остаток
    Delta is B-A, % нашли шаг прогрессии
    C is B+Delta, % нашли третий элемент - будем его искать
    append(C0s, [C|Ds], Cs), check_unique(Unique,C,C0s),
    % извлекли третий элемент и остаток
    % теперь мы знаем шаг и предшествующий элемент, и найдём остальные элементы
    % (пусть даже это будет пустой список: по минимуму мы себя удовлетворили)
    arithm1(Unique, C, Delta, Ds, Rest).

% перебирает хвосты арифметических подпоследовательностей из списка Ds
% - списки (возможно, пустые) - [D|Rest] или []
% где известен предшествующий элемент C и шаг прогрессии Delta
arithm1(Unique, C, Delta, Ds, [D|Rest]) :-
    D is C+Delta, % нашли очередной элемент
    append(D0s, [D|Es], Ds), check_unique(Unique, D,D0s),
    arithm1(Unique, D, Delta, Es, Rest).
arithm1(_, _, _, _, []).

all_seqs(U, ABCs, AllSequences) :-
    findall(Seq, arithm(U, ABCs, Seq), AllSequences), !;
    AllSequences = [].

get_number(U, ABCs, N) :-
    all_seqs(U, ABCs, Seqs),
    length(Seqs, N).

По-моему, вполне декларативно!
Я не проверял её на предмет обращения — то есть, может ли она порождать надпоследовательности заданной арифметической последовательности, и не сойдёт ли она с ума, если первый вход оставить неизвестным, а на второй вход подать не прогрессию.


Как уже сказал, — бойлерплейт append(...), [...]=..., check_unique(...) можно переписать более эффективным, но гораздо более громоздким способом. Чтобы он выполнялся не за линейное на одну попытку и квадратичное на все попытки время, а за логарифмическое/логлинейное или даже за линейное в среднем (если прикрутить хеш-таблицы).

Но вообще, мне эти переборные решения не нравятся в принципе.
Задача-то на динамическое программирование.
"Сколько последовательностей" = сумма "сколько последовательностей с такими-то стартовыми условиями".


Каждая прогрессия может быть представлена тройкой (длина, дельта, конец).
Для прогрессии длины 1 дельта не определена.
Нас, понятное дело, будут интересовать только прогрессии длиной 3 и более.


Каждой прогрессии сопоставим количество уже найденных вхождений.
То есть, четвёрка (длина, дельта, конец, количество).
Или, буквами, (L,D,Z,N).


Тогда для каждого очередного числа X


  • из (1,undefined,X,N) получается
    • (1,undefined,X,N+1) — ещё одна точка старта со значением X
    • (2,0,X,N) — это прогрессия с шагом 0, стартовавшая из N предыдущих мест
  • из (L,D,Z,N), Z=X-D, получается
    • (L,D,Z,N) — мы проигнорировали это число
    • (L+1,D,X,N) — прогрессия, стартовавшая из N предыдущих мест, получила продолжение
  • из (L,D,Z,N), Z≠X-D, получается
    • (L,D,Z,N) — мы вынуждены проигнорировать
  • если не было (1,undefined,X,N), то добавим
    • (1,undefined,X,1) — новая точка старта, одна штука

Под конец возьмём и посчитаем сумму N для всех четвёрок, у которых L≥3.


Как наиболее эффективно реализовать структуру коллекции — тут надо подумать.
Но и линейный список может сгодиться — мы же всё равно его весь перекопируем.


Одна из проблем — в том, что оценка сверху количества разных прогрессий — это квадрат длины исходного списка.
(Кстати, если втупую перебирать все варианты, — как было в наивном решении, — то количество — экспонента с основанием 2… Правда, длина очереди откатов линейная, — разменяли немного памяти на кучу времени).


Вот тут бы подумать о всяких дальнейших улучшениях и сокращениях...

Ну вот, допилил версию с динамическим программированием.
Она не очень оптимальна по использованию структур данных: я использую склеивание и сортировку списков там, где можно было бы взять словари.
Но групповые операции над словарями выглядят ещё более императивно и последовательно, а тут я всё распараллелил.


% правила расширения последовательностей
% всё начинается с пустой последовательности s0, соответствующей точке-до-начала-списка
% далее мы создаём вырожденное начало-любых-последовательностей s1(X)
% затем тривиальную последовательность-через-две-точки X,Y = s2(Y-X, X)
% ну и наконец, последовательности длины L≥3 с шагом D и концом X = ss(L,D,X)
extend(s0, X, s1(X)).
extend(s1(X), Y, s2(D,Y)) :- D is Y-X.
extend(s2(D,X), Y, ss(3,D,Y)) :- D is Y-X.
extend(ss(L,D,X), Y, ss(L1,D,Y)) :- D is Y-X, L1 is L+1.

% расширяем таблицу последовательностей очередным элементом списка чисел X
% таблица содержит пары Sequence-Number,
% где Sequence - спецификация последовательности (s0, s1(...), s2(...), ss(...)),
%     Number - количество вхождений
expand(X, Table, NewTable) :-
    % расширяем каждый подходящий элемент последовательности новым числом
    convlist({X} / [OldKey-N, NewKey-N] >> extend(OldKey, X, NewKey), Table, NewGenTable),
    % новая таблица включает и старую тоже (как если бы мы проигнорировали X)
    append(Table, NewGenTable, UnsortedJointTable),
    % сортируем (с повторами), группируем по одинаковым ключам и суммируем счётчики
    msort(UnsortedJointTable, JointTable),
    group_pairs_by_key(JointTable, NewTableWithLists),
    maplist([Key-Values, Key-Sum] >> sum_list(Values, Sum), NewTableWithLists, NewTable).

get_number(Xs, Count) :-
    % скармливаем последовательно все числа в исходную таблицу "начало:единственное"
    foldl(expand, Xs, [s0-1], Table),
    % суммируем счётчики у всех последовательностей 3-и-более
    convlist([ss(_,_,_)-N, N] >> true, Table, Values),
    sum_list(Values, Count).

% профилируем!
profile_number(Xs, Count, T) :-
    get_time(T0), get_number(Xs, Count), get_time(T1), T is T1-T0.

Результат работы:


:- profile_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1], N, T).
N = 2147483151,
T = 0.002859830856323242

:- profile_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1], N, T).
N = 1048365,
T = 0.0007598400115966797

760 микросекунд против 12 секунд, как тебе такое Элон Маск?


А если я ещё немножко упрощу код — перестану различать последовательности разной длины, то есть,


extend(s2(D,X), Y, ss(D,Y)) :- D is Y-X.
extend(ss(D,X), Y, ss(D,Y)) :- D is Y-X.

.....
    convlist([ss(_,_)-N, N] >> true, Table, Values),
.....

то ещё немножко микросекунд выгадаю. И забег по 31 единичке займёт не 2мс, а 0.9мс.


А если ещё немножко подпилю код — чтобы s2 и ss содержали не последнее встреченное, а следующее ожидаемое число, — чтобы сопоставление происходило не в арифметическом блоке, а непосредственно в паттерн-матчинге,


extend(s0, X, s1(X)).
extend(s1(X), Y, s2(D,Z)) :- D is Y-X, Z is Y+D.
extend(s2(D,Y), Y, ss(D,Z)) :- Z is Y+D.
extend(ss(D,Y), Y, ss(D,Z)) :- Z is Y+D.

то выгадаю вдвое микросекунд!!! Забег по 31 единичке займёт 0.4мс.




А всё потому, что надо думать не просто декларативно, но и алгоритмически, и не подхватывать экспоненты (слава богу, что не факториалы) на ровном месте.


Декларативна ли моя программа?
Я считаю, что по-прежнему — ДА. Каждая инструкция в ней говорит не только, что надо сделать, но и какой результат ожидается. msort — значит, что выход отсортированный (прилагательное) и был отсортирован (причастие).
Простой линейный код: вот вход, вот выход, вот кот, кот лапкой тут!

О шикарно, стоит это представить отдельной статьей.
Решение получилось функционально-логическое. Возможности тут выражать лямбда-предикатыфункции для меня открытие.


А "список отсортироватьн" это уже следующий мой опус.


Спасибо

Sign up to leave a comment.

Articles