Путешественники, привет.
Если вы это читаете предлагаю продолжение того "занимательного" материала, который я писал перед этим. Если вы немного проследили за мыслью, которая изветвилась в три статьи, а основной то посыл — был, только в том, чтобы показать интерес к декларативному подходу. Он почему то не велик, как будто эСКюэЛ не стал общедоступным и обязательным, ведь без него невозможно подумать, а как можно обработать данные иначе. Правда, ведь лучше сформулировать задачу и не заботиться о том, во что это воплощается.
Перейдем к делу, я перед этим писал про попытки вас повеселить, так что продолжу показывать пример использования пролога, хоть предыдущие статьи и показали, что интерес к питону и даже го, вызовет заинтересованность сразу на пару тысяч человек, что интерес к новости про новую батарейку к Тесле, вызывает стотысч просмотров, а для написания программ, на самом разработничестском портале не так, немногие, замеченные за этим поведением, отметились о прочтении в комментариях, и возможно пятёрка из них, после второго прочтения этого предложения еще заморочится мыслью, что стоит это читать далее…
Получилось, гипотеза заинтересовать не выполняется, и тогда просто покажу, как можно использовать пролог, это инструмент современный, развивающийся, и свободно распространяющийся, его можно брать и формулировать, только вот, что бы такое можно было бы сформулировать, чтобы увидеть преимущество.
Скажу, что путешествий во времени и не существует, но отправимся на неделю назад, там в ленте проскакивал Занимательный Пролог о трех частях, вот именно там была затронута тема решения случайно попавшейся новой задачи, я беру этот интересный сайт, и самое сложное задание (только не превращения строки в число) ), попробую сделать в Прологе.
Хватит вызывать заинтересованность, начинаю...

Задача 446 arithmetic-slices-ii-subsequence

A sequence of numbers is called arithmetic if it consists of at least three elements and if the difference between any two consecutive elements is the same.
For example, these are arithmetic sequences:
1, 3, 5, 7, 9
7, 7, 7, 7
3, -1, -5, -9
The following sequence is not arithmetic.
1, 1, 2, 5, 7

Всего-то, разница между двумя соседями должна сохраняться, всего лишь это надо проверить?
Читаем далее:

A zero-indexed array A consisting of N numbers is given. A subsequence slice of that array is any sequence of integers (P0, P1, ..., Pk) such that 0 ≤ P0 < P1 <… < Pk < N.
A subsequence slice (P0, P1, ..., Pk) of array A is called arithmetic if the sequence A[P0], A[P1], ..., A[Pk-1], A[Pk] is arithmetic. In particular, this means that k ≥ 2.
The function should return the number of arithmetic subsequence slices in the array A.

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

Example:
Input: [2, 4, 6, 8, 10]
Output: 7
Explanation:
All arithmetic subsequence slices are:
[2,4,6]
[4,6,8]
[6,8,10]
[2,4,6,8]
[4,6,8,10]
[2,4,6,8,10]
[2,6,10]

Я знаю как выразить подсписок в прологе, это:

sublists(InputList, SubList):-
    append(Prefix,Root,InputList),
    append(SubList,Suffix,,Root).

Как проверить что список нужного вида — проверять надо по тройкам:

is_seq(A,B,C]):-A-B =:=B-C.
is_seq(A,B,C|Tail]):-A-B =:=B-C, is_seq(B,C|Tail]).

Если отбросить перестановки всех элементов списка, то оказывается, что это не просто подсписки элементов стоящих рядом, это такие подсписки, которые сформировались с пропуском элементов.
Тогда выразим это вот так:

seq(_,[]).
seq([H|T],[H|T1]):-seq(T,T1).
seq([_|T],T1):-seq(T,T1).

Такое правило будет возвращать все возможные подсписки из списка, но начинать может с одного элемента, или пропустив его, со следующего, также в конце может быть отброшено любое количество.
Итого получим завышенное количество решений, сразу видно что пустой список вернется много раз также не избежать повторений при отбрасывании элементов с конца.
Просмотрев предлагаемые тесты на эту задачу, оказалось, что на входе могут быть и повторяющиеся значения, что для такого списка [0,1,2,2,2] должно быть 4-ре решения. Каждую 2-ку можно взять отдельно, и это надо считать отдельным срезом, итого подойдут три варианта [0,1,2] и один [2,2,2].
Вот тут незадача, ведь генератор последовательностей будет выдавать повторяющиеся значения, а как сделать подсчет только уникальных? Придется их помечать, сделать так чтобы списки отличались друг от друга. Все решение построю на том чтобы сгенерировать списки, проверить условие и подсчитать количество решений. А что делать с повторами решений…
Сделаю простую нумерацию элементов, пусть список превращается в список из компонентов Значение/Индекс, структурированный терм, так называют это. Для вышеприведенного примера это будет [0/1,1/2,2/3,2/4,2/5]. Последовательности сгенерированные по такому входу, уже все будут отличаться.
Вот так, можно превратить список в помеченный:

label([],[],_).
label([A|T],[A/N|T1],N):-N1 is N+1, label(T,T1,N1).

Ну и важнейший момент, проверка на арифметичность is_seq, после ряда попыток, с учетом помеченного списка, это правило превратилось в достаточно сложное выражение. Тут проверим, что тройки чисел соответствуют условию, и подсчитаем ключ конкретно этого решения, для исключения уникальных решений потребовался ключ, это поможет собрать все ключи в список и потом их подсчитать.
На входе помеченный список, выходом будет величина ключа, подсчитаем ее как целое число, разрядами которого будут сумма Значение+Индекс для каждого элемента.

%is_seq список, максимальный индекс, ключ
is_seq([A/An,B/Bn,C/Cn],2,N):-
      A-B=:=B-C,
      N is 10000*(A+An)+100*(B+Bn)+(C+Cn).
is_seq([A/An,B/Bn,C/Cn|T],K,N):-
      A-B=:=B-C,
      is_seq([B/Bn,C/Cn|T],K1,N1),
      K is K1+1,
      N is N1+(A+An)*(100**K).

Для подсчета всех решений, воспользуюсь встроенной возможность выполнить цель и собрать все уникальные решения в список setof(). Собирать просто список всех последовательностей оказалось совсем неэффективным, отсюда возникли идеи ключа, как более простого значения:

get_number(List,N) :- 
   label(List,ListL,1),
   setof(Len,K^Sub^(seq(ListL,Sub),is_seq(Sub,K,Len)),Result),
   length(Result,N),!.
get_number(_,0).

Конечно, в таком решении производительность не особо выразилась.
Вот такой полный текст программы, со списком тестов, который хардкорно выужен с сайта с задачей (это всего лишь часть тестов):

label([],[],_).
label([A|T],[A/N|T1],N):-N1 is N+1, label(T,T1,N1).

seq(_,[]).
seq([H|T],[H|T1]):-seq(T,T1).
seq([_|T],T1):-seq(T,T1).

is_seq([A/An,B/Bn,C/Cn],2,N):-
      A-B=:=B-C,
      N is 10000*(A+An)+100*(B+Bn)+(C+Cn).
is_seq([A/An,B/Bn,C/Cn|T],K,N):-
      A-B=:=B-C,
      is_seq([B/Bn,C/Cn|T],K1,N1),
      K is K1+1,
      N is N1+(A+An)*(100**K).

get_number(List,N) :- label(List,ListL,1),setof(Len,K^Sub^(seq(ListL,Sub),is_seq(Sub,K,Len)),Result),
   length(Result,N),!.
get_number(_,0).

%unit-tests framework
assert_are_equal(Goal, false):-get_time(St),not(Goal),!,get_time(Fin),Per is round(Fin-St),writeln(Goal->ok:Per/sec).
assert_are_equal(Goal, true):- get_time(St),Goal,     !,get_time(Fin),Per is round(Fin-St),writeln(Goal->ok:Per/sec).
assert_are_equal(Goal, Exp):-writeln(Goal->failed:expected-Exp).

%all test
:-assert_are_equal(get_number([2,4,6,8,10],7),true).
:-assert_are_equal(get_number([],0),true).
:-assert_are_equal(get_number([1],0),true).
:-assert_are_equal(get_number([1,2],0),true).
:-assert_are_equal(get_number([1,2,3],1),true).
:-assert_are_equal(get_number([1,2,3,4],3),true).
:-assert_are_equal(get_number([1,2,3,4,5],7),true).
:-assert_are_equal(get_number([1,2,3,4,5,6],12),true).
:-assert_are_equal(get_number([1,2,3,4,5,6,7],20),true).
:-assert_are_equal(get_number([1,2,3,4,5,6,7,8],29),true).
:-assert_are_equal(get_number([1,2,3,4,5,6,7,8,9],41),true).
:-assert_are_equal(get_number([1,2,3,4,5,6,7,8,9,10],55),true).
:-assert_are_equal(get_number([2,2,3,4],2),true).
:-assert_are_equal(get_number([0,1,2,2,2],4),true).
:-assert_are_equal(get_number([0,2000000000,-294967296],0),true).
:-assert_are_equal(get_number([1,1,1],1),true).
:-assert_are_equal(get_number([1,1,1,1],5),true).
:-assert_are_equal(get_number([1,1,1,1,1],16),true).
:-assert_are_equal(get_number([1,1,1,1,1,1],42),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1],99),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1],219),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1],466),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1],968),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1],1981),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1],4017),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1],8100),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1],16278),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],32647),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],65399),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],130918),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],261972),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],524097),true).
:-assert_are_equal(get_number([1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],1048365),true).

Как неутешительный результат, вот такая эффективность:

get_number([2, 4, 6, 8, 10], 7)->ok:0/sec
get_number([], 0)->ok:0/sec
get_number([1], 0)->ok:0/sec
get_number([1, 2], 0)->ok:0/sec
get_number([1, 2, 3], 1)->ok:0/sec
get_number([1, 2, 3, 4], 3)->ok:0/sec
get_number([1, 2, 3, 4, 5], 7)->ok:0/sec
get_number([1, 2, 3, 4, 5, 6], 12)->ok:0/sec
get_number([1, 2, 3, 4, 5, 6, 7], 20)->ok:0/sec
get_number([1, 2, 3, 4, 5, 6, 7, 8], 29)->ok:0/sec
get_number([1, 2, 3, 4, 5, 6, 7, 8, 9], 41)->ok:0/sec
get_number([1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 55)->ok:0/sec
get_number([2, 2, 3, 4], 2)->ok:0/sec
get_number([0, 1, 2, 2, 2], 4)->ok:0/sec
get_number([0, 2000000000, -294967296], 0)->ok:0/sec
get_number([1, 1, 1], 1)->ok:0/sec
get_number([1, 1, 1, 1], 5)->ok:0/sec
get_number([1, 1, 1, 1, 1], 16)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1], 42)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1], 99)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1], 219)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1], 466)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 968)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 1981)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 4017)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 8100)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 16278)->ok:0/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 32647)->ok:1/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 65399)->ok:1/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 130918)->ok:3/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 261972)->ok:6/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 524097)->ok:12/sec
get_number([1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1], 1048365)->ok:27/sec

Собирать список, даже просто ключей решений, очень громоздко, но это декларативное решение, без этого не удается подсчитать все уникальные решения.

Выводом.

Вот так формулируются задачи на языке Пролог, простое перенесение постановки задачи в программу чревато недостаточной эффективностью. А может в этой задаче только алгоритмическое решение доступно? Насколько нужно усложнить процесс?
Опять оставляю вопросы…
Все таки, поиск ответов и интересен в нашей профессии, правда?

Автор: go-prolog

Источник