Comments 10
Особенно заинтересовала фраза автора «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-е использовать.
Вот тут 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 — значит, что выход отсортированный (прилагательное) и был отсортирован (причастие).
Простой линейный код: вот вход, вот выход, вот кот, кот лапкой тут!
Разминки с Прологом