Разминки с Прологом

    Путешественники, привет.


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


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


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


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


    Хватит вызывать заинтересованность, начинаю...


    Задача 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

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


    Выводом.


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


    Опять оставляю вопросы…


    Все таки, поиск ответов и интересен в нашей профессии, правда?

    Похожие публикации

    Средняя зарплата в IT

    111 111 ₽/мес.
    Средняя зарплата по всем IT-специализациям на основании 6 788 анкет, за 2-ое пол. 2020 года Узнать свою зарплату
    AdBlock похитил этот баннер, но баннеры не зубы — отрастут

    Подробнее
    Реклама

    Комментарии 10

      +2

      Можно я испорчу вам малину и поставлю ссылку на статью, где объясняется, как оно всё на самом деле в Прологе работает? Статья 1992 года между прочим.

        0

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


        For now, those interested in Prolog need to find a good book and perform a lot of experiments.
        0
        Прочитал статью по ссылке от 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-е использовать.
          0
          Да, так и есть, Erlang синтаксически близок с Прологом. Но в нем реализована парадигма функционального программирования. Унификация Пролога более широкое понятие чем pattern matching, также в Пролог встроен поиск с возвратом и управление им.
          Вот тут lpn.swi-prolog.org/lpnpage.php?pageid=online хорошее руководство с живыми примерами.
          0

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


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


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


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

            0

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


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

              0

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


              % управляемо проверяет, уникально ли значение (или же нас это не волнует)
              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(...) можно переписать более эффективным, но гораздо более громоздким способом. Чтобы он выполнялся не за линейное на одну попытку и квадратичное на все попытки время, а за логарифмическое/логлинейное или даже за линейное в среднем (если прикрутить хеш-таблицы).

                0

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


                Каждая прогрессия может быть представлена тройкой (длина, дельта, конец).
                Для прогрессии длины 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… Правда, длина очереди откатов линейная, — разменяли немного памяти на кучу времени).


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

                  +1

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


                  % правила расширения последовательностей
                  % всё начинается с пустой последовательности 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 — значит, что выход отсортированный (прилагательное) и был отсортирован (причастие).
                  Простой линейный код: вот вход, вот выход, вот кот, кот лапкой тут!

                    0

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


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


                    Спасибо

                  Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

                  Самое читаемое